Commit 76e3504f by Arnaud Charlet

[multiple changes]

2010-10-11  Javier Miranda  <miranda@adacore.com>

	* sem_ch10.adb (Analyze_With_Clause): Add missing test to ensure
	availability of attribute Instance_Spec.

2010-10-11  Arnaud Charlet  <charlet@adacore.com>

	* gnat1drv.adb (Adjust_Global_Switches): Disable codepeer mode if
	checking syntax only or in ASIS mode.

2010-10-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Check_Delayed_Subprogram): Abstract subprograms may also
	need a freeze node if some type in the profile has one.
	* gcc-interface/trans.c (case N_Abstract_Subprogram_Declaration): If
	entity has a freeze node, defer elaboration.

2010-10-11  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Check_Aggregate_Project): Add support for finding all
	aggregated projects.

From-SVN: r165287
parent ae6ede77
2010-10-11 Javier Miranda <miranda@adacore.com>
* sem_ch10.adb (Analyze_With_Clause): Add missing test to ensure
availability of attribute Instance_Spec.
2010-10-11 Arnaud Charlet <charlet@adacore.com>
* gnat1drv.adb (Adjust_Global_Switches): Disable codepeer mode if
checking syntax only or in ASIS mode.
2010-10-11 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Check_Delayed_Subprogram): Abstract subprograms may also
need a freeze node if some type in the profile has one.
* gcc-interface/trans.c (case N_Abstract_Subprogram_Declaration): If
entity has a freeze node, defer elaboration.
2010-10-11 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb (Check_Aggregate_Project): Add support for finding all
aggregated projects.
2010-10-11 Ed Schonberg <schonberg@adacore.com> 2010-10-11 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Entry_Call): Generate 's' reference for entry * sem_res.adb (Resolve_Entry_Call): Generate 's' reference for entry
......
...@@ -5011,10 +5011,14 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -5011,10 +5011,14 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Abstract_Subprogram_Declaration: case N_Abstract_Subprogram_Declaration:
/* This subprogram doesn't exist for code generation purposes, but we /* This subprogram doesn't exist for code generation purposes, but we
have to elaborate the types of any parameters and result, unless have to elaborate the types of any parameters and result, unless
they are imported types (nothing to generate in this case). */ they are imported types (nothing to generate in this case).
/* Process the parameter types first. */ The parameter list may contain types with freeze nodes, e.g. not null
subtypes, so the subprogram itself may carry a freeze node, in which
case its elaboration must be deferred. */
/* Process the parameter types first. */
if (No (Freeze_Node (Defining_Entity (Specification (gnat_node)))))
for (gnat_temp for (gnat_temp
= First_Formal_With_Extras = First_Formal_With_Extras
(Defining_Entity (Specification (gnat_node))); (Defining_Entity (Specification (gnat_node)));
...@@ -5024,9 +5028,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -5024,9 +5028,7 @@ gnat_to_gnu (Node_Id gnat_node)
&& !From_With_Type (Etype (gnat_temp))) && !From_With_Type (Etype (gnat_temp)))
gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0); gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0);
/* Then the result type, set to Standard_Void_Type for procedures. */ /* Then the result type, set to Standard_Void_Type for procedures. */
{ {
Entity_Id gnat_temp_type Entity_Id gnat_temp_type
= Etype (Defining_Entity (Specification (gnat_node))); = Etype (Defining_Entity (Specification (gnat_node)));
......
...@@ -123,6 +123,13 @@ procedure Gnat1drv is ...@@ -123,6 +123,13 @@ procedure Gnat1drv is
Generate_SCIL := True; Generate_SCIL := True;
end if; end if;
-- Disable CodePeer_Mode in Check_Syntax, since we need front-end
-- expansion.
if Operating_Mode = Check_Syntax then
CodePeer_Mode := False;
end if;
-- Set ASIS mode if -gnatt and -gnatc are set -- Set ASIS mode if -gnatt and -gnatc are set
if Operating_Mode = Check_Semantics and then Tree_Output then if Operating_Mode = Check_Semantics and then Tree_Output then
...@@ -136,10 +143,11 @@ procedure Gnat1drv is ...@@ -136,10 +143,11 @@ procedure Gnat1drv is
Inline_Active := False; Inline_Active := False;
-- Turn off SCIL generation in ASIS mode, since SCIL requires front- -- Turn off SCIL generation and CodePeer mode in semantics mode,
-- end expansion. -- since SCIL requires front-end expansion.
Generate_SCIL := False; Generate_SCIL := False;
CodePeer_Mode := False;
end if; end if;
-- SCIL mode needs to disable front-end inlining since the generated -- SCIL mode needs to disable front-end inlining since the generated
...@@ -160,10 +168,6 @@ procedure Gnat1drv is ...@@ -160,10 +168,6 @@ procedure Gnat1drv is
Front_End_Inlining := False; Front_End_Inlining := False;
Inline_Active := False; Inline_Active := False;
-- Turn off ASIS mode: incompatible with front-end expansion
ASIS_Mode := False;
-- Disable front-end optimizations, to keep the tree as close to the -- Disable front-end optimizations, to keep the tree as close to the
-- source code as possible, and also to avoid inconsistencies between -- source code as possible, and also to avoid inconsistencies between
-- trees when using different optimization switches. -- trees when using different optimization switches.
......
...@@ -43,6 +43,7 @@ with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; ...@@ -43,6 +43,7 @@ with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
with GNAT.Case_Util; use GNAT.Case_Util; with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Dynamic_HTables; with GNAT.Dynamic_HTables;
with GNAT.Regexp; use GNAT.Regexp;
with GNAT.Table; with GNAT.Table;
package body Prj.Nmsc is package body Prj.Nmsc is
...@@ -213,12 +214,10 @@ package body Prj.Nmsc is ...@@ -213,12 +214,10 @@ package body Prj.Nmsc is
-- as appropriate. -- as appropriate.
type Search_Type is (Search_Files, Search_Directories); type Search_Type is (Search_Files, Search_Directories);
pragma Unreferenced (Search_Files);
generic generic
with procedure Callback with procedure Callback
(Path_Id : Path_Name_Type; (Path : Path_Information;
Display_Path_Id : Path_Name_Type;
Pattern_Index : Natural); Pattern_Index : Natural);
procedure Expand_Subdirectory_Pattern procedure Expand_Subdirectory_Pattern
(Project : Project_Id; (Project : Project_Id;
...@@ -315,7 +314,8 @@ package body Prj.Nmsc is ...@@ -315,7 +314,8 @@ package body Prj.Nmsc is
procedure Check_Aggregate_Project procedure Check_Aggregate_Project
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data); Data : in out Tree_Processing_Data);
-- Check aggregate projects attributes -- Check aggregate projects attributes, and find the list of aggregated
-- projects. They are stored as a "project_files" language in Project.
procedure Check_Abstract_Project procedure Check_Abstract_Project
(Project : Project_Id; (Project : Project_Id;
...@@ -920,6 +920,25 @@ package body Prj.Nmsc is ...@@ -920,6 +920,25 @@ package body Prj.Nmsc is
(Snames.Name_Project_Files, (Snames.Name_Project_Files,
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Data.Tree);
procedure Found_Project_File (Path : Path_Information; Rank : Natural);
procedure Expand_Project_Files is new Expand_Subdirectory_Pattern
(Callback => Found_Project_File);
------------------------
-- Found_Project_File --
------------------------
procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
pragma Unreferenced (Rank);
begin
if Current_Verbosity = High then
Write_Str (" Aggregates:");
Write_Line (Get_Name_String (Path.Display_Name));
end if;
end Found_Project_File;
begin begin
if Project_Files.Default then if Project_Files.Default then
Error_Msg_Name_1 := Snames.Name_Project_Files; Error_Msg_Name_1 := Snames.Name_Project_Files;
...@@ -927,7 +946,21 @@ package body Prj.Nmsc is ...@@ -927,7 +946,21 @@ package body Prj.Nmsc is
(Data.Flags, (Data.Flags,
"Attribute %% must be specified in aggregate project", "Attribute %% must be specified in aggregate project",
Project.Location, Project); Project.Location, Project);
return;
end if; end if;
-- Look for aggregated projects. For similarity with source files and
-- dirs, the aggregated project files are not searched for on the
-- project path, and are only found through the path specified in
-- the Project_Files attribute.
Expand_Project_Files
(Project => Project,
Data => Data,
Patterns => Project_Files.Values,
Search_For => Search_Files,
Resolve_Links => Opt.Follow_Links_For_Files);
end Check_Aggregate_Project; end Check_Aggregate_Project;
---------------------------- ----------------------------
...@@ -988,8 +1021,15 @@ package body Prj.Nmsc is ...@@ -988,8 +1021,15 @@ package body Prj.Nmsc is
Initialize (Prj_Data, Project); Initialize (Prj_Data, Project);
Check_If_Externally_Built (Project, Data); Check_If_Externally_Built (Project, Data);
Get_Directories (Project, Data);
Check_Programming_Languages (Project, Data); if Project.Qualifier /= Aggregate then
Get_Directories (Project, Data);
Check_Programming_Languages (Project, Data);
if Current_Verbosity = High then
Show_Source_Dirs (Project, Data.Tree);
end if;
end if;
case Project.Qualifier is case Project.Qualifier is
when Aggregate => Check_Aggregate_Project (Project, Data); when Aggregate => Check_Aggregate_Project (Project, Data);
...@@ -1003,26 +1043,20 @@ package body Prj.Nmsc is ...@@ -1003,26 +1043,20 @@ package body Prj.Nmsc is
Check_Configuration (Project, Data); Check_Configuration (Project, Data);
Check_Library_Attributes (Project, Data);
if Current_Verbosity = High then
Show_Source_Dirs (Project, Data.Tree);
end if;
Check_Package_Naming (Project, Data);
if Project.Qualifier /= Aggregate then if Project.Qualifier /= Aggregate then
Check_Library_Attributes (Project, Data);
Check_Package_Naming (Project, Data);
Look_For_Sources (Prj_Data, Data); Look_For_Sources (Prj_Data, Data);
end if; Check_Interfaces (Project, Data);
Check_Interfaces (Project, Data); if Project.Library then
Check_Stand_Alone_Library (Project, Data);
end if;
if Project.Library then Get_Mains (Project, Data);
Check_Stand_Alone_Library (Project, Data);
end if; end if;
Get_Mains (Project, Data);
Free (Prj_Data); Free (Prj_Data);
end Check; end Check;
...@@ -4928,9 +4962,7 @@ package body Prj.Nmsc is ...@@ -4928,9 +4962,7 @@ package body Prj.Nmsc is
Remove_Source_Dirs : Boolean := False; Remove_Source_Dirs : Boolean := False;
procedure Add_To_Or_Remove_From_Source_Dirs procedure Add_To_Or_Remove_From_Source_Dirs
(Path_Id : Path_Name_Type; (Path : Path_Information; Rank : Natural);
Display_Path_Id : Path_Name_Type;
Rank : Natural);
-- When Removed = False, the directory Path_Id to the list of -- When Removed = False, the directory Path_Id to the list of
-- source_dirs if not already in the list. When Removed = True, -- source_dirs if not already in the list. When Removed = True,
-- removed directory Path_Id if in the list. -- removed directory Path_Id if in the list.
...@@ -4943,9 +4975,7 @@ package body Prj.Nmsc is ...@@ -4943,9 +4975,7 @@ package body Prj.Nmsc is
--------------------------------------- ---------------------------------------
procedure Add_To_Or_Remove_From_Source_Dirs procedure Add_To_Or_Remove_From_Source_Dirs
(Path_Id : Path_Name_Type; (Path : Path_Information; Rank : Natural)
Display_Path_Id : Path_Name_Type;
Rank : Natural)
is is
List : String_List_Id; List : String_List_Id;
Prev : String_List_Id; Prev : String_List_Id;
...@@ -4960,7 +4990,7 @@ package body Prj.Nmsc is ...@@ -4960,7 +4990,7 @@ package body Prj.Nmsc is
Rank_List := Project.Source_Dir_Ranks; Rank_List := Project.Source_Dir_Ranks;
while List /= Nil_String loop while List /= Nil_String loop
Element := Data.Tree.String_Elements.Table (List); Element := Data.Tree.String_Elements.Table (List);
exit when Element.Value = Name_Id (Path_Id); exit when Element.Value = Name_Id (Path.Name);
Prev := List; Prev := List;
List := Element.Next; List := Element.Next;
Prev_Rank := Rank_List; Prev_Rank := Rank_List;
...@@ -4972,14 +5002,14 @@ package body Prj.Nmsc is ...@@ -4972,14 +5002,14 @@ package body Prj.Nmsc is
if not Remove_Source_Dirs and then List = Nil_String then if not Remove_Source_Dirs and then List = Nil_String then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" Adding Source Dir="); Write_Str (" Adding Source Dir=");
Write_Line (Get_Name_String (Display_Path_Id)); Write_Line (Get_Name_String (Path.Display_Name));
end if; end if;
String_Element_Table.Increment_Last (Data.Tree.String_Elements); String_Element_Table.Increment_Last (Data.Tree.String_Elements);
Element := Element :=
(Value => Name_Id (Path_Id), (Value => Name_Id (Path.Name),
Index => 0, Index => 0,
Display_Value => Name_Id (Display_Path_Id), Display_Value => Name_Id (Path.Display_Name),
Location => No_Location, Location => No_Location,
Flag => False, Flag => False,
Next => Nil_String); Next => Nil_String);
...@@ -5207,8 +5237,8 @@ package body Prj.Nmsc is ...@@ -5207,8 +5237,8 @@ package body Prj.Nmsc is
Remove_Source_Dirs := False; Remove_Source_Dirs := False;
Add_To_Or_Remove_From_Source_Dirs Add_To_Or_Remove_From_Source_Dirs
(Path_Id => Project.Directory.Name, (Path => (Name => Project.Directory.Name,
Display_Path_Id => Project.Directory.Display_Name, Display_Name => Project.Directory.Display_Name),
Rank => 1); Rank => 1);
else else
...@@ -6706,7 +6736,6 @@ package body Prj.Nmsc is ...@@ -6706,7 +6736,6 @@ package body Prj.Nmsc is
Search_For : Search_Type; Search_For : Search_Type;
Resolve_Links : Boolean) Resolve_Links : Boolean)
is is
pragma Unreferenced (Search_For);
package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Boolean, Element => Boolean,
...@@ -6718,61 +6747,102 @@ package body Prj.Nmsc is ...@@ -6718,61 +6747,102 @@ package body Prj.Nmsc is
-- several times, and to avoid cycles that may be introduced by symbolic -- several times, and to avoid cycles that may be introduced by symbolic
-- links. -- links.
File_Pattern : GNAT.Regexp.Regexp;
-- Pattern to use when matching file names.
Visited : Recursive_Dirs.Instance; Visited : Recursive_Dirs.Instance;
procedure Find_Pattern procedure Find_Pattern
(Pattern : String; Rank : Natural; Location : Source_Ptr); (Pattern_Id : Name_Id; Rank : Natural; Location : Source_Ptr);
-- Find a specific pattern -- Find a specific pattern
procedure Recursive_Find_Dirs (Normalized_Path : String; Rank : Natural); function Recursive_Find_Dirs
-- Search all the subdirectories (recursively) of Path (Path : Path_Information; Rank : Natural) return Boolean;
-- Search all the subdirectories (recursively) of Path.
-- Return True if at least one file or directory was processed
procedure Check_Directory_And_Subdirs function Subdirectory_Matches
(Directory : String; (Path : Path_Information; Rank : Natural) return Boolean;
Include_Subdirs : Boolean; -- Called when a matching directory was found. If the user is in fact
Rank : Natural; -- searching for files, we then search for those files matching the
Location : Source_Ptr); -- pattern within the directory.
-- Make sur that Directory exists (and if not report an error/warning -- Return True if at least one file or directory was processed
-- message depending on the flags.
-- Calls Callback for Directory itself and all its subdirectories if --------------------------
-- Include_Subdirs is True). -- Subdirectory_Matches --
--------------------------
function Subdirectory_Matches
(Path : Path_Information; Rank : Natural) return Boolean
is
Dir : Dir_Type;
Name : String (1 .. 250);
Last : Natural;
Found : Path_Information;
Success : Boolean := False;
begin
case Search_For is
when Search_Directories =>
Callback (Path, Rank);
return True;
when Search_Files =>
Open (Dir, Get_Name_String (Path.Display_Name));
loop
Read (Dir, Name, Last);
exit when Last = 0;
if Name (Name'First .. Last) /= "."
and then Name (Name'First .. Last) /= ".."
and then Match (Name (Name'First .. Last), File_Pattern)
then
Get_Name_String (Path.Display_Name);
Add_Str_To_Name_Buffer (Name (Name'First .. Last));
Found.Display_Name := Name_Find;
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Found.Name := Name_Find;
Callback (Found, Rank);
Success := True;
end if;
end loop;
Close (Dir);
return Success;
end case;
end Subdirectory_Matches;
------------------------- -------------------------
-- Recursive_Find_Dirs -- -- Recursive_Find_Dirs --
------------------------- -------------------------
procedure Recursive_Find_Dirs function Recursive_Find_Dirs
(Normalized_Path : String; Rank : Natural) (Path : Path_Information; Rank : Natural) return Boolean
is is
Dir : Dir_Type; Path_Str : constant String := Get_Name_String (Path.Display_Name);
Name : String (1 .. 250); Dir : Dir_Type;
Last : Natural; Name : String (1 .. 250);
Last : Natural;
Non_Canonical_Path : Path_Name_Type := No_Path; Success : Boolean := False;
Canonical_Path : Path_Name_Type := No_Path;
The_Path_Last : constant Natural :=
Compute_Directory_Last (Normalized_Path);
begin begin
Name_Len := 0; if Current_Verbosity = High then
Add_Str_To_Name_Buffer Write_Str (" Looking for subdirs of """);
(Normalized_Path (Normalized_Path'First .. The_Path_Last)); Write_Str (Path_Str);
Non_Canonical_Path := Name_Find; Write_Line ("""");
end if;
Canonical_Path :=
Path_Name_Type
(Canonical_Case_File_Name (Name_Id (Non_Canonical_Path)));
if Recursive_Dirs.Get (Visited, Canonical_Path) then if Recursive_Dirs.Get (Visited, Path.Name) then
return; return Success;
end if; end if;
Recursive_Dirs.Set (Visited, Canonical_Path, True); Recursive_Dirs.Set (Visited, Path.Name, True);
Callback (Canonical_Path, Non_Canonical_Path, Rank); Success := Subdirectory_Matches (Path, Rank) or Success;
Open (Dir, Normalized_Path (Normalized_Path'First .. The_Path_Last)); Open (Dir, Path_Str);
loop loop
Read (Dir, Name, Last); Read (Dir, Name, Last);
...@@ -6781,23 +6851,24 @@ package body Prj.Nmsc is ...@@ -6781,23 +6851,24 @@ package body Prj.Nmsc is
if Name (1 .. Last) /= "." if Name (1 .. Last) /= "."
and then Name (1 .. Last) /= ".." and then Name (1 .. Last) /= ".."
then then
if Current_Verbosity = High then
Write_Str (" Checking ");
Write_Line (Name (1 .. Last));
end if;
declare declare
Path_Name : constant String := Path_Name : constant String :=
Normalize_Pathname Normalize_Pathname
(Name => Name (1 .. Last), (Name => Name (1 .. Last),
Directory => Directory => Path_Str,
Normalized_Path
(Normalized_Path'First .. The_Path_Last),
Resolve_Links => Resolve_Links) Resolve_Links => Resolve_Links)
& Directory_Separator; & Directory_Separator;
Path2 : Path_Information;
begin begin
if Is_Directory (Path_Name) then if Is_Directory (Path_Name) then
Recursive_Find_Dirs (Path_Name, Rank); Name_Len := 0;
Add_Str_To_Name_Buffer (Path_Name);
Path2.Display_Name := Name_Find;
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Path2.Name := Name_Find;
Success := Recursive_Find_Dirs (Path2, Rank) or Success;
end if; end if;
end; end;
end if; end if;
...@@ -6805,28 +6876,88 @@ package body Prj.Nmsc is ...@@ -6805,28 +6876,88 @@ package body Prj.Nmsc is
Close (Dir); Close (Dir);
return Success;
exception exception
when Directory_Error => when Directory_Error =>
null; return Success;
end Recursive_Find_Dirs; end Recursive_Find_Dirs;
--------------------------------- ------------------
-- Check_Directory_And_Subdirs -- -- Find_Pattern --
--------------------------------- ------------------
procedure Check_Directory_And_Subdirs procedure Find_Pattern
(Directory : String; (Pattern_Id : Name_Id; Rank : Natural; Location : Source_Ptr)
Include_Subdirs : Boolean;
Rank : Natural;
Location : Source_Ptr)
is is
Dir : File_Name_Type; Pattern : constant String := Get_Name_String (Pattern_Id);
Path_Name : Path_Information; Pattern_End : Natural := Pattern'Last;
Dir_Exists : Boolean; Recursive : Boolean;
Has_Error : Boolean := False; Dir : File_Name_Type;
Path_Name : Path_Information;
Dir_Exists : Boolean;
Has_Error : Boolean := False;
Success : Boolean;
begin begin
Name_Len := Directory'Length; if Current_Verbosity = High then
Name_Buffer (1 .. Name_Len) := Directory; Write_Str ("Expand_Subdirectory_Pattern (""");
Write_Str (Pattern);
Write_Line (""")");
end if;
-- If we are looking for files, find the pattern for the files
if Search_For = Search_Files then
while Pattern_End >= Pattern'First
and then Pattern (Pattern_End) /= '/'
and then Pattern (Pattern_End) /= Directory_Separator
loop
Pattern_End := Pattern_End - 1;
end loop;
if Pattern_End = Pattern'Last then
Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
Error_Or_Warning
(Data.Flags, Data.Flags.Missing_Source_Files,
"Missing file name or pattern in {", Location, Project);
return;
end if;
if Current_Verbosity = High then
Write_Str (" file pattern=");
Write_Line (Pattern (Pattern_End + 1 .. Pattern'Last));
Write_Str (" Expand directory pattern=");
Write_Line (Pattern (Pattern'First .. Pattern_End));
end if;
File_Pattern := Compile
(Pattern (Pattern_End + 1 .. Pattern'Last),
Glob => True,
Case_Sensitive => File_Names_Case_Sensitive);
-- If we had just "*.gpr", this is equivalent to "./*.gpr"
if Pattern_End > Pattern'First then
Pattern_End := Pattern_End - 1; -- Skip directory separator
end if;
end if;
Recursive :=
Pattern_End - 1 >= Pattern'First
and then Pattern (Pattern_End - 1 .. Pattern_End) = "**"
and then (Pattern_End - 1 = Pattern'First
or else Pattern (Pattern_End - 2) = '/'
or else Pattern (Pattern_End - 2) = Directory_Separator);
if Recursive then
Pattern_End := Pattern_End - 2;
if Pattern_End > Pattern'First then
Pattern_End := Pattern_End - 1; -- Skip '/'
end if;
end if;
Name_Len := Pattern_End - Pattern'First + 1;
Name_Buffer (1 .. Name_Len) := Pattern (Pattern'First .. Pattern_End);
Dir := Name_Find; Dir := Name_Find;
Locate_Directory Locate_Directory
...@@ -6849,58 +6980,24 @@ package body Prj.Nmsc is ...@@ -6849,58 +6980,24 @@ package body Prj.Nmsc is
-- Links have been resolved if necessary, and Path_Name -- Links have been resolved if necessary, and Path_Name
-- always ends with a directory separator. -- always ends with a directory separator.
if Include_Subdirs then if Recursive then
if Current_Verbosity = High then Success := Recursive_Find_Dirs (Path_Name, Rank);
Write_Str ("Looking for all subdirectories of """);
Write_Str (Directory);
Write_Line ("""");
end if;
Recursive_Find_Dirs (Get_Name_String (Path_Name.Name), Rank);
if Current_Verbosity = High then
Write_Line ("End of looking for source directories.");
end if;
else else
Callback (Path_Name.Name, Path_Name.Display_Name, Rank); Success := Subdirectory_Matches (Path_Name, Rank);
end if; end if;
end if;
end Check_Directory_And_Subdirs;
------------------
-- Find_Pattern --
------------------
procedure Find_Pattern if not Success then
(Pattern : String; Rank : Natural; Location : Source_Ptr) is case Search_For is
begin when Search_Directories =>
if Current_Verbosity = High then null; -- Error can't occur
Write_Str ("Expand_Subdirectory_Pattern (""");
Write_Str (Pattern);
Write_Line (""")");
end if;
-- First, check if we are looking for a directory tree, indicated when Search_Files =>
-- by "/**" at the end. Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
Error_Or_Warning
if Pattern'Length >= 3 (Data.Flags, Data.Flags.Missing_Source_Files,
and then Pattern (Pattern'Last - 1 .. Pattern'Last) = "**" "file { not found", Location, Project);
and then (Pattern (Pattern'Last - 2) = '/' end case;
or else Pattern (Pattern'Last - 2) = Directory_Separator)
then
if Pattern'Length = 3 then
-- Case of "/**": all directories in file system
Check_Directory_And_Subdirs
(Pattern (Pattern'First .. Pattern'First),
True, Rank, Location);
else
Check_Directory_And_Subdirs
(Pattern (Pattern'First .. Pattern'Last - 3),
True, Rank, Location);
end if; end if;
else
Check_Directory_And_Subdirs (Pattern, False, Rank, Location);
end if; end if;
end Find_Pattern; end Find_Pattern;
...@@ -6912,8 +7009,7 @@ package body Prj.Nmsc is ...@@ -6912,8 +7009,7 @@ package body Prj.Nmsc is
begin begin
while Pattern_Id /= Nil_String loop while Pattern_Id /= Nil_String loop
Element := Data.Tree.String_Elements.Table (Pattern_Id); Element := Data.Tree.String_Elements.Table (Pattern_Id);
Find_Pattern Find_Pattern (Element.Value, Rank, Element.Location);
(Get_Name_String (Element.Value), Rank, Element.Location);
Rank := Rank + 1; Rank := Rank + 1;
Pattern_Id := Element.Next; Pattern_Id := Element.Next;
end loop; end loop;
......
...@@ -2490,6 +2490,7 @@ package body Sem_Ch10 is ...@@ -2490,6 +2490,7 @@ package body Sem_Ch10 is
elsif Unit_Kind = N_Package_Instantiation elsif Unit_Kind = N_Package_Instantiation
and then Nkind (U) = N_Package_Instantiation and then Nkind (U) = N_Package_Instantiation
and then Present (Instance_Spec (U))
then then
-- If the instance has not been rewritten as a package declaration, -- If the instance has not been rewritten as a package declaration,
-- then it appeared already in a previous with clause. Retrieve -- then it appeared already in a previous with clause. Retrieve
......
...@@ -4240,29 +4240,21 @@ package body Sem_Ch6 is ...@@ -4240,29 +4240,21 @@ package body Sem_Ch6 is
-- Start of processing for Check_Delayed_Subprogram -- Start of processing for Check_Delayed_Subprogram
begin begin
-- Never need to freeze abstract subprogram -- All subprograms, including abstract subprograms, may need a freeze
-- node if some formal type or the return type needs one.
if Ekind (Designator) /= E_Subprogram_Type Possible_Freeze (Etype (Designator));
and then Is_Abstract_Subprogram (Designator) Possible_Freeze (Base_Type (Etype (Designator))); -- needed ???
then
null;
else
-- Need delayed freeze if return type itself needs a delayed
-- freeze and is not yet frozen.
Possible_Freeze (Etype (Designator)); -- Need delayed freeze if any of the formal types themselves need
Possible_Freeze (Base_Type (Etype (Designator))); -- needed ??? -- a delayed freeze and are not yet frozen.
-- Need delayed freeze if any of the formal types themselves need F := First_Formal (Designator);
-- a delayed freeze and are not yet frozen. while Present (F) loop
Possible_Freeze (Etype (F));
F := First_Formal (Designator); Possible_Freeze (Base_Type (Etype (F))); -- needed ???
while Present (F) loop Next_Formal (F);
Possible_Freeze (Etype (F)); end loop;
Possible_Freeze (Base_Type (Etype (F))); -- needed ???
Next_Formal (F);
end loop;
end if;
-- Mark functions that return by reference. Note that it cannot be -- Mark functions that return by reference. Note that it cannot be
-- done for delayed_freeze subprograms because the underlying -- done for delayed_freeze subprograms because the underlying
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment