[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
This commit is contained in:
Arnaud Charlet
parent
ae6ede7778
commit
76e3504fad
|
|
@ -1,3 +1,25 @@
|
|||
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>
|
||||
|
||||
* sem_res.adb (Resolve_Entry_Call): Generate 's' reference for entry
|
||||
|
|
|
|||
|
|
@ -5011,10 +5011,14 @@ gnat_to_gnu (Node_Id gnat_node)
|
|||
case N_Abstract_Subprogram_Declaration:
|
||||
/* This subprogram doesn't exist for code generation purposes, but we
|
||||
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).
|
||||
|
||||
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
|
||||
= First_Formal_With_Extras
|
||||
(Defining_Entity (Specification (gnat_node)));
|
||||
|
|
@ -5024,9 +5028,7 @@ gnat_to_gnu (Node_Id gnat_node)
|
|||
&& !From_With_Type (Etype (gnat_temp)))
|
||||
gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0);
|
||||
|
||||
|
||||
/* Then the result type, set to Standard_Void_Type for procedures. */
|
||||
|
||||
{
|
||||
Entity_Id gnat_temp_type
|
||||
= Etype (Defining_Entity (Specification (gnat_node)));
|
||||
|
|
|
|||
|
|
@ -123,6 +123,13 @@ procedure Gnat1drv is
|
|||
Generate_SCIL := True;
|
||||
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
|
||||
|
||||
if Operating_Mode = Check_Semantics and then Tree_Output then
|
||||
|
|
@ -136,10 +143,11 @@ procedure Gnat1drv is
|
|||
|
||||
Inline_Active := False;
|
||||
|
||||
-- Turn off SCIL generation in ASIS mode, since SCIL requires front-
|
||||
-- end expansion.
|
||||
-- Turn off SCIL generation and CodePeer mode in semantics mode,
|
||||
-- since SCIL requires front-end expansion.
|
||||
|
||||
Generate_SCIL := False;
|
||||
CodePeer_Mode := False;
|
||||
end if;
|
||||
|
||||
-- SCIL mode needs to disable front-end inlining since the generated
|
||||
|
|
@ -160,10 +168,6 @@ procedure Gnat1drv is
|
|||
Front_End_Inlining := 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
|
||||
-- source code as possible, and also to avoid inconsistencies between
|
||||
-- trees when using different optimization switches.
|
||||
|
|
|
|||
|
|
@ -43,6 +43,7 @@ with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
|
|||
with GNAT.Case_Util; use GNAT.Case_Util;
|
||||
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
||||
with GNAT.Dynamic_HTables;
|
||||
with GNAT.Regexp; use GNAT.Regexp;
|
||||
with GNAT.Table;
|
||||
|
||||
package body Prj.Nmsc is
|
||||
|
|
@ -213,12 +214,10 @@ package body Prj.Nmsc is
|
|||
-- as appropriate.
|
||||
|
||||
type Search_Type is (Search_Files, Search_Directories);
|
||||
pragma Unreferenced (Search_Files);
|
||||
|
||||
generic
|
||||
with procedure Callback
|
||||
(Path_Id : Path_Name_Type;
|
||||
Display_Path_Id : Path_Name_Type;
|
||||
(Path : Path_Information;
|
||||
Pattern_Index : Natural);
|
||||
procedure Expand_Subdirectory_Pattern
|
||||
(Project : Project_Id;
|
||||
|
|
@ -315,7 +314,8 @@ package body Prj.Nmsc is
|
|||
procedure Check_Aggregate_Project
|
||||
(Project : Project_Id;
|
||||
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
|
||||
(Project : Project_Id;
|
||||
|
|
@ -920,6 +920,25 @@ package body Prj.Nmsc is
|
|||
(Snames.Name_Project_Files,
|
||||
Project.Decl.Attributes,
|
||||
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
|
||||
if Project_Files.Default then
|
||||
Error_Msg_Name_1 := Snames.Name_Project_Files;
|
||||
|
|
@ -927,7 +946,21 @@ package body Prj.Nmsc is
|
|||
(Data.Flags,
|
||||
"Attribute %% must be specified in aggregate project",
|
||||
Project.Location, Project);
|
||||
return;
|
||||
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;
|
||||
|
||||
----------------------------
|
||||
|
|
@ -988,8 +1021,15 @@ package body Prj.Nmsc is
|
|||
Initialize (Prj_Data, Project);
|
||||
|
||||
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
|
||||
when Aggregate => Check_Aggregate_Project (Project, Data);
|
||||
|
|
@ -1003,26 +1043,20 @@ package body Prj.Nmsc is
|
|||
|
||||
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
|
||||
|
||||
Check_Library_Attributes (Project, Data);
|
||||
Check_Package_Naming (Project, Data);
|
||||
Look_For_Sources (Prj_Data, Data);
|
||||
Check_Interfaces (Project, Data);
|
||||
|
||||
if Project.Library then
|
||||
Check_Stand_Alone_Library (Project, Data);
|
||||
end if;
|
||||
|
||||
Get_Mains (Project, Data);
|
||||
end if;
|
||||
|
||||
Check_Interfaces (Project, Data);
|
||||
|
||||
if Project.Library then
|
||||
Check_Stand_Alone_Library (Project, Data);
|
||||
end if;
|
||||
|
||||
Get_Mains (Project, Data);
|
||||
|
||||
Free (Prj_Data);
|
||||
end Check;
|
||||
|
||||
|
|
@ -4928,9 +4962,7 @@ package body Prj.Nmsc is
|
|||
Remove_Source_Dirs : Boolean := False;
|
||||
|
||||
procedure Add_To_Or_Remove_From_Source_Dirs
|
||||
(Path_Id : Path_Name_Type;
|
||||
Display_Path_Id : Path_Name_Type;
|
||||
Rank : Natural);
|
||||
(Path : Path_Information; Rank : Natural);
|
||||
-- When Removed = False, the directory Path_Id to the list of
|
||||
-- source_dirs if not already in the list. When Removed = True,
|
||||
-- removed directory Path_Id if in the list.
|
||||
|
|
@ -4943,9 +4975,7 @@ package body Prj.Nmsc is
|
|||
---------------------------------------
|
||||
|
||||
procedure Add_To_Or_Remove_From_Source_Dirs
|
||||
(Path_Id : Path_Name_Type;
|
||||
Display_Path_Id : Path_Name_Type;
|
||||
Rank : Natural)
|
||||
(Path : Path_Information; Rank : Natural)
|
||||
is
|
||||
List : String_List_Id;
|
||||
Prev : String_List_Id;
|
||||
|
|
@ -4960,7 +4990,7 @@ package body Prj.Nmsc is
|
|||
Rank_List := Project.Source_Dir_Ranks;
|
||||
while List /= Nil_String loop
|
||||
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;
|
||||
List := Element.Next;
|
||||
Prev_Rank := Rank_List;
|
||||
|
|
@ -4972,14 +5002,14 @@ package body Prj.Nmsc is
|
|||
if not Remove_Source_Dirs and then List = Nil_String then
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" Adding Source Dir=");
|
||||
Write_Line (Get_Name_String (Display_Path_Id));
|
||||
Write_Line (Get_Name_String (Path.Display_Name));
|
||||
end if;
|
||||
|
||||
String_Element_Table.Increment_Last (Data.Tree.String_Elements);
|
||||
Element :=
|
||||
(Value => Name_Id (Path_Id),
|
||||
(Value => Name_Id (Path.Name),
|
||||
Index => 0,
|
||||
Display_Value => Name_Id (Display_Path_Id),
|
||||
Display_Value => Name_Id (Path.Display_Name),
|
||||
Location => No_Location,
|
||||
Flag => False,
|
||||
Next => Nil_String);
|
||||
|
|
@ -5207,8 +5237,8 @@ package body Prj.Nmsc is
|
|||
|
||||
Remove_Source_Dirs := False;
|
||||
Add_To_Or_Remove_From_Source_Dirs
|
||||
(Path_Id => Project.Directory.Name,
|
||||
Display_Path_Id => Project.Directory.Display_Name,
|
||||
(Path => (Name => Project.Directory.Name,
|
||||
Display_Name => Project.Directory.Display_Name),
|
||||
Rank => 1);
|
||||
|
||||
else
|
||||
|
|
@ -6706,7 +6736,6 @@ package body Prj.Nmsc is
|
|||
Search_For : Search_Type;
|
||||
Resolve_Links : Boolean)
|
||||
is
|
||||
pragma Unreferenced (Search_For);
|
||||
package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
|
||||
(Header_Num => Header_Num,
|
||||
Element => Boolean,
|
||||
|
|
@ -6718,61 +6747,102 @@ package body Prj.Nmsc is
|
|||
-- several times, and to avoid cycles that may be introduced by symbolic
|
||||
-- links.
|
||||
|
||||
File_Pattern : GNAT.Regexp.Regexp;
|
||||
-- Pattern to use when matching file names.
|
||||
|
||||
Visited : Recursive_Dirs.Instance;
|
||||
|
||||
procedure Find_Pattern
|
||||
(Pattern : String; Rank : Natural; Location : Source_Ptr);
|
||||
(Pattern_Id : Name_Id; Rank : Natural; Location : Source_Ptr);
|
||||
-- Find a specific pattern
|
||||
|
||||
procedure Recursive_Find_Dirs (Normalized_Path : String; Rank : Natural);
|
||||
-- Search all the subdirectories (recursively) of Path
|
||||
function Recursive_Find_Dirs
|
||||
(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
|
||||
(Directory : String;
|
||||
Include_Subdirs : Boolean;
|
||||
Rank : Natural;
|
||||
Location : Source_Ptr);
|
||||
-- Make sur that Directory exists (and if not report an error/warning
|
||||
-- message depending on the flags.
|
||||
-- Calls Callback for Directory itself and all its subdirectories if
|
||||
-- Include_Subdirs is True).
|
||||
function Subdirectory_Matches
|
||||
(Path : Path_Information; Rank : Natural) return Boolean;
|
||||
-- Called when a matching directory was found. If the user is in fact
|
||||
-- searching for files, we then search for those files matching the
|
||||
-- pattern within the directory.
|
||||
-- Return True if at least one file or directory was processed
|
||||
|
||||
--------------------------
|
||||
-- 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 --
|
||||
-------------------------
|
||||
|
||||
procedure Recursive_Find_Dirs
|
||||
(Normalized_Path : String; Rank : Natural)
|
||||
function Recursive_Find_Dirs
|
||||
(Path : Path_Information; Rank : Natural) return Boolean
|
||||
is
|
||||
Dir : Dir_Type;
|
||||
Name : String (1 .. 250);
|
||||
Last : Natural;
|
||||
|
||||
Non_Canonical_Path : Path_Name_Type := No_Path;
|
||||
Canonical_Path : Path_Name_Type := No_Path;
|
||||
|
||||
The_Path_Last : constant Natural :=
|
||||
Compute_Directory_Last (Normalized_Path);
|
||||
Path_Str : constant String := Get_Name_String (Path.Display_Name);
|
||||
Dir : Dir_Type;
|
||||
Name : String (1 .. 250);
|
||||
Last : Natural;
|
||||
Success : Boolean := False;
|
||||
|
||||
begin
|
||||
Name_Len := 0;
|
||||
Add_Str_To_Name_Buffer
|
||||
(Normalized_Path (Normalized_Path'First .. The_Path_Last));
|
||||
Non_Canonical_Path := Name_Find;
|
||||
|
||||
Canonical_Path :=
|
||||
Path_Name_Type
|
||||
(Canonical_Case_File_Name (Name_Id (Non_Canonical_Path)));
|
||||
|
||||
if Recursive_Dirs.Get (Visited, Canonical_Path) then
|
||||
return;
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" Looking for subdirs of """);
|
||||
Write_Str (Path_Str);
|
||||
Write_Line ("""");
|
||||
end if;
|
||||
|
||||
Recursive_Dirs.Set (Visited, Canonical_Path, True);
|
||||
if Recursive_Dirs.Get (Visited, Path.Name) then
|
||||
return Success;
|
||||
end if;
|
||||
|
||||
Callback (Canonical_Path, Non_Canonical_Path, Rank);
|
||||
Recursive_Dirs.Set (Visited, Path.Name, True);
|
||||
|
||||
Open (Dir, Normalized_Path (Normalized_Path'First .. The_Path_Last));
|
||||
Success := Subdirectory_Matches (Path, Rank) or Success;
|
||||
|
||||
Open (Dir, Path_Str);
|
||||
|
||||
loop
|
||||
Read (Dir, Name, Last);
|
||||
|
|
@ -6781,23 +6851,24 @@ package body Prj.Nmsc is
|
|||
if Name (1 .. Last) /= "."
|
||||
and then Name (1 .. Last) /= ".."
|
||||
then
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" Checking ");
|
||||
Write_Line (Name (1 .. Last));
|
||||
end if;
|
||||
|
||||
declare
|
||||
Path_Name : constant String :=
|
||||
Normalize_Pathname
|
||||
(Name => Name (1 .. Last),
|
||||
Directory =>
|
||||
Normalized_Path
|
||||
(Normalized_Path'First .. The_Path_Last),
|
||||
Directory => Path_Str,
|
||||
Resolve_Links => Resolve_Links)
|
||||
& Directory_Separator;
|
||||
Path2 : Path_Information;
|
||||
begin
|
||||
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;
|
||||
end if;
|
||||
|
|
@ -6805,28 +6876,88 @@ package body Prj.Nmsc is
|
|||
|
||||
Close (Dir);
|
||||
|
||||
return Success;
|
||||
|
||||
exception
|
||||
when Directory_Error =>
|
||||
null;
|
||||
return Success;
|
||||
end Recursive_Find_Dirs;
|
||||
|
||||
---------------------------------
|
||||
-- Check_Directory_And_Subdirs --
|
||||
---------------------------------
|
||||
------------------
|
||||
-- Find_Pattern --
|
||||
------------------
|
||||
|
||||
procedure Check_Directory_And_Subdirs
|
||||
(Directory : String;
|
||||
Include_Subdirs : Boolean;
|
||||
Rank : Natural;
|
||||
Location : Source_Ptr)
|
||||
procedure Find_Pattern
|
||||
(Pattern_Id : Name_Id; Rank : Natural; Location : Source_Ptr)
|
||||
is
|
||||
Dir : File_Name_Type;
|
||||
Path_Name : Path_Information;
|
||||
Dir_Exists : Boolean;
|
||||
Has_Error : Boolean := False;
|
||||
Pattern : constant String := Get_Name_String (Pattern_Id);
|
||||
Pattern_End : Natural := Pattern'Last;
|
||||
Recursive : Boolean;
|
||||
Dir : File_Name_Type;
|
||||
Path_Name : Path_Information;
|
||||
Dir_Exists : Boolean;
|
||||
Has_Error : Boolean := False;
|
||||
Success : Boolean;
|
||||
begin
|
||||
Name_Len := Directory'Length;
|
||||
Name_Buffer (1 .. Name_Len) := Directory;
|
||||
if Current_Verbosity = High then
|
||||
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;
|
||||
|
||||
Locate_Directory
|
||||
|
|
@ -6849,58 +6980,24 @@ package body Prj.Nmsc is
|
|||
-- Links have been resolved if necessary, and Path_Name
|
||||
-- always ends with a directory separator.
|
||||
|
||||
if Include_Subdirs then
|
||||
if Current_Verbosity = High then
|
||||
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;
|
||||
|
||||
if Recursive then
|
||||
Success := Recursive_Find_Dirs (Path_Name, Rank);
|
||||
else
|
||||
Callback (Path_Name.Name, Path_Name.Display_Name, Rank);
|
||||
Success := Subdirectory_Matches (Path_Name, Rank);
|
||||
end if;
|
||||
end if;
|
||||
end Check_Directory_And_Subdirs;
|
||||
|
||||
------------------
|
||||
-- Find_Pattern --
|
||||
------------------
|
||||
if not Success then
|
||||
case Search_For is
|
||||
when Search_Directories =>
|
||||
null; -- Error can't occur
|
||||
|
||||
procedure Find_Pattern
|
||||
(Pattern : String; Rank : Natural; Location : Source_Ptr) is
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Write_Str ("Expand_Subdirectory_Pattern (""");
|
||||
Write_Str (Pattern);
|
||||
Write_Line (""")");
|
||||
end if;
|
||||
|
||||
-- First, check if we are looking for a directory tree, indicated
|
||||
-- by "/**" at the end.
|
||||
|
||||
if Pattern'Length >= 3
|
||||
and then Pattern (Pattern'Last - 1 .. Pattern'Last) = "**"
|
||||
and then (Pattern (Pattern'Last - 2) = '/'
|
||||
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);
|
||||
when Search_Files =>
|
||||
Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
|
||||
Error_Or_Warning
|
||||
(Data.Flags, Data.Flags.Missing_Source_Files,
|
||||
"file { not found", Location, Project);
|
||||
end case;
|
||||
end if;
|
||||
else
|
||||
Check_Directory_And_Subdirs (Pattern, False, Rank, Location);
|
||||
end if;
|
||||
end Find_Pattern;
|
||||
|
||||
|
|
@ -6912,8 +7009,7 @@ package body Prj.Nmsc is
|
|||
begin
|
||||
while Pattern_Id /= Nil_String loop
|
||||
Element := Data.Tree.String_Elements.Table (Pattern_Id);
|
||||
Find_Pattern
|
||||
(Get_Name_String (Element.Value), Rank, Element.Location);
|
||||
Find_Pattern (Element.Value, Rank, Element.Location);
|
||||
Rank := Rank + 1;
|
||||
Pattern_Id := Element.Next;
|
||||
end loop;
|
||||
|
|
|
|||
|
|
@ -2490,6 +2490,7 @@ package body Sem_Ch10 is
|
|||
|
||||
elsif Unit_Kind = N_Package_Instantiation
|
||||
and then Nkind (U) = N_Package_Instantiation
|
||||
and then Present (Instance_Spec (U))
|
||||
then
|
||||
-- If the instance has not been rewritten as a package declaration,
|
||||
-- then it appeared already in a previous with clause. Retrieve
|
||||
|
|
|
|||
|
|
@ -4240,29 +4240,21 @@ package body Sem_Ch6 is
|
|||
-- Start of processing for Check_Delayed_Subprogram
|
||||
|
||||
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
|
||||
and then Is_Abstract_Subprogram (Designator)
|
||||
then
|
||||
null;
|
||||
else
|
||||
-- Need delayed freeze if return type itself needs a delayed
|
||||
-- freeze and is not yet frozen.
|
||||
Possible_Freeze (Etype (Designator));
|
||||
Possible_Freeze (Base_Type (Etype (Designator))); -- needed ???
|
||||
|
||||
Possible_Freeze (Etype (Designator));
|
||||
Possible_Freeze (Base_Type (Etype (Designator))); -- needed ???
|
||||
-- Need delayed freeze if any of the formal types themselves need
|
||||
-- a delayed freeze and are not yet frozen.
|
||||
|
||||
-- Need delayed freeze if any of the formal types themselves need
|
||||
-- a delayed freeze and are not yet frozen.
|
||||
|
||||
F := First_Formal (Designator);
|
||||
while Present (F) loop
|
||||
Possible_Freeze (Etype (F));
|
||||
Possible_Freeze (Base_Type (Etype (F))); -- needed ???
|
||||
Next_Formal (F);
|
||||
end loop;
|
||||
end if;
|
||||
F := First_Formal (Designator);
|
||||
while Present (F) loop
|
||||
Possible_Freeze (Etype (F));
|
||||
Possible_Freeze (Base_Type (Etype (F))); -- needed ???
|
||||
Next_Formal (F);
|
||||
end loop;
|
||||
|
||||
-- Mark functions that return by reference. Note that it cannot be
|
||||
-- done for delayed_freeze subprograms because the underlying
|
||||
|
|
|
|||
Loading…
Reference in New Issue