[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>
|
||||
|
||||
* 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
|
||||
-- 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;
|
||||
-- Check whether Bounds is a range node and its lower and higher bounds
|
||||
-- are integers literals.
|
||||
|
@ -2156,6 +2161,56 @@ package body Exp_Aggr is
|
|||
return L;
|
||||
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 --
|
||||
-------------------------
|
||||
|
@ -2741,6 +2796,17 @@ package body Exp_Aggr is
|
|||
end if;
|
||||
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)
|
||||
|
||||
else
|
||||
|
@ -2752,59 +2818,7 @@ package body Exp_Aggr is
|
|||
if Has_Discriminants (Typ)
|
||||
and then not Is_Unchecked_Union (Base_Type (Typ))
|
||||
then
|
||||
-- If the type is derived, and constrains discriminants of the
|
||||
-- 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;
|
||||
Init_Hidden_Discriminants (Typ, L);
|
||||
|
||||
-- Generate discriminant init values for the visible discriminants
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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 --
|
||||
-- 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
|
||||
begin
|
||||
Name_Len := Name_Len + 1;
|
||||
Name_Buffer (Name_Len) := ASCII.LF;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str ("Mapping file: " & Name_Buffer (1 .. Name_Len));
|
||||
Debug_Output (Name_Buffer (1 .. Name_Len));
|
||||
end if;
|
||||
|
||||
Name_Len := Name_Len + 1;
|
||||
Name_Buffer (Name_Len) := ASCII.LF;
|
||||
Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
|
||||
end Put_Name_Buffer;
|
||||
|
||||
|
@ -875,6 +874,12 @@ package body Prj.Env is
|
|||
-- Start of processing for Create_Mapping_File
|
||||
|
||||
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);
|
||||
|
||||
declare
|
||||
|
@ -882,8 +887,6 @@ package body Prj.Env is
|
|||
Status : Boolean := False;
|
||||
|
||||
begin
|
||||
Create_Temp_File (In_Tree, File, Name, "mapping");
|
||||
|
||||
if File /= Invalid_FD then
|
||||
Last := Write (File, Buffer (1)'Address, Buffer_Last);
|
||||
|
||||
|
@ -898,6 +901,8 @@ package body Prj.Env is
|
|||
end;
|
||||
|
||||
Free (Buffer);
|
||||
|
||||
Debug_Decrease_Indent ("Done create mapping file");
|
||||
end Create_Mapping_File;
|
||||
|
||||
----------------------
|
||||
|
@ -2021,8 +2026,7 @@ package body Prj.Env is
|
|||
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" Trying ");
|
||||
Write_Line (Path);
|
||||
Debug_Output ("Trying " & Path);
|
||||
end if;
|
||||
|
||||
if Is_Absolute_Path (Path) then
|
||||
|
@ -2064,8 +2068,7 @@ package body Prj.Env is
|
|||
Add_Str_To_Name_Buffer (Path);
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" Testing file ");
|
||||
Write_Line (Name_Buffer (1 .. Name_Len));
|
||||
Debug_Output ("Testing file " & Name_Buffer (1 .. Name_Len));
|
||||
end if;
|
||||
|
||||
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);
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str ("Searching for project (""");
|
||||
Write_Str (File);
|
||||
Write_Str (""", """);
|
||||
Write_Str (Directory);
|
||||
Write_Line (""");");
|
||||
Debug_Increase_Indent
|
||||
("Searching for project """ & File & """ in """
|
||||
& Directory & '"');
|
||||
end if;
|
||||
|
||||
-- Check the project cache
|
||||
|
@ -2107,6 +2108,7 @@ package body Prj.Env is
|
|||
Path := Projects_Paths.Get (Self.Cache, Key);
|
||||
|
||||
if Path /= No_Path then
|
||||
Debug_Decrease_Indent;
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
@ -2176,6 +2178,8 @@ package body Prj.Env is
|
|||
Projects_Paths.Set (Self.Cache, Key, Path);
|
||||
end;
|
||||
end if;
|
||||
|
||||
Debug_Decrease_Indent;
|
||||
end Find_Project;
|
||||
|
||||
----------
|
||||
|
|
|
@ -624,10 +624,7 @@ package body Prj.Nmsc is
|
|||
procedure Write_Attr (Name, Value : String) is
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" " & Name & " = """);
|
||||
Write_Str (Value);
|
||||
Write_Char ('"');
|
||||
Write_Eol;
|
||||
Debug_Output (Name & " = """ & Value & '"');
|
||||
end if;
|
||||
end Write_Attr;
|
||||
|
||||
|
@ -804,6 +801,7 @@ package body Prj.Nmsc is
|
|||
Id := new Source_Data;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Debug_Indent;
|
||||
Write_Str ("Adding source File: ");
|
||||
Write_Str (Get_Name_String (Display_File));
|
||||
|
||||
|
@ -939,11 +937,13 @@ package body Prj.Nmsc is
|
|||
Data.Tree);
|
||||
|
||||
procedure Found_Project_File (Path : Path_Information; Rank : Natural);
|
||||
-- Comments required ???
|
||||
-- Called for each project file aggregated by Project
|
||||
|
||||
procedure Expand_Project_Files is
|
||||
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 --
|
||||
|
@ -952,10 +952,8 @@ package body Prj.Nmsc is
|
|||
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;
|
||||
Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name));
|
||||
|
||||
end Found_Project_File;
|
||||
|
||||
-- Start of processing for Check_Aggregate_Project
|
||||
|
@ -982,7 +980,6 @@ package body Prj.Nmsc is
|
|||
Ignore => Nil_String,
|
||||
Search_For => Search_Files,
|
||||
Resolve_Links => Opt.Follow_Links_For_Files);
|
||||
|
||||
end Check_Aggregate_Project;
|
||||
|
||||
----------------------------
|
||||
|
@ -1040,6 +1037,8 @@ package body Prj.Nmsc is
|
|||
Prj_Data : Project_Processing_Data;
|
||||
|
||||
begin
|
||||
Debug_Increase_Indent ("Check ", Project.Name);
|
||||
|
||||
Initialize (Prj_Data, Project);
|
||||
|
||||
Check_If_Externally_Built (Project, Data);
|
||||
|
@ -1079,6 +1078,8 @@ package body Prj.Nmsc is
|
|||
end if;
|
||||
|
||||
Free (Prj_Data);
|
||||
|
||||
Debug_Decrease_Indent ("Done Check");
|
||||
end Check;
|
||||
|
||||
--------------------
|
||||
|
@ -1125,12 +1126,7 @@ package body Prj.Nmsc is
|
|||
and then Name not in Ada_2005_Reserved_Words
|
||||
then
|
||||
Unit := No_Name;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (The_Name);
|
||||
Write_Line (" is an Ada reserved word.");
|
||||
end if;
|
||||
|
||||
Debug_Output ("Ada reserved word: ", Name);
|
||||
return True;
|
||||
|
||||
else
|
||||
|
@ -1183,6 +1179,7 @@ package body Prj.Nmsc is
|
|||
OK := False;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Debug_Indent;
|
||||
Write_Int (Types.Int (Index));
|
||||
Write_Str (": '");
|
||||
Write_Char (The_Name (Index));
|
||||
|
@ -1201,6 +1198,7 @@ package body Prj.Nmsc is
|
|||
OK := False;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Debug_Indent;
|
||||
Write_Int (Types.Int (Index));
|
||||
Write_Str (": '");
|
||||
Write_Char (The_Name (Index));
|
||||
|
@ -1235,6 +1233,7 @@ package body Prj.Nmsc is
|
|||
OK := False;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Debug_Indent;
|
||||
Write_Int (Types.Int (Index));
|
||||
Write_Str (": '");
|
||||
Write_Char (The_Name (Index));
|
||||
|
@ -2682,14 +2681,10 @@ package body Prj.Nmsc is
|
|||
Project.Externally_Built := Project.Extends.Externally_Built;
|
||||
end if;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str ("Project is ");
|
||||
|
||||
if not Project.Externally_Built then
|
||||
Write_Str ("not ");
|
||||
end if;
|
||||
|
||||
Write_Line ("externally built.");
|
||||
if Project.Externally_Built then
|
||||
Debug_Output ("Project is externally built");
|
||||
else
|
||||
Debug_Output ("Project is not externally built");
|
||||
end if;
|
||||
end Check_If_Externally_Built;
|
||||
|
||||
|
@ -2766,10 +2761,8 @@ package body Prj.Nmsc is
|
|||
Other.Declared_In_Interfaces := True;
|
||||
end if;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" interface: ");
|
||||
Write_Line (Get_Name_String (Source.Path.Name));
|
||||
end if;
|
||||
Debug_Output
|
||||
("interface: ", Name_Id (Source.Path.Name));
|
||||
end if;
|
||||
|
||||
exit Big_Loop;
|
||||
|
@ -2845,10 +2838,8 @@ package body Prj.Nmsc is
|
|||
Other.Declared_In_Interfaces := True;
|
||||
end if;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" interface: ");
|
||||
Write_Line (Get_Name_String (Source.Path.Name));
|
||||
end if;
|
||||
Debug_Output
|
||||
("interface: ", Name_Id (Source.Path.Name));
|
||||
end if;
|
||||
|
||||
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 Lang = null then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line
|
||||
("Ignoring spec naming data for "
|
||||
& Get_Name_String (Lang_Name)
|
||||
& " since language is not defined for this project");
|
||||
end if;
|
||||
Debug_Output
|
||||
("Ignoring spec naming data (lang. not in project): ",
|
||||
Lang_Name);
|
||||
|
||||
else
|
||||
Value := Data.Tree.Array_Elements.Table (Specs).Value;
|
||||
|
@ -3523,12 +3511,9 @@ package body Prj.Nmsc is
|
|||
(Project, Name => Get_Name_String (Lang_Name));
|
||||
|
||||
if Lang = null then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line
|
||||
("Ignoring impl naming data for "
|
||||
& Get_Name_String (Lang_Name)
|
||||
& " since language is not defined for this project");
|
||||
end if;
|
||||
Debug_Output
|
||||
("Ignoring impl naming data (lang. not in project): ",
|
||||
Lang_Name);
|
||||
else
|
||||
Value := Data.Tree.Array_Elements.Table (Impls).Value;
|
||||
|
||||
|
@ -3555,14 +3540,10 @@ package body Prj.Nmsc is
|
|||
and then Project.Qualifier /= Configuration
|
||||
then
|
||||
Naming := Data.Tree.Packages.Table (Naming_Id);
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("Checking package Naming for project "
|
||||
& Get_Name_String (Project.Name));
|
||||
end if;
|
||||
|
||||
Debug_Increase_Indent ("Checking package Naming for ", Project.Name);
|
||||
Initialize_Naming_Data;
|
||||
Check_Naming;
|
||||
Debug_Decrease_Indent ("Done checking package naming");
|
||||
end if;
|
||||
end Check_Package_Naming;
|
||||
|
||||
|
@ -3747,6 +3728,7 @@ package body Prj.Nmsc is
|
|||
if Current_Verbosity = High
|
||||
and then Project.Library_Name = No_Name
|
||||
then
|
||||
Debug_Indent;
|
||||
Write_Line ("No library name");
|
||||
end if;
|
||||
|
||||
|
@ -3758,16 +3740,14 @@ package body Prj.Nmsc is
|
|||
|
||||
if Project.Library_Name /= No_Name then
|
||||
if Current_Verbosity = High then
|
||||
Write_Attr
|
||||
("Library name", Get_Name_String (Project.Library_Name));
|
||||
Write_Attr ("Library name: ",
|
||||
Get_Name_String (Project.Library_Name));
|
||||
end if;
|
||||
|
||||
pragma Assert (Lib_Dir.Kind = Single);
|
||||
|
||||
if not Library_Directory_Present then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("No library directory");
|
||||
end if;
|
||||
Debug_Output ("No library directory");
|
||||
|
||||
else
|
||||
-- Find path name (unless inherited), check that it is a directory
|
||||
|
@ -3960,10 +3940,7 @@ package body Prj.Nmsc is
|
|||
|
||||
else
|
||||
if Lib_ALI_Dir.Value = Empty_String then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("No library ALI directory specified");
|
||||
end if;
|
||||
|
||||
Debug_Output ("No library ALI directory specified");
|
||||
Project.Library_ALI_Dir := Project.Library_Dir;
|
||||
|
||||
else
|
||||
|
@ -4101,9 +4078,7 @@ package body Prj.Nmsc is
|
|||
pragma Assert (Lib_Version.Kind = Single);
|
||||
|
||||
if Lib_Version.Value = Empty_String then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("No library version specified");
|
||||
end if;
|
||||
Debug_Output ("No library version specified");
|
||||
|
||||
else
|
||||
Project.Lib_Internal_Name := Lib_Version.Value;
|
||||
|
@ -4112,9 +4087,7 @@ package body Prj.Nmsc is
|
|||
pragma Assert (The_Lib_Kind.Kind = Single);
|
||||
|
||||
if The_Lib_Kind.Value = Empty_String then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("No library kind specified");
|
||||
end if;
|
||||
Debug_Output ("No library kind specified");
|
||||
|
||||
else
|
||||
Get_Name_String (The_Lib_Kind.Value);
|
||||
|
@ -4199,9 +4172,7 @@ package body Prj.Nmsc is
|
|||
end if;
|
||||
|
||||
if Project.Library then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("This is a library project file");
|
||||
end if;
|
||||
Debug_Output ("This is a library project file");
|
||||
|
||||
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
|
||||
|
||||
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 (Path.Display_Name));
|
||||
end if;
|
||||
Debug_Output ("Adding source dir=", Name_Id (Path.Display_Name));
|
||||
|
||||
String_Element_Table.Increment_Last (Data.Tree.String_Elements);
|
||||
Element :=
|
||||
|
@ -5162,9 +5130,7 @@ package body Prj.Nmsc is
|
|||
-- Start of processing for Get_Directories
|
||||
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("Starting to look for directories");
|
||||
end if;
|
||||
Debug_Output ("Starting to look for directories");
|
||||
|
||||
-- Set the object directory to its default which may be nil, if there
|
||||
-- is no sources in the project.
|
||||
|
@ -5283,19 +5249,17 @@ package body Prj.Nmsc is
|
|||
|
||||
if Current_Verbosity = High then
|
||||
if Project.Exec_Directory = No_Path_Information then
|
||||
Write_Line ("No exec directory");
|
||||
Debug_Output ("No exec directory");
|
||||
else
|
||||
Write_Str ("Exec directory: """);
|
||||
Write_Str (Get_Name_String (Project.Exec_Directory.Display_Name));
|
||||
Write_Line ("""");
|
||||
Debug_Output
|
||||
("Exec directory: ",
|
||||
Name_Id (Project.Exec_Directory.Display_Name));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Look for the source directories
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("Starting to look for source directories");
|
||||
end if;
|
||||
Debug_Output ("Starting to look for source directories");
|
||||
|
||||
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);
|
||||
end if;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("Putting source directories in canonical cases");
|
||||
end if;
|
||||
Debug_Output ("Putting source directories in canonical cases");
|
||||
|
||||
declare
|
||||
Current : String_List_Id := Project.Source_Dirs;
|
||||
|
@ -5446,9 +5408,7 @@ package body Prj.Nmsc is
|
|||
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Write_Str ("Opening """);
|
||||
Write_Str (Path);
|
||||
Write_Line (""".");
|
||||
Debug_Output ("Opening """ & Path & '"');
|
||||
end if;
|
||||
|
||||
-- Open the file
|
||||
|
@ -5556,10 +5516,7 @@ package body Prj.Nmsc is
|
|||
end if;
|
||||
|
||||
if Naming.Dot_Replacement = No_File then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line (" No dot_replacement specified");
|
||||
end if;
|
||||
|
||||
Debug_Output ("No dot_replacement specified");
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
@ -5592,10 +5549,7 @@ package body Prj.Nmsc is
|
|||
end if;
|
||||
|
||||
if Last = Filename'Last then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line (" no matching suffix");
|
||||
end if;
|
||||
|
||||
Debug_Output ("no matching suffix");
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
@ -5608,10 +5562,7 @@ package body Prj.Nmsc is
|
|||
if Is_Letter (Filename (J))
|
||||
and then not Is_Lower (Filename (J))
|
||||
then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line (" Invalid casing");
|
||||
end if;
|
||||
|
||||
Debug_Output ("Invalid casing");
|
||||
return;
|
||||
end if;
|
||||
end loop;
|
||||
|
@ -5621,10 +5572,7 @@ package body Prj.Nmsc is
|
|||
if Is_Letter (Filename (J))
|
||||
and then not Is_Upper (Filename (J))
|
||||
then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line (" Invalid casing");
|
||||
end if;
|
||||
|
||||
Debug_Output ("Invalid casing");
|
||||
return;
|
||||
end if;
|
||||
end loop;
|
||||
|
@ -5645,10 +5593,7 @@ package body Prj.Nmsc is
|
|||
if Dot_Repl /= "." then
|
||||
for Index in Filename'First .. Last loop
|
||||
if Filename (Index) = '.' then
|
||||
if Current_Verbosity = High then
|
||||
Write_Line (" Invalid name, contains dot");
|
||||
end if;
|
||||
|
||||
Debug_Output ("Invalid name, contains dot");
|
||||
return;
|
||||
end if;
|
||||
end loop;
|
||||
|
@ -5731,6 +5676,7 @@ package body Prj.Nmsc is
|
|||
|
||||
if Masked then
|
||||
if Current_Verbosity = High then
|
||||
Debug_Indent;
|
||||
Write_Str (" """ & Filename & """ contains the ");
|
||||
|
||||
if Kind = Spec then
|
||||
|
@ -5752,12 +5698,10 @@ package body Prj.Nmsc is
|
|||
and then Current_Verbosity = High
|
||||
then
|
||||
case Kind is
|
||||
when Spec => Write_Str (" spec of ");
|
||||
when Impl => Write_Str (" body of ");
|
||||
when Sep => Write_Str (" sep of ");
|
||||
when Spec => Debug_Output ("spec of", Unit);
|
||||
when Impl => Debug_Output ("body of", Unit);
|
||||
when Sep => Debug_Output ("sep of", Unit);
|
||||
end case;
|
||||
|
||||
Write_Line (Get_Name_String (Unit));
|
||||
end if;
|
||||
end Compute_Unit_Name;
|
||||
|
||||
|
@ -5869,9 +5813,10 @@ package body Prj.Nmsc is
|
|||
The_Name := Name_Find;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Debug_Indent;
|
||||
Write_Str ("Locate_Directory (""");
|
||||
Write_Str (Get_Name_String (The_Name));
|
||||
Write_Str (""", """);
|
||||
Write_Str (""", in """);
|
||||
Write_Str (The_Parent);
|
||||
Write_Line (""")");
|
||||
end if;
|
||||
|
@ -6411,6 +6356,7 @@ package body Prj.Nmsc is
|
|||
Source.Path := Path;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Debug_Indent;
|
||||
if Source.Path /= No_Path_Information then
|
||||
Write_Line ("Setting full path for "
|
||||
& Get_Name_String (Source.File)
|
||||
|
@ -6562,16 +6508,12 @@ package body Prj.Nmsc is
|
|||
Kind := Impl;
|
||||
Language := Tmp_Lang;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" implementation of language ");
|
||||
Write_Line (Get_Name_String (Display_Language_Name));
|
||||
end if;
|
||||
Debug_Output
|
||||
("Implementation of language ", Display_Language_Name);
|
||||
|
||||
elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" header of language ");
|
||||
Write_Line (Get_Name_String (Display_Language_Name));
|
||||
end if;
|
||||
Debug_Output
|
||||
("Header of language ", Display_Language_Name);
|
||||
|
||||
if Header_File then
|
||||
Alternate_Languages := new Language_List_Element'
|
||||
|
@ -6600,7 +6542,7 @@ package body Prj.Nmsc is
|
|||
Tmp_Lang := Project.Project.Languages;
|
||||
while Tmp_Lang /= No_Language_Index loop
|
||||
if Current_Verbosity = High then
|
||||
Write_Line
|
||||
Debug_Output
|
||||
("Testing language "
|
||||
& Get_Name_String (Tmp_Lang.Name)
|
||||
& " Header_File=" & Header_File'Img);
|
||||
|
@ -6639,10 +6581,8 @@ package body Prj.Nmsc is
|
|||
Tmp_Lang := Tmp_Lang.Next;
|
||||
end loop;
|
||||
|
||||
if Language = No_Language_Index
|
||||
and then Current_Verbosity = High
|
||||
then
|
||||
Write_Line (" not a source of any language");
|
||||
if Language = No_Language_Index then
|
||||
Debug_Output ("not a source of any language");
|
||||
end if;
|
||||
end Check_File_Naming_Schemes;
|
||||
|
||||
|
@ -6674,7 +6614,7 @@ package body Prj.Nmsc is
|
|||
if Current_Verbosity = High
|
||||
and then Source.File /= No_File
|
||||
then
|
||||
Write_Line ("Override kind for "
|
||||
Debug_Output ("Override kind for "
|
||||
& Get_Name_String (Source.File)
|
||||
& " kind=" & Source.Kind'Img);
|
||||
end if;
|
||||
|
@ -6714,11 +6654,9 @@ package body Prj.Nmsc is
|
|||
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("Checking file:");
|
||||
Write_Str (" Path = ");
|
||||
Write_Line (Get_Name_String (Path));
|
||||
Write_Str (" Rank =");
|
||||
Write_Line (Source_Dir_Rank'Img);
|
||||
Debug_Increase_Indent
|
||||
("Checking file (rank=" & Source_Dir_Rank'Img & ")",
|
||||
Name_Id (Path));
|
||||
end if;
|
||||
|
||||
if Name_Loc = No_Name_Location then
|
||||
|
@ -6825,6 +6763,8 @@ package body Prj.Nmsc is
|
|||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Debug_Decrease_Indent;
|
||||
end Check_File;
|
||||
|
||||
---------------------------------
|
||||
|
@ -6938,11 +6878,7 @@ package body Prj.Nmsc is
|
|||
Success : Boolean := False;
|
||||
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" Looking for subdirs of """);
|
||||
Write_Str (Path_Str);
|
||||
Write_Line ("""");
|
||||
end if;
|
||||
Debug_Output ("Looking for subdirs of ", Name_Id (Path.Display_Name));
|
||||
|
||||
if Recursive_Dirs.Get (Visited, Path.Name) then
|
||||
return Success;
|
||||
|
@ -7038,11 +6974,7 @@ package body Prj.Nmsc is
|
|||
Success : Boolean;
|
||||
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Write_Str ("Expand_Subdirectory_Pattern (""");
|
||||
Write_Str (Pattern);
|
||||
Write_Line (""")");
|
||||
end if;
|
||||
Debug_Increase_Indent ("Find_Pattern", Pattern_Id);
|
||||
|
||||
-- If we are looking for files, find the pattern for the files
|
||||
|
||||
|
@ -7063,9 +6995,10 @@ package body Prj.Nmsc is
|
|||
end if;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" file pattern=");
|
||||
Write_Line (Pattern (Pattern_End + 1 .. Pattern'Last));
|
||||
Write_Str (" Expand directory pattern=");
|
||||
Debug_Indent;
|
||||
Write_Str ("file_pattern=");
|
||||
Write_Str (Pattern (Pattern_End + 1 .. Pattern'Last));
|
||||
Write_Str (" dir_pattern=");
|
||||
Write_Line (Pattern (Pattern'First .. Pattern_End));
|
||||
end if;
|
||||
|
||||
|
@ -7138,6 +7071,8 @@ package body Prj.Nmsc is
|
|||
end case;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Debug_Decrease_Indent ("Done Find_Pattern");
|
||||
end Find_Pattern;
|
||||
|
||||
-- Local variables
|
||||
|
@ -7179,9 +7114,7 @@ package body Prj.Nmsc is
|
|||
Display_File_Name : File_Name_Type;
|
||||
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("Looking for sources:");
|
||||
end if;
|
||||
Debug_Increase_Indent ("Looking for sources");
|
||||
|
||||
-- Loop through subdirectories
|
||||
|
||||
|
@ -7213,10 +7146,10 @@ package body Prj.Nmsc is
|
|||
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Write_Attr
|
||||
("Source_Dir",
|
||||
Source_Directory (Source_Directory'First .. Dir_Last));
|
||||
Write_Line (Num_Nod.Number'Img);
|
||||
Debug_Increase_Indent
|
||||
("Source_Dir (node=" & Num_Nod.Number'Img & ") """
|
||||
& Source_Directory (Source_Directory'First .. Dir_Last)
|
||||
& '"');
|
||||
end if;
|
||||
|
||||
-- We look to every entry in the source directory
|
||||
|
@ -7238,11 +7171,6 @@ package body Prj.Nmsc is
|
|||
or else Is_Regular_File
|
||||
(Display_Source_Directory & Name (1 .. Last))
|
||||
then
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" Checking ");
|
||||
Write_Line (Name (1 .. Last));
|
||||
end if;
|
||||
|
||||
Name_Len := Last;
|
||||
Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
|
||||
Display_File_Name := Name_Find;
|
||||
|
@ -7291,12 +7219,9 @@ package body Prj.Nmsc is
|
|||
Excluded_Sources_Htable.Set
|
||||
(Project.Excluded, File_Name, FF);
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" excluded source """);
|
||||
Write_Str
|
||||
(Get_Name_String (Display_File_Name));
|
||||
Write_Line ("""");
|
||||
end if;
|
||||
Debug_Output
|
||||
("Excluded source ",
|
||||
Name_Id (Display_File_Name));
|
||||
|
||||
-- Will mark the file as removed, but 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,
|
||||
For_All_Sources => For_All_Sources);
|
||||
end;
|
||||
|
||||
else
|
||||
if Current_Verbosity = High then
|
||||
Debug_Output ("Ignore " & Name (1 .. Last));
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
Debug_Decrease_Indent;
|
||||
Close (Dir);
|
||||
end;
|
||||
end if;
|
||||
|
@ -7343,9 +7274,7 @@ package body Prj.Nmsc is
|
|||
Src_Dir_Rank := Num_Nod.Next;
|
||||
end loop;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Line ("end Looking for sources.");
|
||||
end if;
|
||||
Debug_Decrease_Indent ("end Looking for sources.");
|
||||
end Search_Directories;
|
||||
|
||||
----------------------------
|
||||
|
@ -7377,11 +7306,9 @@ package body Prj.Nmsc is
|
|||
No_Location, Project.Project);
|
||||
end if;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str ("Naming exception: Putting source file ");
|
||||
Write_Str (Get_Name_String (Source.File));
|
||||
Write_Line (" in Source_Names");
|
||||
end if;
|
||||
Debug_Output
|
||||
("Naming exception: adding source file to source_Names: ",
|
||||
Name_Id (Source.File));
|
||||
|
||||
Source_Names_Htable.Set
|
||||
(Project.Source_Names,
|
||||
|
@ -7568,6 +7495,7 @@ package body Prj.Nmsc is
|
|||
Source.In_Interfaces := False;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Debug_Indent;
|
||||
Write_Str ("Removing file ");
|
||||
Write_Line
|
||||
(Get_Name_String (Excluded.File)
|
||||
|
@ -7875,6 +7803,7 @@ package body Prj.Nmsc is
|
|||
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Debug_Indent;
|
||||
Write_Str ("Removing source ");
|
||||
Write_Str (Get_Name_String (Id.File));
|
||||
|
||||
|
@ -7978,7 +7907,7 @@ package body Prj.Nmsc is
|
|||
Element : String_Element;
|
||||
|
||||
begin
|
||||
Write_Line ("Source_Dirs:");
|
||||
Debug_Increase_Indent ("Source_Dirs:");
|
||||
|
||||
Current := Project.Source_Dirs;
|
||||
while Current /= Nil_String loop
|
||||
|
@ -7988,7 +7917,7 @@ package body Prj.Nmsc is
|
|||
Current := Element.Next;
|
||||
end loop;
|
||||
|
||||
Write_Line ("end Source_Dirs.");
|
||||
Debug_Decrease_Indent ("end Source_Dirs.");
|
||||
end Show_Source_Dirs;
|
||||
|
||||
---------------------------
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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 --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
@ -1308,10 +1308,7 @@ package body Prj.Part is
|
|||
end if;
|
||||
|
||||
if Current_Verbosity >= Medium then
|
||||
Write_Str ("Parsing """);
|
||||
Write_Str (Path_Name);
|
||||
Write_Char ('"');
|
||||
Write_Eol;
|
||||
Debug_Increase_Indent ("Parsing """ & Path_Name & '"');
|
||||
end if;
|
||||
|
||||
Project_Directory :=
|
||||
|
@ -1882,6 +1879,8 @@ package body Prj.Part is
|
|||
-- And restore the comment state that was saved
|
||||
|
||||
Tree.Restore_And_Free (Project_Comment_State);
|
||||
|
||||
Debug_Decrease_Indent ("Done parsing project");
|
||||
end Parse_Single_Project;
|
||||
|
||||
-----------------------
|
||||
|
@ -1899,9 +1898,7 @@ package body Prj.Part is
|
|||
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Write_Str ("Project_Name_From (""");
|
||||
Write_Str (Canonical);
|
||||
Write_Line (""")");
|
||||
Debug_Output ("Project_Name_From (""" & Canonical & """)");
|
||||
end if;
|
||||
|
||||
-- If the path name is empty, return No_Name to indicate failure
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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 --
|
||||
-- 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);
|
||||
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);
|
||||
|
||||
if Id /= Prj.No_Project then
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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 --
|
||||
-- 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;
|
||||
|
||||
Debug_Level : Integer := 0;
|
||||
-- Current indentation level for debug traces.
|
||||
|
||||
type Cst_String_Access is access constant String;
|
||||
|
||||
All_Lower_Case_Image : aliased constant String := "lowercase";
|
||||
|
@ -1300,6 +1303,77 @@ package body Prj is
|
|||
return Count;
|
||||
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
|
||||
-- Make sure that the standard config and user project file extensions are
|
||||
-- compatible with canonical case file naming.
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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 --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
@ -849,16 +849,6 @@ package Prj is
|
|||
Hash => Hash,
|
||||
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 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
|
||||
-- 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
|
||||
|
||||
All_Packages : constant String_List_Access := null;
|
||||
|
|
|
@ -7226,14 +7226,18 @@ package body Sem_Ch3 is
|
|||
Analyze (N);
|
||||
|
||||
-- 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
|
||||
-- the call to Build_Derived_Type above, then the check for type
|
||||
-- conformance would fail because earlier primitive subprograms
|
||||
-- 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.
|
||||
-- Subprograms are not derived, however, when Derive_Subps is False
|
||||
-- (since otherwise there could be redundant derivations).
|
||||
|
||||
if Derive_Subps then
|
||||
Derive_Subprograms (Parent_Type, Derived_Type);
|
||||
end if;
|
||||
|
||||
-- For tagged types the Discriminant_Constraint of the new base itype
|
||||
-- is inherited from the first subtype so that no subtype conformance
|
||||
|
|
Loading…
Reference in New Issue