[multiple changes]
2011-08-03 Gary Dismukes <dismukes@adacore.com> * sem_ch3.adb (Build_Derived_Record_Type): Test the Derive_Subps formal as a condition for the delayed call to Derived_Subprograms done for the case of the rewriting of a derived type that constrains the discriminants of its parent type. Avoids redundant subprogram derivations for private subtype derivations. 2011-08-03 Javier Miranda <miranda@adacore.com> * exp_aggr.adb (Init_Hidden_Discriminants): New subprogram of Build_Record_Aggr_Code. (Build_Record_Aggr_Code): Add missing support to initialize hidden discriminants in extension aggregates. 2011-08-03 Emmanuel Briot <briot@adacore.com> * prj-pp.adb (Print): also output project qualifiers, since in particular "aggregate" is mandatory in an aggregate project. 2011-08-03 Emmanuel Briot <briot@adacore.com> * prj-part.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb: (Debug_Output): new function. From-SVN: r177240
This commit is contained in:
parent
56e941863b
commit
3e5828693d
|
@ -1,3 +1,28 @@
|
||||||
|
2011-08-03 Gary Dismukes <dismukes@adacore.com>
|
||||||
|
|
||||||
|
* sem_ch3.adb (Build_Derived_Record_Type): Test the Derive_Subps formal
|
||||||
|
as a condition for the delayed call to Derived_Subprograms done for the
|
||||||
|
case of the rewriting of a derived type that constrains the
|
||||||
|
discriminants of its parent type.
|
||||||
|
Avoids redundant subprogram derivations for private subtype derivations.
|
||||||
|
|
||||||
|
2011-08-03 Javier Miranda <miranda@adacore.com>
|
||||||
|
|
||||||
|
* exp_aggr.adb (Init_Hidden_Discriminants): New subprogram of
|
||||||
|
Build_Record_Aggr_Code.
|
||||||
|
(Build_Record_Aggr_Code): Add missing support to initialize hidden
|
||||||
|
discriminants in extension aggregates.
|
||||||
|
|
||||||
|
2011-08-03 Emmanuel Briot <briot@adacore.com>
|
||||||
|
|
||||||
|
* prj-pp.adb (Print): also output project qualifiers, since in
|
||||||
|
particular "aggregate" is mandatory in an aggregate project.
|
||||||
|
|
||||||
|
2011-08-03 Emmanuel Briot <briot@adacore.com>
|
||||||
|
|
||||||
|
* prj-part.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb:
|
||||||
|
(Debug_Output): new function.
|
||||||
|
|
||||||
2011-08-03 Eric Botcazou <ebotcazou@adacore.com>
|
2011-08-03 Eric Botcazou <ebotcazou@adacore.com>
|
||||||
|
|
||||||
* gnat_ugn.texi: Document -Wstack-usage.
|
* gnat_ugn.texi: Document -Wstack-usage.
|
||||||
|
|
|
@ -1854,6 +1854,11 @@ package body Exp_Aggr is
|
||||||
-- to finalization list F. Init_Pr conditions the call to the init proc
|
-- to finalization list F. Init_Pr conditions the call to the init proc
|
||||||
-- since it may already be done due to ancestor initialization.
|
-- since it may already be done due to ancestor initialization.
|
||||||
|
|
||||||
|
procedure Init_Hidden_Discriminants (Typ : Entity_Id; List : List_Id);
|
||||||
|
-- If Typ is derived, and constrains discriminants of the parent type,
|
||||||
|
-- these discriminants are not components of the aggregate, and must be
|
||||||
|
-- initialized. The assignments are appended to List.
|
||||||
|
|
||||||
function Is_Int_Range_Bounds (Bounds : Node_Id) return Boolean;
|
function Is_Int_Range_Bounds (Bounds : Node_Id) return Boolean;
|
||||||
-- Check whether Bounds is a range node and its lower and higher bounds
|
-- Check whether Bounds is a range node and its lower and higher bounds
|
||||||
-- are integers literals.
|
-- are integers literals.
|
||||||
|
@ -2156,6 +2161,56 @@ package body Exp_Aggr is
|
||||||
return L;
|
return L;
|
||||||
end Init_Controller;
|
end Init_Controller;
|
||||||
|
|
||||||
|
-------------------------------
|
||||||
|
-- Init_Hidden_Discriminants --
|
||||||
|
-------------------------------
|
||||||
|
|
||||||
|
procedure Init_Hidden_Discriminants (Typ : Entity_Id; List : List_Id) is
|
||||||
|
Btype : Entity_Id;
|
||||||
|
Parent_Type : Entity_Id;
|
||||||
|
Disc : Entity_Id;
|
||||||
|
Discr_Val : Elmt_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Btype := Base_Type (Typ);
|
||||||
|
while Is_Derived_Type (Btype)
|
||||||
|
and then Present (Stored_Constraint (Btype))
|
||||||
|
loop
|
||||||
|
Parent_Type := Etype (Btype);
|
||||||
|
|
||||||
|
Disc := First_Discriminant (Parent_Type);
|
||||||
|
Discr_Val := First_Elmt (Stored_Constraint (Base_Type (Typ)));
|
||||||
|
while Present (Discr_Val) loop
|
||||||
|
|
||||||
|
-- Only those discriminants of the parent that are not
|
||||||
|
-- renamed by discriminants of the derived type need to
|
||||||
|
-- be added explicitly.
|
||||||
|
|
||||||
|
if not Is_Entity_Name (Node (Discr_Val))
|
||||||
|
or else Ekind (Entity (Node (Discr_Val))) /= E_Discriminant
|
||||||
|
then
|
||||||
|
Comp_Expr :=
|
||||||
|
Make_Selected_Component (Loc,
|
||||||
|
Prefix => New_Copy_Tree (Target),
|
||||||
|
Selector_Name => New_Occurrence_Of (Disc, Loc));
|
||||||
|
|
||||||
|
Instr :=
|
||||||
|
Make_OK_Assignment_Statement (Loc,
|
||||||
|
Name => Comp_Expr,
|
||||||
|
Expression => New_Copy_Tree (Node (Discr_Val)));
|
||||||
|
|
||||||
|
Set_No_Ctrl_Actions (Instr);
|
||||||
|
Append_To (List, Instr);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Next_Discriminant (Disc);
|
||||||
|
Next_Elmt (Discr_Val);
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
Btype := Base_Type (Parent_Type);
|
||||||
|
end loop;
|
||||||
|
end Init_Hidden_Discriminants;
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
-- Is_Int_Range_Bounds --
|
-- Is_Int_Range_Bounds --
|
||||||
-------------------------
|
-------------------------
|
||||||
|
@ -2741,6 +2796,17 @@ package body Exp_Aggr is
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
-- Generate assignments of hidden assignments. If the base type is an
|
||||||
|
-- unchecked union, the discriminants are unknown to the back-end and
|
||||||
|
-- absent from a value of the type, so assignments for them are not
|
||||||
|
-- emitted.
|
||||||
|
|
||||||
|
if Has_Discriminants (Typ)
|
||||||
|
and then not Is_Unchecked_Union (Base_Type (Typ))
|
||||||
|
then
|
||||||
|
Init_Hidden_Discriminants (Typ, L);
|
||||||
|
end if;
|
||||||
|
|
||||||
-- Normal case (not an extension aggregate)
|
-- Normal case (not an extension aggregate)
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -2752,59 +2818,7 @@ package body Exp_Aggr is
|
||||||
if Has_Discriminants (Typ)
|
if Has_Discriminants (Typ)
|
||||||
and then not Is_Unchecked_Union (Base_Type (Typ))
|
and then not Is_Unchecked_Union (Base_Type (Typ))
|
||||||
then
|
then
|
||||||
-- If the type is derived, and constrains discriminants of the
|
Init_Hidden_Discriminants (Typ, L);
|
||||||
-- parent type, these discriminants are not components of the
|
|
||||||
-- aggregate, and must be initialized explicitly. They are not
|
|
||||||
-- visible components of the object, but can become visible with
|
|
||||||
-- a view conversion to the ancestor.
|
|
||||||
|
|
||||||
declare
|
|
||||||
Btype : Entity_Id;
|
|
||||||
Parent_Type : Entity_Id;
|
|
||||||
Disc : Entity_Id;
|
|
||||||
Discr_Val : Elmt_Id;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Btype := Base_Type (Typ);
|
|
||||||
while Is_Derived_Type (Btype)
|
|
||||||
and then Present (Stored_Constraint (Btype))
|
|
||||||
loop
|
|
||||||
Parent_Type := Etype (Btype);
|
|
||||||
|
|
||||||
Disc := First_Discriminant (Parent_Type);
|
|
||||||
Discr_Val :=
|
|
||||||
First_Elmt (Stored_Constraint (Base_Type (Typ)));
|
|
||||||
while Present (Discr_Val) loop
|
|
||||||
|
|
||||||
-- Only those discriminants of the parent that are not
|
|
||||||
-- renamed by discriminants of the derived type need to
|
|
||||||
-- be added explicitly.
|
|
||||||
|
|
||||||
if not Is_Entity_Name (Node (Discr_Val))
|
|
||||||
or else
|
|
||||||
Ekind (Entity (Node (Discr_Val))) /= E_Discriminant
|
|
||||||
then
|
|
||||||
Comp_Expr :=
|
|
||||||
Make_Selected_Component (Loc,
|
|
||||||
Prefix => New_Copy_Tree (Target),
|
|
||||||
Selector_Name => New_Occurrence_Of (Disc, Loc));
|
|
||||||
|
|
||||||
Instr :=
|
|
||||||
Make_OK_Assignment_Statement (Loc,
|
|
||||||
Name => Comp_Expr,
|
|
||||||
Expression => New_Copy_Tree (Node (Discr_Val)));
|
|
||||||
|
|
||||||
Set_No_Ctrl_Actions (Instr);
|
|
||||||
Append_To (L, Instr);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Next_Discriminant (Disc);
|
|
||||||
Next_Elmt (Discr_Val);
|
|
||||||
end loop;
|
|
||||||
|
|
||||||
Btype := Base_Type (Parent_Type);
|
|
||||||
end loop;
|
|
||||||
end;
|
|
||||||
|
|
||||||
-- Generate discriminant init values for the visible discriminants
|
-- Generate discriminant init values for the visible discriminants
|
||||||
|
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
|
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -782,13 +782,12 @@ package body Prj.Env is
|
||||||
|
|
||||||
procedure Put_Name_Buffer is
|
procedure Put_Name_Buffer is
|
||||||
begin
|
begin
|
||||||
Name_Len := Name_Len + 1;
|
|
||||||
Name_Buffer (Name_Len) := ASCII.LF;
|
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Str ("Mapping file: " & Name_Buffer (1 .. Name_Len));
|
Debug_Output (Name_Buffer (1 .. Name_Len));
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
Name_Len := Name_Len + 1;
|
||||||
|
Name_Buffer (Name_Len) := ASCII.LF;
|
||||||
Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
|
Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
|
||||||
end Put_Name_Buffer;
|
end Put_Name_Buffer;
|
||||||
|
|
||||||
|
@ -875,6 +874,12 @@ package body Prj.Env is
|
||||||
-- Start of processing for Create_Mapping_File
|
-- Start of processing for Create_Mapping_File
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
Create_Temp_File (In_Tree, File, Name, "mapping");
|
||||||
|
|
||||||
|
if Current_Verbosity = High then
|
||||||
|
Debug_Increase_Indent ("Create mapping file ", Name_Id (Name));
|
||||||
|
end if;
|
||||||
|
|
||||||
For_Every_Imported_Project (Project, Dummy);
|
For_Every_Imported_Project (Project, Dummy);
|
||||||
|
|
||||||
declare
|
declare
|
||||||
|
@ -882,8 +887,6 @@ package body Prj.Env is
|
||||||
Status : Boolean := False;
|
Status : Boolean := False;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Create_Temp_File (In_Tree, File, Name, "mapping");
|
|
||||||
|
|
||||||
if File /= Invalid_FD then
|
if File /= Invalid_FD then
|
||||||
Last := Write (File, Buffer (1)'Address, Buffer_Last);
|
Last := Write (File, Buffer (1)'Address, Buffer_Last);
|
||||||
|
|
||||||
|
@ -898,6 +901,8 @@ package body Prj.Env is
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Free (Buffer);
|
Free (Buffer);
|
||||||
|
|
||||||
|
Debug_Decrease_Indent ("Done create mapping file");
|
||||||
end Create_Mapping_File;
|
end Create_Mapping_File;
|
||||||
|
|
||||||
----------------------
|
----------------------
|
||||||
|
@ -2021,8 +2026,7 @@ package body Prj.Env is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Str (" Trying ");
|
Debug_Output ("Trying " & Path);
|
||||||
Write_Line (Path);
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Is_Absolute_Path (Path) then
|
if Is_Absolute_Path (Path) then
|
||||||
|
@ -2064,8 +2068,7 @@ package body Prj.Env is
|
||||||
Add_Str_To_Name_Buffer (Path);
|
Add_Str_To_Name_Buffer (Path);
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Str (" Testing file ");
|
Debug_Output ("Testing file " & Name_Buffer (1 .. Name_Len));
|
||||||
Write_Line (Name_Buffer (1 .. Name_Len));
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
|
if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
|
||||||
|
@ -2092,11 +2095,9 @@ package body Prj.Env is
|
||||||
Initialize_Project_Path (Self, Target_Name);
|
Initialize_Project_Path (Self, Target_Name);
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Str ("Searching for project (""");
|
Debug_Increase_Indent
|
||||||
Write_Str (File);
|
("Searching for project """ & File & """ in """
|
||||||
Write_Str (""", """);
|
& Directory & '"');
|
||||||
Write_Str (Directory);
|
|
||||||
Write_Line (""");");
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Check the project cache
|
-- Check the project cache
|
||||||
|
@ -2107,6 +2108,7 @@ package body Prj.Env is
|
||||||
Path := Projects_Paths.Get (Self.Cache, Key);
|
Path := Projects_Paths.Get (Self.Cache, Key);
|
||||||
|
|
||||||
if Path /= No_Path then
|
if Path /= No_Path then
|
||||||
|
Debug_Decrease_Indent;
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -2176,6 +2178,8 @@ package body Prj.Env is
|
||||||
Projects_Paths.Set (Self.Cache, Key, Path);
|
Projects_Paths.Set (Self.Cache, Key, Path);
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
Debug_Decrease_Indent;
|
||||||
end Find_Project;
|
end Find_Project;
|
||||||
|
|
||||||
----------
|
----------
|
||||||
|
|
|
@ -624,10 +624,7 @@ package body Prj.Nmsc is
|
||||||
procedure Write_Attr (Name, Value : String) is
|
procedure Write_Attr (Name, Value : String) is
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Str (" " & Name & " = """);
|
Debug_Output (Name & " = """ & Value & '"');
|
||||||
Write_Str (Value);
|
|
||||||
Write_Char ('"');
|
|
||||||
Write_Eol;
|
|
||||||
end if;
|
end if;
|
||||||
end Write_Attr;
|
end Write_Attr;
|
||||||
|
|
||||||
|
@ -804,6 +801,7 @@ package body Prj.Nmsc is
|
||||||
Id := new Source_Data;
|
Id := new Source_Data;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
|
Debug_Indent;
|
||||||
Write_Str ("Adding source File: ");
|
Write_Str ("Adding source File: ");
|
||||||
Write_Str (Get_Name_String (Display_File));
|
Write_Str (Get_Name_String (Display_File));
|
||||||
|
|
||||||
|
@ -939,11 +937,13 @@ package body Prj.Nmsc is
|
||||||
Data.Tree);
|
Data.Tree);
|
||||||
|
|
||||||
procedure Found_Project_File (Path : Path_Information; Rank : Natural);
|
procedure Found_Project_File (Path : Path_Information; Rank : Natural);
|
||||||
-- Comments required ???
|
-- Called for each project file aggregated by Project
|
||||||
|
|
||||||
procedure Expand_Project_Files is
|
procedure Expand_Project_Files is
|
||||||
new Expand_Subdirectory_Pattern (Callback => Found_Project_File);
|
new Expand_Subdirectory_Pattern (Callback => Found_Project_File);
|
||||||
-- Comments required ???
|
-- Search for all project files referenced by the patterns given in
|
||||||
|
-- parameter.
|
||||||
|
-- Calls Found_Project_File for each of them
|
||||||
|
|
||||||
------------------------
|
------------------------
|
||||||
-- Found_Project_File --
|
-- Found_Project_File --
|
||||||
|
@ -952,10 +952,8 @@ package body Prj.Nmsc is
|
||||||
procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
|
procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
|
||||||
pragma Unreferenced (Rank);
|
pragma Unreferenced (Rank);
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name));
|
||||||
Write_Str (" Aggregates:");
|
|
||||||
Write_Line (Get_Name_String (Path.Display_Name));
|
|
||||||
end if;
|
|
||||||
end Found_Project_File;
|
end Found_Project_File;
|
||||||
|
|
||||||
-- Start of processing for Check_Aggregate_Project
|
-- Start of processing for Check_Aggregate_Project
|
||||||
|
@ -982,7 +980,6 @@ package body Prj.Nmsc is
|
||||||
Ignore => Nil_String,
|
Ignore => Nil_String,
|
||||||
Search_For => Search_Files,
|
Search_For => Search_Files,
|
||||||
Resolve_Links => Opt.Follow_Links_For_Files);
|
Resolve_Links => Opt.Follow_Links_For_Files);
|
||||||
|
|
||||||
end Check_Aggregate_Project;
|
end Check_Aggregate_Project;
|
||||||
|
|
||||||
----------------------------
|
----------------------------
|
||||||
|
@ -1040,6 +1037,8 @@ package body Prj.Nmsc is
|
||||||
Prj_Data : Project_Processing_Data;
|
Prj_Data : Project_Processing_Data;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
Debug_Increase_Indent ("Check ", Project.Name);
|
||||||
|
|
||||||
Initialize (Prj_Data, Project);
|
Initialize (Prj_Data, Project);
|
||||||
|
|
||||||
Check_If_Externally_Built (Project, Data);
|
Check_If_Externally_Built (Project, Data);
|
||||||
|
@ -1079,6 +1078,8 @@ package body Prj.Nmsc is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Free (Prj_Data);
|
Free (Prj_Data);
|
||||||
|
|
||||||
|
Debug_Decrease_Indent ("Done Check");
|
||||||
end Check;
|
end Check;
|
||||||
|
|
||||||
--------------------
|
--------------------
|
||||||
|
@ -1125,12 +1126,7 @@ package body Prj.Nmsc is
|
||||||
and then Name not in Ada_2005_Reserved_Words
|
and then Name not in Ada_2005_Reserved_Words
|
||||||
then
|
then
|
||||||
Unit := No_Name;
|
Unit := No_Name;
|
||||||
|
Debug_Output ("Ada reserved word: ", Name);
|
||||||
if Current_Verbosity = High then
|
|
||||||
Write_Str (The_Name);
|
|
||||||
Write_Line (" is an Ada reserved word.");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return True;
|
return True;
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -1183,6 +1179,7 @@ package body Prj.Nmsc is
|
||||||
OK := False;
|
OK := False;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
|
Debug_Indent;
|
||||||
Write_Int (Types.Int (Index));
|
Write_Int (Types.Int (Index));
|
||||||
Write_Str (": '");
|
Write_Str (": '");
|
||||||
Write_Char (The_Name (Index));
|
Write_Char (The_Name (Index));
|
||||||
|
@ -1201,6 +1198,7 @@ package body Prj.Nmsc is
|
||||||
OK := False;
|
OK := False;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
|
Debug_Indent;
|
||||||
Write_Int (Types.Int (Index));
|
Write_Int (Types.Int (Index));
|
||||||
Write_Str (": '");
|
Write_Str (": '");
|
||||||
Write_Char (The_Name (Index));
|
Write_Char (The_Name (Index));
|
||||||
|
@ -1235,6 +1233,7 @@ package body Prj.Nmsc is
|
||||||
OK := False;
|
OK := False;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
|
Debug_Indent;
|
||||||
Write_Int (Types.Int (Index));
|
Write_Int (Types.Int (Index));
|
||||||
Write_Str (": '");
|
Write_Str (": '");
|
||||||
Write_Char (The_Name (Index));
|
Write_Char (The_Name (Index));
|
||||||
|
@ -2682,14 +2681,10 @@ package body Prj.Nmsc is
|
||||||
Project.Externally_Built := Project.Extends.Externally_Built;
|
Project.Externally_Built := Project.Extends.Externally_Built;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Project.Externally_Built then
|
||||||
Write_Str ("Project is ");
|
Debug_Output ("Project is externally built");
|
||||||
|
else
|
||||||
if not Project.Externally_Built then
|
Debug_Output ("Project is not externally built");
|
||||||
Write_Str ("not ");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Write_Line ("externally built.");
|
|
||||||
end if;
|
end if;
|
||||||
end Check_If_Externally_Built;
|
end Check_If_Externally_Built;
|
||||||
|
|
||||||
|
@ -2766,10 +2761,8 @@ package body Prj.Nmsc is
|
||||||
Other.Declared_In_Interfaces := True;
|
Other.Declared_In_Interfaces := True;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
Debug_Output
|
||||||
Write_Str (" interface: ");
|
("interface: ", Name_Id (Source.Path.Name));
|
||||||
Write_Line (Get_Name_String (Source.Path.Name));
|
|
||||||
end if;
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
exit Big_Loop;
|
exit Big_Loop;
|
||||||
|
@ -2845,10 +2838,8 @@ package body Prj.Nmsc is
|
||||||
Other.Declared_In_Interfaces := True;
|
Other.Declared_In_Interfaces := True;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
Debug_Output
|
||||||
Write_Str (" interface: ");
|
("interface: ", Name_Id (Source.Path.Name));
|
||||||
Write_Line (Get_Name_String (Source.Path.Name));
|
|
||||||
end if;
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
exit Big_Loop_2;
|
exit Big_Loop_2;
|
||||||
|
@ -3497,12 +3488,9 @@ package body Prj.Nmsc is
|
||||||
-- If language was not found in project or the projects it extends
|
-- If language was not found in project or the projects it extends
|
||||||
|
|
||||||
if Lang = null then
|
if Lang = null then
|
||||||
if Current_Verbosity = High then
|
Debug_Output
|
||||||
Write_Line
|
("Ignoring spec naming data (lang. not in project): ",
|
||||||
("Ignoring spec naming data for "
|
Lang_Name);
|
||||||
& Get_Name_String (Lang_Name)
|
|
||||||
& " since language is not defined for this project");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
else
|
else
|
||||||
Value := Data.Tree.Array_Elements.Table (Specs).Value;
|
Value := Data.Tree.Array_Elements.Table (Specs).Value;
|
||||||
|
@ -3523,12 +3511,9 @@ package body Prj.Nmsc is
|
||||||
(Project, Name => Get_Name_String (Lang_Name));
|
(Project, Name => Get_Name_String (Lang_Name));
|
||||||
|
|
||||||
if Lang = null then
|
if Lang = null then
|
||||||
if Current_Verbosity = High then
|
Debug_Output
|
||||||
Write_Line
|
("Ignoring impl naming data (lang. not in project): ",
|
||||||
("Ignoring impl naming data for "
|
Lang_Name);
|
||||||
& Get_Name_String (Lang_Name)
|
|
||||||
& " since language is not defined for this project");
|
|
||||||
end if;
|
|
||||||
else
|
else
|
||||||
Value := Data.Tree.Array_Elements.Table (Impls).Value;
|
Value := Data.Tree.Array_Elements.Table (Impls).Value;
|
||||||
|
|
||||||
|
@ -3555,14 +3540,10 @@ package body Prj.Nmsc is
|
||||||
and then Project.Qualifier /= Configuration
|
and then Project.Qualifier /= Configuration
|
||||||
then
|
then
|
||||||
Naming := Data.Tree.Packages.Table (Naming_Id);
|
Naming := Data.Tree.Packages.Table (Naming_Id);
|
||||||
|
Debug_Increase_Indent ("Checking package Naming for ", Project.Name);
|
||||||
if Current_Verbosity = High then
|
|
||||||
Write_Line ("Checking package Naming for project "
|
|
||||||
& Get_Name_String (Project.Name));
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Initialize_Naming_Data;
|
Initialize_Naming_Data;
|
||||||
Check_Naming;
|
Check_Naming;
|
||||||
|
Debug_Decrease_Indent ("Done checking package naming");
|
||||||
end if;
|
end if;
|
||||||
end Check_Package_Naming;
|
end Check_Package_Naming;
|
||||||
|
|
||||||
|
@ -3747,6 +3728,7 @@ package body Prj.Nmsc is
|
||||||
if Current_Verbosity = High
|
if Current_Verbosity = High
|
||||||
and then Project.Library_Name = No_Name
|
and then Project.Library_Name = No_Name
|
||||||
then
|
then
|
||||||
|
Debug_Indent;
|
||||||
Write_Line ("No library name");
|
Write_Line ("No library name");
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -3758,16 +3740,14 @@ package body Prj.Nmsc is
|
||||||
|
|
||||||
if Project.Library_Name /= No_Name then
|
if Project.Library_Name /= No_Name then
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Attr
|
Write_Attr ("Library name: ",
|
||||||
("Library name", Get_Name_String (Project.Library_Name));
|
Get_Name_String (Project.Library_Name));
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
pragma Assert (Lib_Dir.Kind = Single);
|
pragma Assert (Lib_Dir.Kind = Single);
|
||||||
|
|
||||||
if not Library_Directory_Present then
|
if not Library_Directory_Present then
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("No library directory");
|
||||||
Write_Line ("No library directory");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
else
|
else
|
||||||
-- Find path name (unless inherited), check that it is a directory
|
-- Find path name (unless inherited), check that it is a directory
|
||||||
|
@ -3960,10 +3940,7 @@ package body Prj.Nmsc is
|
||||||
|
|
||||||
else
|
else
|
||||||
if Lib_ALI_Dir.Value = Empty_String then
|
if Lib_ALI_Dir.Value = Empty_String then
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("No library ALI directory specified");
|
||||||
Write_Line ("No library ALI directory specified");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Project.Library_ALI_Dir := Project.Library_Dir;
|
Project.Library_ALI_Dir := Project.Library_Dir;
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -4101,9 +4078,7 @@ package body Prj.Nmsc is
|
||||||
pragma Assert (Lib_Version.Kind = Single);
|
pragma Assert (Lib_Version.Kind = Single);
|
||||||
|
|
||||||
if Lib_Version.Value = Empty_String then
|
if Lib_Version.Value = Empty_String then
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("No library version specified");
|
||||||
Write_Line ("No library version specified");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
else
|
else
|
||||||
Project.Lib_Internal_Name := Lib_Version.Value;
|
Project.Lib_Internal_Name := Lib_Version.Value;
|
||||||
|
@ -4112,9 +4087,7 @@ package body Prj.Nmsc is
|
||||||
pragma Assert (The_Lib_Kind.Kind = Single);
|
pragma Assert (The_Lib_Kind.Kind = Single);
|
||||||
|
|
||||||
if The_Lib_Kind.Value = Empty_String then
|
if The_Lib_Kind.Value = Empty_String then
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("No library kind specified");
|
||||||
Write_Line ("No library kind specified");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
else
|
else
|
||||||
Get_Name_String (The_Lib_Kind.Value);
|
Get_Name_String (The_Lib_Kind.Value);
|
||||||
|
@ -4199,9 +4172,7 @@ package body Prj.Nmsc is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Project.Library then
|
if Project.Library then
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("This is a library project file");
|
||||||
Write_Line ("This is a library project file");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Check_Library (Project.Extends, Extends => True);
|
Check_Library (Project.Extends, Extends => True);
|
||||||
|
|
||||||
|
@ -5080,10 +5051,7 @@ package body Prj.Nmsc is
|
||||||
-- The directory is in the list if List is not Nil_String
|
-- The directory is in the list if List is not Nil_String
|
||||||
|
|
||||||
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
|
Debug_Output ("Adding source dir=", Name_Id (Path.Display_Name));
|
||||||
Write_Str (" Adding Source Dir=");
|
|
||||||
Write_Line (Get_Name_String (Path.Display_Name));
|
|
||||||
end if;
|
|
||||||
|
|
||||||
String_Element_Table.Increment_Last (Data.Tree.String_Elements);
|
String_Element_Table.Increment_Last (Data.Tree.String_Elements);
|
||||||
Element :=
|
Element :=
|
||||||
|
@ -5162,9 +5130,7 @@ package body Prj.Nmsc is
|
||||||
-- Start of processing for Get_Directories
|
-- Start of processing for Get_Directories
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("Starting to look for directories");
|
||||||
Write_Line ("Starting to look for directories");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Set the object directory to its default which may be nil, if there
|
-- Set the object directory to its default which may be nil, if there
|
||||||
-- is no sources in the project.
|
-- is no sources in the project.
|
||||||
|
@ -5283,19 +5249,17 @@ package body Prj.Nmsc is
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
if Project.Exec_Directory = No_Path_Information then
|
if Project.Exec_Directory = No_Path_Information then
|
||||||
Write_Line ("No exec directory");
|
Debug_Output ("No exec directory");
|
||||||
else
|
else
|
||||||
Write_Str ("Exec directory: """);
|
Debug_Output
|
||||||
Write_Str (Get_Name_String (Project.Exec_Directory.Display_Name));
|
("Exec directory: ",
|
||||||
Write_Line ("""");
|
Name_Id (Project.Exec_Directory.Display_Name));
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Look for the source directories
|
-- Look for the source directories
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("Starting to look for source directories");
|
||||||
Write_Line ("Starting to look for source directories");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
|
pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
|
||||||
|
|
||||||
|
@ -5355,9 +5319,7 @@ package body Prj.Nmsc is
|
||||||
Resolve_Links => Opt.Follow_Links_For_Dirs);
|
Resolve_Links => Opt.Follow_Links_For_Dirs);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("Putting source directories in canonical cases");
|
||||||
Write_Line ("Putting source directories in canonical cases");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
declare
|
declare
|
||||||
Current : String_List_Id := Project.Source_Dirs;
|
Current : String_List_Id := Project.Source_Dirs;
|
||||||
|
@ -5446,9 +5408,7 @@ package body Prj.Nmsc is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Str ("Opening """);
|
Debug_Output ("Opening """ & Path & '"');
|
||||||
Write_Str (Path);
|
|
||||||
Write_Line (""".");
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Open the file
|
-- Open the file
|
||||||
|
@ -5556,10 +5516,7 @@ package body Prj.Nmsc is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Naming.Dot_Replacement = No_File then
|
if Naming.Dot_Replacement = No_File then
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("No dot_replacement specified");
|
||||||
Write_Line (" No dot_replacement specified");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -5592,10 +5549,7 @@ package body Prj.Nmsc is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Last = Filename'Last then
|
if Last = Filename'Last then
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("no matching suffix");
|
||||||
Write_Line (" no matching suffix");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -5608,10 +5562,7 @@ package body Prj.Nmsc is
|
||||||
if Is_Letter (Filename (J))
|
if Is_Letter (Filename (J))
|
||||||
and then not Is_Lower (Filename (J))
|
and then not Is_Lower (Filename (J))
|
||||||
then
|
then
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("Invalid casing");
|
||||||
Write_Line (" Invalid casing");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
|
@ -5621,10 +5572,7 @@ package body Prj.Nmsc is
|
||||||
if Is_Letter (Filename (J))
|
if Is_Letter (Filename (J))
|
||||||
and then not Is_Upper (Filename (J))
|
and then not Is_Upper (Filename (J))
|
||||||
then
|
then
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("Invalid casing");
|
||||||
Write_Line (" Invalid casing");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
|
@ -5645,10 +5593,7 @@ package body Prj.Nmsc is
|
||||||
if Dot_Repl /= "." then
|
if Dot_Repl /= "." then
|
||||||
for Index in Filename'First .. Last loop
|
for Index in Filename'First .. Last loop
|
||||||
if Filename (Index) = '.' then
|
if Filename (Index) = '.' then
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("Invalid name, contains dot");
|
||||||
Write_Line (" Invalid name, contains dot");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
|
@ -5731,6 +5676,7 @@ package body Prj.Nmsc is
|
||||||
|
|
||||||
if Masked then
|
if Masked then
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
|
Debug_Indent;
|
||||||
Write_Str (" """ & Filename & """ contains the ");
|
Write_Str (" """ & Filename & """ contains the ");
|
||||||
|
|
||||||
if Kind = Spec then
|
if Kind = Spec then
|
||||||
|
@ -5752,12 +5698,10 @@ package body Prj.Nmsc is
|
||||||
and then Current_Verbosity = High
|
and then Current_Verbosity = High
|
||||||
then
|
then
|
||||||
case Kind is
|
case Kind is
|
||||||
when Spec => Write_Str (" spec of ");
|
when Spec => Debug_Output ("spec of", Unit);
|
||||||
when Impl => Write_Str (" body of ");
|
when Impl => Debug_Output ("body of", Unit);
|
||||||
when Sep => Write_Str (" sep of ");
|
when Sep => Debug_Output ("sep of", Unit);
|
||||||
end case;
|
end case;
|
||||||
|
|
||||||
Write_Line (Get_Name_String (Unit));
|
|
||||||
end if;
|
end if;
|
||||||
end Compute_Unit_Name;
|
end Compute_Unit_Name;
|
||||||
|
|
||||||
|
@ -5869,9 +5813,10 @@ package body Prj.Nmsc is
|
||||||
The_Name := Name_Find;
|
The_Name := Name_Find;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
|
Debug_Indent;
|
||||||
Write_Str ("Locate_Directory (""");
|
Write_Str ("Locate_Directory (""");
|
||||||
Write_Str (Get_Name_String (The_Name));
|
Write_Str (Get_Name_String (The_Name));
|
||||||
Write_Str (""", """);
|
Write_Str (""", in """);
|
||||||
Write_Str (The_Parent);
|
Write_Str (The_Parent);
|
||||||
Write_Line (""")");
|
Write_Line (""")");
|
||||||
end if;
|
end if;
|
||||||
|
@ -6411,6 +6356,7 @@ package body Prj.Nmsc is
|
||||||
Source.Path := Path;
|
Source.Path := Path;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
|
Debug_Indent;
|
||||||
if Source.Path /= No_Path_Information then
|
if Source.Path /= No_Path_Information then
|
||||||
Write_Line ("Setting full path for "
|
Write_Line ("Setting full path for "
|
||||||
& Get_Name_String (Source.File)
|
& Get_Name_String (Source.File)
|
||||||
|
@ -6562,16 +6508,12 @@ package body Prj.Nmsc is
|
||||||
Kind := Impl;
|
Kind := Impl;
|
||||||
Language := Tmp_Lang;
|
Language := Tmp_Lang;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
Debug_Output
|
||||||
Write_Str (" implementation of language ");
|
("Implementation of language ", Display_Language_Name);
|
||||||
Write_Line (Get_Name_String (Display_Language_Name));
|
|
||||||
end if;
|
|
||||||
|
|
||||||
elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
|
elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
|
||||||
if Current_Verbosity = High then
|
Debug_Output
|
||||||
Write_Str (" header of language ");
|
("Header of language ", Display_Language_Name);
|
||||||
Write_Line (Get_Name_String (Display_Language_Name));
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if Header_File then
|
if Header_File then
|
||||||
Alternate_Languages := new Language_List_Element'
|
Alternate_Languages := new Language_List_Element'
|
||||||
|
@ -6600,8 +6542,8 @@ package body Prj.Nmsc is
|
||||||
Tmp_Lang := Project.Project.Languages;
|
Tmp_Lang := Project.Project.Languages;
|
||||||
while Tmp_Lang /= No_Language_Index loop
|
while Tmp_Lang /= No_Language_Index loop
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Line
|
Debug_Output
|
||||||
(" Testing language "
|
("Testing language "
|
||||||
& Get_Name_String (Tmp_Lang.Name)
|
& Get_Name_String (Tmp_Lang.Name)
|
||||||
& " Header_File=" & Header_File'Img);
|
& " Header_File=" & Header_File'Img);
|
||||||
end if;
|
end if;
|
||||||
|
@ -6639,10 +6581,8 @@ package body Prj.Nmsc is
|
||||||
Tmp_Lang := Tmp_Lang.Next;
|
Tmp_Lang := Tmp_Lang.Next;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
if Language = No_Language_Index
|
if Language = No_Language_Index then
|
||||||
and then Current_Verbosity = High
|
Debug_Output ("not a source of any language");
|
||||||
then
|
|
||||||
Write_Line (" not a source of any language");
|
|
||||||
end if;
|
end if;
|
||||||
end Check_File_Naming_Schemes;
|
end Check_File_Naming_Schemes;
|
||||||
|
|
||||||
|
@ -6674,9 +6614,9 @@ package body Prj.Nmsc is
|
||||||
if Current_Verbosity = High
|
if Current_Verbosity = High
|
||||||
and then Source.File /= No_File
|
and then Source.File /= No_File
|
||||||
then
|
then
|
||||||
Write_Line ("Override kind for "
|
Debug_Output ("Override kind for "
|
||||||
& Get_Name_String (Source.File)
|
& Get_Name_String (Source.File)
|
||||||
& " kind=" & Source.Kind'Img);
|
& " kind=" & Source.Kind'Img);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Source.Kind in Spec_Or_Body and then Source.Unit /= null then
|
if Source.Kind in Spec_Or_Body and then Source.Unit /= null then
|
||||||
|
@ -6714,11 +6654,9 @@ package body Prj.Nmsc is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Line ("Checking file:");
|
Debug_Increase_Indent
|
||||||
Write_Str (" Path = ");
|
("Checking file (rank=" & Source_Dir_Rank'Img & ")",
|
||||||
Write_Line (Get_Name_String (Path));
|
Name_Id (Path));
|
||||||
Write_Str (" Rank =");
|
|
||||||
Write_Line (Source_Dir_Rank'Img);
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Name_Loc = No_Name_Location then
|
if Name_Loc = No_Name_Location then
|
||||||
|
@ -6825,6 +6763,8 @@ package body Prj.Nmsc is
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
Debug_Decrease_Indent;
|
||||||
end Check_File;
|
end Check_File;
|
||||||
|
|
||||||
---------------------------------
|
---------------------------------
|
||||||
|
@ -6938,11 +6878,7 @@ package body Prj.Nmsc is
|
||||||
Success : Boolean := False;
|
Success : Boolean := False;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
Debug_Output ("Looking for subdirs of ", Name_Id (Path.Display_Name));
|
||||||
Write_Str (" Looking for subdirs of """);
|
|
||||||
Write_Str (Path_Str);
|
|
||||||
Write_Line ("""");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if Recursive_Dirs.Get (Visited, Path.Name) then
|
if Recursive_Dirs.Get (Visited, Path.Name) then
|
||||||
return Success;
|
return Success;
|
||||||
|
@ -7038,11 +6974,7 @@ package body Prj.Nmsc is
|
||||||
Success : Boolean;
|
Success : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
Debug_Increase_Indent ("Find_Pattern", Pattern_Id);
|
||||||
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 we are looking for files, find the pattern for the files
|
||||||
|
|
||||||
|
@ -7063,9 +6995,10 @@ package body Prj.Nmsc is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Str (" file pattern=");
|
Debug_Indent;
|
||||||
Write_Line (Pattern (Pattern_End + 1 .. Pattern'Last));
|
Write_Str ("file_pattern=");
|
||||||
Write_Str (" Expand directory pattern=");
|
Write_Str (Pattern (Pattern_End + 1 .. Pattern'Last));
|
||||||
|
Write_Str (" dir_pattern=");
|
||||||
Write_Line (Pattern (Pattern'First .. Pattern_End));
|
Write_Line (Pattern (Pattern'First .. Pattern_End));
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -7138,6 +7071,8 @@ package body Prj.Nmsc is
|
||||||
end case;
|
end case;
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
Debug_Decrease_Indent ("Done Find_Pattern");
|
||||||
end Find_Pattern;
|
end Find_Pattern;
|
||||||
|
|
||||||
-- Local variables
|
-- Local variables
|
||||||
|
@ -7179,9 +7114,7 @@ package body Prj.Nmsc is
|
||||||
Display_File_Name : File_Name_Type;
|
Display_File_Name : File_Name_Type;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
Debug_Increase_Indent ("Looking for sources");
|
||||||
Write_Line ("Looking for sources:");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Loop through subdirectories
|
-- Loop through subdirectories
|
||||||
|
|
||||||
|
@ -7213,10 +7146,10 @@ package body Prj.Nmsc is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Attr
|
Debug_Increase_Indent
|
||||||
("Source_Dir",
|
("Source_Dir (node=" & Num_Nod.Number'Img & ") """
|
||||||
Source_Directory (Source_Directory'First .. Dir_Last));
|
& Source_Directory (Source_Directory'First .. Dir_Last)
|
||||||
Write_Line (Num_Nod.Number'Img);
|
& '"');
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- We look to every entry in the source directory
|
-- We look to every entry in the source directory
|
||||||
|
@ -7238,11 +7171,6 @@ package body Prj.Nmsc is
|
||||||
or else Is_Regular_File
|
or else Is_Regular_File
|
||||||
(Display_Source_Directory & Name (1 .. Last))
|
(Display_Source_Directory & Name (1 .. Last))
|
||||||
then
|
then
|
||||||
if Current_Verbosity = High then
|
|
||||||
Write_Str (" Checking ");
|
|
||||||
Write_Line (Name (1 .. Last));
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Name_Len := Last;
|
Name_Len := Last;
|
||||||
Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
|
Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
|
||||||
Display_File_Name := Name_Find;
|
Display_File_Name := Name_Find;
|
||||||
|
@ -7291,12 +7219,9 @@ package body Prj.Nmsc is
|
||||||
Excluded_Sources_Htable.Set
|
Excluded_Sources_Htable.Set
|
||||||
(Project.Excluded, File_Name, FF);
|
(Project.Excluded, File_Name, FF);
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
Debug_Output
|
||||||
Write_Str (" excluded source """);
|
("Excluded source ",
|
||||||
Write_Str
|
Name_Id (Display_File_Name));
|
||||||
(Get_Name_String (Display_File_Name));
|
|
||||||
Write_Line ("""");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Will mark the file as removed, but we
|
-- Will mark the file as removed, but we
|
||||||
-- still need to add it to the list: if we
|
-- still need to add it to the list: if we
|
||||||
|
@ -7327,9 +7252,15 @@ package body Prj.Nmsc is
|
||||||
Display_File_Name => Display_File_Name,
|
Display_File_Name => Display_File_Name,
|
||||||
For_All_Sources => For_All_Sources);
|
For_All_Sources => For_All_Sources);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
else
|
||||||
|
if Current_Verbosity = High then
|
||||||
|
Debug_Output ("Ignore " & Name (1 .. Last));
|
||||||
|
end if;
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
|
Debug_Decrease_Indent;
|
||||||
Close (Dir);
|
Close (Dir);
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
|
@ -7343,9 +7274,7 @@ package body Prj.Nmsc is
|
||||||
Src_Dir_Rank := Num_Nod.Next;
|
Src_Dir_Rank := Num_Nod.Next;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
Debug_Decrease_Indent ("end Looking for sources.");
|
||||||
Write_Line ("end Looking for sources.");
|
|
||||||
end if;
|
|
||||||
end Search_Directories;
|
end Search_Directories;
|
||||||
|
|
||||||
----------------------------
|
----------------------------
|
||||||
|
@ -7377,11 +7306,9 @@ package body Prj.Nmsc is
|
||||||
No_Location, Project.Project);
|
No_Location, Project.Project);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
Debug_Output
|
||||||
Write_Str ("Naming exception: Putting source file ");
|
("Naming exception: adding source file to source_Names: ",
|
||||||
Write_Str (Get_Name_String (Source.File));
|
Name_Id (Source.File));
|
||||||
Write_Line (" in Source_Names");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Source_Names_Htable.Set
|
Source_Names_Htable.Set
|
||||||
(Project.Source_Names,
|
(Project.Source_Names,
|
||||||
|
@ -7568,6 +7495,7 @@ package body Prj.Nmsc is
|
||||||
Source.In_Interfaces := False;
|
Source.In_Interfaces := False;
|
||||||
|
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
|
Debug_Indent;
|
||||||
Write_Str ("Removing file ");
|
Write_Str ("Removing file ");
|
||||||
Write_Line
|
Write_Line
|
||||||
(Get_Name_String (Excluded.File)
|
(Get_Name_String (Excluded.File)
|
||||||
|
@ -7875,6 +7803,7 @@ package body Prj.Nmsc is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
|
Debug_Indent;
|
||||||
Write_Str ("Removing source ");
|
Write_Str ("Removing source ");
|
||||||
Write_Str (Get_Name_String (Id.File));
|
Write_Str (Get_Name_String (Id.File));
|
||||||
|
|
||||||
|
@ -7978,7 +7907,7 @@ package body Prj.Nmsc is
|
||||||
Element : String_Element;
|
Element : String_Element;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Write_Line ("Source_Dirs:");
|
Debug_Increase_Indent ("Source_Dirs:");
|
||||||
|
|
||||||
Current := Project.Source_Dirs;
|
Current := Project.Source_Dirs;
|
||||||
while Current /= Nil_String loop
|
while Current /= Nil_String loop
|
||||||
|
@ -7988,7 +7917,7 @@ package body Prj.Nmsc is
|
||||||
Current := Element.Next;
|
Current := Element.Next;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
Write_Line ("end Source_Dirs.");
|
Debug_Decrease_Indent ("end Source_Dirs.");
|
||||||
end Show_Source_Dirs;
|
end Show_Source_Dirs;
|
||||||
|
|
||||||
---------------------------
|
---------------------------
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
|
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -1308,10 +1308,7 @@ package body Prj.Part is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Current_Verbosity >= Medium then
|
if Current_Verbosity >= Medium then
|
||||||
Write_Str ("Parsing """);
|
Debug_Increase_Indent ("Parsing """ & Path_Name & '"');
|
||||||
Write_Str (Path_Name);
|
|
||||||
Write_Char ('"');
|
|
||||||
Write_Eol;
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Project_Directory :=
|
Project_Directory :=
|
||||||
|
@ -1882,6 +1879,8 @@ package body Prj.Part is
|
||||||
-- And restore the comment state that was saved
|
-- And restore the comment state that was saved
|
||||||
|
|
||||||
Tree.Restore_And_Free (Project_Comment_State);
|
Tree.Restore_And_Free (Project_Comment_State);
|
||||||
|
|
||||||
|
Debug_Decrease_Indent ("Done parsing project");
|
||||||
end Parse_Single_Project;
|
end Parse_Single_Project;
|
||||||
|
|
||||||
-----------------------
|
-----------------------
|
||||||
|
@ -1899,9 +1898,7 @@ package body Prj.Part is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Current_Verbosity = High then
|
if Current_Verbosity = High then
|
||||||
Write_Str ("Project_Name_From (""");
|
Debug_Output ("Project_Name_From (""" & Canonical & """)");
|
||||||
Write_Str (Canonical);
|
|
||||||
Write_Line (""")");
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- If the path name is empty, return No_Name to indicate failure
|
-- If the path name is empty, return No_Name to indicate failure
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
|
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -373,6 +373,22 @@ package body Prj.PP is
|
||||||
|
|
||||||
Print (First_Comment_Before (Node, In_Tree), Indent);
|
Print (First_Comment_Before (Node, In_Tree), Indent);
|
||||||
Start_Line (Indent);
|
Start_Line (Indent);
|
||||||
|
|
||||||
|
case Project_Qualifier_Of (Node, In_Tree) is
|
||||||
|
when Unspecified | Standard =>
|
||||||
|
null;
|
||||||
|
when Aggregate =>
|
||||||
|
Write_String ("aggregate ", Indent);
|
||||||
|
when Aggregate_Library =>
|
||||||
|
Write_String ("aggregate library ", Indent);
|
||||||
|
when Library =>
|
||||||
|
Write_String ("library ", Indent);
|
||||||
|
when Configuration =>
|
||||||
|
Write_String ("configuration ", Indent);
|
||||||
|
when Dry =>
|
||||||
|
Write_String ("abstract ", Indent);
|
||||||
|
end case;
|
||||||
|
|
||||||
Write_String ("project ", Indent);
|
Write_String ("project ", Indent);
|
||||||
|
|
||||||
if Id /= Prj.No_Project then
|
if Id /= Prj.No_Project then
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
|
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -48,6 +48,9 @@ package body Prj is
|
||||||
|
|
||||||
The_Empty_String : Name_Id := No_Name;
|
The_Empty_String : Name_Id := No_Name;
|
||||||
|
|
||||||
|
Debug_Level : Integer := 0;
|
||||||
|
-- Current indentation level for debug traces.
|
||||||
|
|
||||||
type Cst_String_Access is access constant String;
|
type Cst_String_Access is access constant String;
|
||||||
|
|
||||||
All_Lower_Case_Image : aliased constant String := "lowercase";
|
All_Lower_Case_Image : aliased constant String := "lowercase";
|
||||||
|
@ -1300,6 +1303,77 @@ package body Prj is
|
||||||
return Count;
|
return Count;
|
||||||
end Length;
|
end Length;
|
||||||
|
|
||||||
|
------------------
|
||||||
|
-- Debug_Output --
|
||||||
|
------------------
|
||||||
|
|
||||||
|
procedure Debug_Output (Str : String) is
|
||||||
|
begin
|
||||||
|
if Current_Verbosity > Default then
|
||||||
|
Write_Line ((1 .. Debug_Level * 2 => ' ') & Str);
|
||||||
|
end if;
|
||||||
|
end Debug_Output;
|
||||||
|
|
||||||
|
------------------
|
||||||
|
-- Debug_Indent --
|
||||||
|
------------------
|
||||||
|
|
||||||
|
procedure Debug_Indent is
|
||||||
|
begin
|
||||||
|
if Current_Verbosity = High then
|
||||||
|
Write_Str ((1 .. Debug_Level * 2 => ' '));
|
||||||
|
end if;
|
||||||
|
end Debug_Indent;
|
||||||
|
|
||||||
|
------------------
|
||||||
|
-- Debug_Output --
|
||||||
|
------------------
|
||||||
|
|
||||||
|
procedure Debug_Output (Str : String; Str2 : Name_Id) is
|
||||||
|
begin
|
||||||
|
if Current_Verbosity = High then
|
||||||
|
Debug_Indent;
|
||||||
|
Write_Str (Str);
|
||||||
|
|
||||||
|
if Str2 = No_Name then
|
||||||
|
Write_Line (" <no_name>");
|
||||||
|
else
|
||||||
|
Write_Line (" """ & Get_Name_String (Str2) & '"');
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
end Debug_Output;
|
||||||
|
|
||||||
|
---------------------------
|
||||||
|
-- Debug_Increase_Indent --
|
||||||
|
---------------------------
|
||||||
|
|
||||||
|
procedure Debug_Increase_Indent
|
||||||
|
(Str : String := ""; Str2 : Name_Id := No_Name)
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
if Str2 /= No_Name then
|
||||||
|
Debug_Output (Str, Str2);
|
||||||
|
else
|
||||||
|
Debug_Output (Str);
|
||||||
|
end if;
|
||||||
|
Debug_Level := Debug_Level + 1;
|
||||||
|
end Debug_Increase_Indent;
|
||||||
|
|
||||||
|
---------------------------
|
||||||
|
-- Debug_Decrease_Indent --
|
||||||
|
---------------------------
|
||||||
|
|
||||||
|
procedure Debug_Decrease_Indent (Str : String := "") is
|
||||||
|
begin
|
||||||
|
if Debug_Level > 0 then
|
||||||
|
Debug_Level := Debug_Level - 1;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if Str /= "" then
|
||||||
|
Debug_Output (Str);
|
||||||
|
end if;
|
||||||
|
end Debug_Decrease_Indent;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- Make sure that the standard config and user project file extensions are
|
-- Make sure that the standard config and user project file extensions are
|
||||||
-- compatible with canonical case file naming.
|
-- compatible with canonical case file naming.
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- S p e c --
|
-- S p e c --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
|
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -849,16 +849,6 @@ package Prj is
|
||||||
Hash => Hash,
|
Hash => Hash,
|
||||||
Equal => "=");
|
Equal => "=");
|
||||||
|
|
||||||
type Verbosity is (Default, Medium, High);
|
|
||||||
pragma Ordered (Verbosity);
|
|
||||||
-- Verbosity when parsing GNAT Project Files
|
|
||||||
-- Default is default (very quiet, if no errors).
|
|
||||||
-- Medium is more verbose.
|
|
||||||
-- High is extremely verbose.
|
|
||||||
|
|
||||||
Current_Verbosity : Verbosity := Default;
|
|
||||||
-- The current value of the verbosity the project files are parsed with
|
|
||||||
|
|
||||||
type Lib_Kind is (Static, Dynamic, Relocatable);
|
type Lib_Kind is (Static, Dynamic, Relocatable);
|
||||||
|
|
||||||
type Policy is (Autonomous, Compliant, Controlled, Restricted, Direct);
|
type Policy is (Autonomous, Compliant, Controlled, Restricted, Direct);
|
||||||
|
@ -1594,6 +1584,35 @@ package Prj is
|
||||||
-- The prefix for virtual extending projects. Because of the '$', which is
|
-- The prefix for virtual extending projects. Because of the '$', which is
|
||||||
-- normally forbidden for project names, there cannot be any name clash.
|
-- normally forbidden for project names, there cannot be any name clash.
|
||||||
|
|
||||||
|
-----------
|
||||||
|
-- Debug --
|
||||||
|
-----------
|
||||||
|
|
||||||
|
type Verbosity is (Default, Medium, High);
|
||||||
|
pragma Ordered (Verbosity);
|
||||||
|
-- Verbosity when parsing GNAT Project Files
|
||||||
|
-- Default is default (very quiet, if no errors).
|
||||||
|
-- Medium is more verbose.
|
||||||
|
-- High is extremely verbose.
|
||||||
|
|
||||||
|
Current_Verbosity : Verbosity := Default;
|
||||||
|
-- The current value of the verbosity the project files are parsed with
|
||||||
|
|
||||||
|
procedure Debug_Indent;
|
||||||
|
-- Inserts a series of blanks depending on the current indentation level
|
||||||
|
|
||||||
|
procedure Debug_Output (Str : String);
|
||||||
|
procedure Debug_Output (Str : String; Str2 : Name_Id);
|
||||||
|
-- If Current_Verbosity is not Default, outputs Str.
|
||||||
|
-- This indents Str based on the current indentation level for traces
|
||||||
|
-- Debug_Error is intended to be used to report an error in the traces.
|
||||||
|
|
||||||
|
procedure Debug_Increase_Indent
|
||||||
|
(Str : String := ""; Str2 : Name_Id := No_Name);
|
||||||
|
procedure Debug_Decrease_Indent (Str : String := "");
|
||||||
|
-- Increase or decrease the indentation level for debug traces.
|
||||||
|
-- This indentation level only affects output done through Debug_Output.
|
||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
All_Packages : constant String_List_Access := null;
|
All_Packages : constant String_List_Access := null;
|
||||||
|
|
|
@ -7226,14 +7226,18 @@ package body Sem_Ch3 is
|
||||||
Analyze (N);
|
Analyze (N);
|
||||||
|
|
||||||
-- Derivation of subprograms must be delayed until the full subtype
|
-- Derivation of subprograms must be delayed until the full subtype
|
||||||
-- has been established to ensure proper overriding of subprograms
|
-- has been established, to ensure proper overriding of subprograms
|
||||||
-- inherited by full types. If the derivations occurred as part of
|
-- inherited by full types. If the derivations occurred as part of
|
||||||
-- the call to Build_Derived_Type above, then the check for type
|
-- the call to Build_Derived_Type above, then the check for type
|
||||||
-- conformance would fail because earlier primitive subprograms
|
-- conformance would fail because earlier primitive subprograms
|
||||||
-- could still refer to the full type prior the change to the new
|
-- could still refer to the full type prior the change to the new
|
||||||
-- subtype and hence would not match the new base type created here.
|
-- subtype and hence would not match the new base type created here.
|
||||||
|
-- Subprograms are not derived, however, when Derive_Subps is False
|
||||||
|
-- (since otherwise there could be redundant derivations).
|
||||||
|
|
||||||
Derive_Subprograms (Parent_Type, Derived_Type);
|
if Derive_Subps then
|
||||||
|
Derive_Subprograms (Parent_Type, Derived_Type);
|
||||||
|
end if;
|
||||||
|
|
||||||
-- For tagged types the Discriminant_Constraint of the new base itype
|
-- For tagged types the Discriminant_Constraint of the new base itype
|
||||||
-- is inherited from the first subtype so that no subtype conformance
|
-- is inherited from the first subtype so that no subtype conformance
|
||||||
|
|
Loading…
Reference in New Issue