[multiple changes]
2012-01-30 Pascal Obry <obry@adacore.com> * prj.ads, prj.adb (For_Each_Source): Add support for skipping sources coming from an encapsulated library. 2012-01-30 Ed Schonberg <schonberg@adacore.com> * sem_ch3.adb (Process-Full_View): fix typo. * sem_ch13.adb (Aalyze_Aspect_Specifications): if predicates appear on a private type and the full view is available, ensure existence of freeze node for full view. (Build_Predicate_Function): Attach predicate function to both views of a private type. 2012-01-30 Vincent Celier <celier@adacore.com> * prj-nmsc.adb (Check_Interfaces): Compute the Lib_Interface_ALIs for the project if either attribute Library_Interface or Interfaces is declared. (Check_Stand_Alone_Library): Use Lib_Interface_ALIs computed in Check_Interfaces. From-SVN: r183704
This commit is contained in:
Arnaud Charlet
parent
a76b09dce5
commit
de6e4fc494
6 changed files with 182 additions and 205 deletions
|
|
@ -1,3 +1,25 @@
|
|||
2012-01-30 Pascal Obry <obry@adacore.com>
|
||||
|
||||
* prj.ads, prj.adb (For_Each_Source): Add support for skipping
|
||||
sources coming from an encapsulated library.
|
||||
|
||||
2012-01-30 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Process-Full_View): fix typo.
|
||||
* sem_ch13.adb (Aalyze_Aspect_Specifications): if predicates
|
||||
appear on a private type and the full view is available, ensure
|
||||
existence of freeze node for full view.
|
||||
(Build_Predicate_Function): Attach predicate function to both
|
||||
views of a private type.
|
||||
|
||||
2012-01-30 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* prj-nmsc.adb (Check_Interfaces): Compute the Lib_Interface_ALIs
|
||||
for the project if either attribute Library_Interface or
|
||||
Interfaces is declared.
|
||||
(Check_Stand_Alone_Library): Use Lib_Interface_ALIs computed in
|
||||
Check_Interfaces.
|
||||
|
||||
2012-01-30 Pascal Obry <obry@adacore.com>
|
||||
|
||||
* prj-proc.adb (Recursive_Process): Set From_Encapsulated_Lib
|
||||
|
|
|
|||
|
|
@ -2554,6 +2554,8 @@ package body Prj.Nmsc is
|
|||
Project_2 : Project_Id;
|
||||
Other : Source_Id;
|
||||
|
||||
Interface_ALIs : String_List_Id := Nil_String;
|
||||
|
||||
begin
|
||||
if not Interfaces.Default then
|
||||
|
||||
|
|
@ -2599,6 +2601,31 @@ package body Prj.Nmsc is
|
|||
Other.Declared_In_Interfaces := True;
|
||||
end if;
|
||||
|
||||
if Source.Language.Config.Kind = Unit_Based then
|
||||
if Source.Kind = Spec
|
||||
and then Other_Part (Source) /= No_Source
|
||||
then
|
||||
Source := Other_Part (Source);
|
||||
end if;
|
||||
|
||||
String_Element_Table.Increment_Last
|
||||
(Shared.String_Elements);
|
||||
|
||||
Shared.String_Elements.Table
|
||||
(String_Element_Table.Last
|
||||
(Shared.String_Elements)) :=
|
||||
(Value => Name_Id (Source.Dep_Name),
|
||||
Index => 0,
|
||||
Display_Value => Name_Id (Source.Dep_Name),
|
||||
Location => No_Location,
|
||||
Flag => False,
|
||||
Next => Interface_ALIs);
|
||||
|
||||
Interface_ALIs :=
|
||||
String_Element_Table.Last
|
||||
(Shared.String_Elements);
|
||||
end if;
|
||||
|
||||
Debug_Output
|
||||
("interface: ", Name_Id (Source.Path.Name));
|
||||
end if;
|
||||
|
|
@ -2627,6 +2654,7 @@ package body Prj.Nmsc is
|
|||
end loop;
|
||||
|
||||
Project.Interfaces_Defined := True;
|
||||
Project.Lib_Interface_ALIs := Interface_ALIs;
|
||||
|
||||
elsif Project.Library and then not Library_Interface.Default then
|
||||
|
||||
|
|
@ -2668,6 +2696,7 @@ package body Prj.Nmsc is
|
|||
if not Source.Locally_Removed then
|
||||
Source.In_Interfaces := True;
|
||||
Source.Declared_In_Interfaces := True;
|
||||
Project.Interfaces_Defined := True;
|
||||
|
||||
Other := Other_Part (Source);
|
||||
|
||||
|
|
@ -2678,6 +2707,28 @@ package body Prj.Nmsc is
|
|||
|
||||
Debug_Output
|
||||
("interface: ", Name_Id (Source.Path.Name));
|
||||
|
||||
if Source.Kind = Spec
|
||||
and then Other_Part (Source) /= No_Source
|
||||
then
|
||||
Source := Other_Part (Source);
|
||||
end if;
|
||||
|
||||
String_Element_Table.Increment_Last
|
||||
(Shared.String_Elements);
|
||||
|
||||
Shared.String_Elements.Table
|
||||
(String_Element_Table.Last
|
||||
(Shared.String_Elements)) :=
|
||||
(Value => Name_Id (Source.Dep_Name),
|
||||
Index => 0,
|
||||
Display_Value => Name_Id (Source.Dep_Name),
|
||||
Location => No_Location,
|
||||
Flag => False,
|
||||
Next => Interface_ALIs);
|
||||
|
||||
Interface_ALIs :=
|
||||
String_Element_Table.Last (Shared.String_Elements);
|
||||
end if;
|
||||
|
||||
exit Big_Loop_2;
|
||||
|
|
@ -2692,7 +2743,7 @@ package body Prj.Nmsc is
|
|||
List := Element.Next;
|
||||
end loop;
|
||||
|
||||
Project.Interfaces_Defined := True;
|
||||
Project.Lib_Interface_ALIs := Interface_ALIs;
|
||||
|
||||
elsif Project.Extends /= No_Project
|
||||
and then Project.Extends.Interfaces_Defined
|
||||
|
|
@ -2710,6 +2761,8 @@ package body Prj.Nmsc is
|
|||
|
||||
Next (Iter);
|
||||
end loop;
|
||||
|
||||
Project.Lib_Interface_ALIs := Project.Extends.Lib_Interface_ALIs;
|
||||
end if;
|
||||
end Check_Interfaces;
|
||||
|
||||
|
|
@ -4282,12 +4335,6 @@ package body Prj.Nmsc is
|
|||
Project.Decl.Attributes,
|
||||
Shared);
|
||||
|
||||
Lib_Interfaces : constant Prj.Variable_Value :=
|
||||
Prj.Util.Value_Of
|
||||
(Snames.Name_Library_Interface,
|
||||
Project.Decl.Attributes,
|
||||
Shared);
|
||||
|
||||
Lib_Standalone : constant Prj.Variable_Value :=
|
||||
Prj.Util.Value_Of
|
||||
(Snames.Name_Library_Standalone,
|
||||
|
|
@ -4326,19 +4373,14 @@ package body Prj.Nmsc is
|
|||
|
||||
Auto_Init_Supported : Boolean;
|
||||
OK : Boolean := True;
|
||||
Source : Source_Id;
|
||||
Next_Proj : Project_Id;
|
||||
Iter : Source_Iterator;
|
||||
|
||||
begin
|
||||
Auto_Init_Supported := Project.Config.Auto_Init_Supported;
|
||||
|
||||
pragma Assert (Lib_Interfaces.Kind = List);
|
||||
-- It is a stand-alone library project file if there is at least one
|
||||
-- unit in the declared or inherited interface.
|
||||
|
||||
-- It is a stand-alone library project file if attribute
|
||||
-- Library_Interface is defined.
|
||||
|
||||
if Lib_Interfaces.Default then
|
||||
if Project.Lib_Interface_ALIs = Nil_String then
|
||||
if not Lib_Standalone.Default
|
||||
and then Get_Name_String (Lib_Standalone.Value) /= "no"
|
||||
then
|
||||
|
|
@ -4349,6 +4391,10 @@ package body Prj.Nmsc is
|
|||
end if;
|
||||
|
||||
else
|
||||
if Project.Standalone_Library = No then
|
||||
Project.Standalone_Library := Standard;
|
||||
end if;
|
||||
|
||||
-- The name of a stand-alone library needs to have the syntax of an
|
||||
-- Ada identifier.
|
||||
|
||||
|
|
@ -4388,198 +4434,74 @@ package body Prj.Nmsc is
|
|||
end if;
|
||||
end;
|
||||
|
||||
declare
|
||||
Interfaces : String_List_Id := Lib_Interfaces.Values;
|
||||
Interface_ALIs : String_List_Id := Nil_String;
|
||||
Unit : Name_Id;
|
||||
if Lib_Standalone.Default then
|
||||
Project.Standalone_Library := Standard;
|
||||
|
||||
begin
|
||||
if Lib_Standalone.Default then
|
||||
else
|
||||
Get_Name_String (Lib_Standalone.Value);
|
||||
To_Lower (Name_Buffer (1 .. Name_Len));
|
||||
|
||||
if Name_Buffer (1 .. Name_Len) = "standard" then
|
||||
Project.Standalone_Library := Standard;
|
||||
|
||||
else
|
||||
Get_Name_String (Lib_Standalone.Value);
|
||||
To_Lower (Name_Buffer (1 .. Name_Len));
|
||||
elsif Name_Buffer (1 .. Name_Len) = "encapsulated" then
|
||||
Project.Standalone_Library := Encapsulated;
|
||||
|
||||
if Name_Buffer (1 .. Name_Len) = "standard" then
|
||||
Project.Standalone_Library := Standard;
|
||||
|
||||
elsif Name_Buffer (1 .. Name_Len) = "encapsulated" then
|
||||
Project.Standalone_Library := Encapsulated;
|
||||
|
||||
elsif Name_Buffer (1 .. Name_Len) = "no" then
|
||||
Project.Standalone_Library := No;
|
||||
Error_Msg
|
||||
(Data.Flags,
|
||||
"wrong value for Library_Standalone "
|
||||
& "when Library_Interface defined",
|
||||
Lib_Standalone.Location, Project);
|
||||
|
||||
else
|
||||
Error_Msg
|
||||
(Data.Flags,
|
||||
"invalid value for attribute Library_Standalone",
|
||||
Lib_Standalone.Location, Project);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Library_Interface cannot be an empty list
|
||||
|
||||
if Interfaces = Nil_String then
|
||||
elsif Name_Buffer (1 .. Name_Len) = "no" then
|
||||
Project.Standalone_Library := No;
|
||||
Error_Msg
|
||||
(Data.Flags,
|
||||
"Library_Interface cannot be an empty list",
|
||||
Lib_Interfaces.Location, Project);
|
||||
end if;
|
||||
|
||||
-- Process each unit name specified in the attribute
|
||||
-- Library_Interface.
|
||||
|
||||
while Interfaces /= Nil_String loop
|
||||
Get_Name_String
|
||||
(Shared.String_Elements.Table (Interfaces).Value);
|
||||
To_Lower (Name_Buffer (1 .. Name_Len));
|
||||
|
||||
if Name_Len = 0 then
|
||||
Error_Msg
|
||||
(Data.Flags,
|
||||
"an interface cannot be an empty string",
|
||||
Shared.String_Elements.Table (Interfaces).Location,
|
||||
Project);
|
||||
|
||||
else
|
||||
Unit := Name_Find;
|
||||
Error_Msg_Name_1 := Unit;
|
||||
|
||||
Next_Proj := Project.Extends;
|
||||
|
||||
if Project.Qualifier = Aggregate_Library then
|
||||
|
||||
-- For an aggregate library we want to consider sources
|
||||
-- of all aggregated projects.
|
||||
|
||||
Iter := For_Each_Source (Data.Tree);
|
||||
|
||||
else
|
||||
Iter := For_Each_Source (Data.Tree, Project);
|
||||
end if;
|
||||
|
||||
loop
|
||||
while Prj.Element (Iter) /= No_Source
|
||||
and then
|
||||
(Prj.Element (Iter).Unit = null
|
||||
or else Prj.Element (Iter).Unit.Name /= Unit)
|
||||
loop
|
||||
Next (Iter);
|
||||
end loop;
|
||||
|
||||
Source := Prj.Element (Iter);
|
||||
exit when Source /= No_Source
|
||||
or else Next_Proj = No_Project;
|
||||
|
||||
Iter := For_Each_Source (Data.Tree, Next_Proj);
|
||||
Next_Proj := Next_Proj.Extends;
|
||||
end loop;
|
||||
|
||||
if Source /= No_Source then
|
||||
if Source.Kind = Sep then
|
||||
Source := No_Source;
|
||||
|
||||
elsif Source.Kind = Spec
|
||||
and then Other_Part (Source) /= No_Source
|
||||
then
|
||||
Source := Other_Part (Source);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if Source /= No_Source then
|
||||
if Source.Project /= Project
|
||||
and then not Is_Extending (Project, Source.Project)
|
||||
and then Project.Qualifier /= Aggregate_Library
|
||||
then
|
||||
Source := No_Source;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if Source = No_Source then
|
||||
Error_Msg
|
||||
(Data.Flags,
|
||||
"%% is not a unit of this project",
|
||||
Shared.String_Elements.Table (Interfaces).Location,
|
||||
Project);
|
||||
|
||||
else
|
||||
if Source.Kind = Spec
|
||||
and then Other_Part (Source) /= No_Source
|
||||
then
|
||||
Source := Other_Part (Source);
|
||||
end if;
|
||||
|
||||
String_Element_Table.Increment_Last
|
||||
(Shared.String_Elements);
|
||||
|
||||
Shared.String_Elements.Table
|
||||
(String_Element_Table.Last (Shared.String_Elements)) :=
|
||||
(Value => Name_Id (Source.Dep_Name),
|
||||
Index => 0,
|
||||
Display_Value => Name_Id (Source.Dep_Name),
|
||||
Location =>
|
||||
Shared.String_Elements.Table (Interfaces).Location,
|
||||
Flag => False,
|
||||
Next => Interface_ALIs);
|
||||
|
||||
Interface_ALIs :=
|
||||
String_Element_Table.Last (Shared.String_Elements);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Interfaces := Shared.String_Elements.Table (Interfaces).Next;
|
||||
end loop;
|
||||
|
||||
-- Put the list of Interface ALIs in the project data
|
||||
|
||||
Project.Lib_Interface_ALIs := Interface_ALIs;
|
||||
|
||||
-- Check value of attribute Library_Auto_Init and set
|
||||
-- Lib_Auto_Init accordingly.
|
||||
|
||||
if Lib_Auto_Init.Default then
|
||||
|
||||
-- If no attribute Library_Auto_Init is declared, then set auto
|
||||
-- init only if it is supported.
|
||||
|
||||
Project.Lib_Auto_Init := Auto_Init_Supported;
|
||||
"wrong value for Library_Standalone "
|
||||
& "when Library_Interface defined",
|
||||
Lib_Standalone.Location, Project);
|
||||
|
||||
else
|
||||
Get_Name_String (Lib_Auto_Init.Value);
|
||||
To_Lower (Name_Buffer (1 .. Name_Len));
|
||||
Error_Msg
|
||||
(Data.Flags,
|
||||
"invalid value for attribute Library_Standalone",
|
||||
Lib_Standalone.Location, Project);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if Name_Buffer (1 .. Name_Len) = "false" then
|
||||
Project.Lib_Auto_Init := False;
|
||||
-- Check value of attribute Library_Auto_Init and set
|
||||
-- Lib_Auto_Init accordingly.
|
||||
|
||||
elsif Name_Buffer (1 .. Name_Len) = "true" then
|
||||
if Auto_Init_Supported then
|
||||
Project.Lib_Auto_Init := True;
|
||||
if Lib_Auto_Init.Default then
|
||||
|
||||
else
|
||||
-- Library_Auto_Init cannot be "true" if auto init is not
|
||||
-- supported.
|
||||
-- If no attribute Library_Auto_Init is declared, then set auto
|
||||
-- init only if it is supported.
|
||||
|
||||
Error_Msg
|
||||
(Data.Flags,
|
||||
"library auto init not supported " &
|
||||
"on this platform",
|
||||
Lib_Auto_Init.Location, Project);
|
||||
end if;
|
||||
Project.Lib_Auto_Init := Auto_Init_Supported;
|
||||
|
||||
else
|
||||
Get_Name_String (Lib_Auto_Init.Value);
|
||||
To_Lower (Name_Buffer (1 .. Name_Len));
|
||||
|
||||
if Name_Buffer (1 .. Name_Len) = "false" then
|
||||
Project.Lib_Auto_Init := False;
|
||||
|
||||
elsif Name_Buffer (1 .. Name_Len) = "true" then
|
||||
if Auto_Init_Supported then
|
||||
Project.Lib_Auto_Init := True;
|
||||
|
||||
else
|
||||
-- Library_Auto_Init cannot be "true" if auto init is not
|
||||
-- supported.
|
||||
|
||||
Error_Msg
|
||||
(Data.Flags,
|
||||
"invalid value for attribute Library_Auto_Init",
|
||||
"library auto init not supported " &
|
||||
"on this platform",
|
||||
Lib_Auto_Init.Location, Project);
|
||||
end if;
|
||||
|
||||
else
|
||||
Error_Msg
|
||||
(Data.Flags,
|
||||
"invalid value for attribute Library_Auto_Init",
|
||||
Lib_Auto_Init.Location, Project);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- If attribute Library_Src_Dir is defined and not the empty string,
|
||||
-- check if the directory exist and is not the object directory or
|
||||
|
|
|
|||
|
|
@ -443,7 +443,13 @@ package body Prj is
|
|||
|
||||
if Iter.Language = No_Language_Index then
|
||||
if Iter.All_Projects then
|
||||
Iter.Project := Iter.Project.Next;
|
||||
loop
|
||||
Iter.Project := Iter.Project.Next;
|
||||
exit when Iter.Project = null
|
||||
or else Iter.Encapsulated_Libs
|
||||
or else not Iter.Project.From_Encapsulated_Lib;
|
||||
end loop;
|
||||
|
||||
Project_Changed (Iter);
|
||||
else
|
||||
Iter.Project := null;
|
||||
|
|
@ -464,19 +470,21 @@ package body Prj is
|
|||
---------------------
|
||||
|
||||
function For_Each_Source
|
||||
(In_Tree : Project_Tree_Ref;
|
||||
Project : Project_Id := No_Project;
|
||||
Language : Name_Id := No_Name) return Source_Iterator
|
||||
(In_Tree : Project_Tree_Ref;
|
||||
Project : Project_Id := No_Project;
|
||||
Language : Name_Id := No_Name;
|
||||
Encapsulated_Libs : Boolean := True) return Source_Iterator
|
||||
is
|
||||
Iter : Source_Iterator;
|
||||
begin
|
||||
Iter := Source_Iterator'
|
||||
(In_Tree => In_Tree,
|
||||
Project => In_Tree.Projects,
|
||||
All_Projects => Project = No_Project,
|
||||
Language_Name => Language,
|
||||
Language => No_Language_Index,
|
||||
Current => No_Source);
|
||||
(In_Tree => In_Tree,
|
||||
Project => In_Tree.Projects,
|
||||
All_Projects => Project = No_Project,
|
||||
Language_Name => Language,
|
||||
Language => No_Language_Index,
|
||||
Current => No_Source,
|
||||
Encapsulated_Libs => Encapsulated_Libs);
|
||||
|
||||
if Project /= null then
|
||||
while Iter.Project /= null
|
||||
|
|
@ -484,6 +492,13 @@ package body Prj is
|
|||
loop
|
||||
Iter.Project := Iter.Project.Next;
|
||||
end loop;
|
||||
|
||||
else
|
||||
while not Iter.Encapsulated_Libs
|
||||
and then Iter.Project.From_Encapsulated_Lib
|
||||
loop
|
||||
Iter.Project := Iter.Project.Next;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
Project_Changed (Iter);
|
||||
|
|
|
|||
|
|
@ -1180,7 +1180,8 @@ package Prj is
|
|||
-- True for virtual extending projects
|
||||
|
||||
Location : Source_Ptr := No_Location;
|
||||
-- The location in the project file source of the reserved word project
|
||||
-- The location in the project file source of the project name that
|
||||
-- immediately follows the reserved word "project".
|
||||
|
||||
---------------
|
||||
-- Languages --
|
||||
|
|
@ -1405,11 +1406,13 @@ package Prj is
|
|||
type Source_Iterator is private;
|
||||
|
||||
function For_Each_Source
|
||||
(In_Tree : Project_Tree_Ref;
|
||||
Project : Project_Id := No_Project;
|
||||
Language : Name_Id := No_Name) return Source_Iterator;
|
||||
(In_Tree : Project_Tree_Ref;
|
||||
Project : Project_Id := No_Project;
|
||||
Language : Name_Id := No_Name;
|
||||
Encapsulated_Libs : Boolean := True) return Source_Iterator;
|
||||
-- Returns an iterator for all the sources of a project tree, or a specific
|
||||
-- project, or a specific language.
|
||||
-- project, or a specific language. Include sources from aggregated libs if
|
||||
-- Aggregated_Libs is True.
|
||||
|
||||
function Element (Iter : Source_Iterator) return Source_Id;
|
||||
-- Return the current source (or No_Source if there are no more sources)
|
||||
|
|
@ -1847,7 +1850,10 @@ private
|
|||
Language_Name : Name_Id;
|
||||
-- Only sources of this language will be returned (or all if No_Name)
|
||||
|
||||
Current : Source_Id;
|
||||
Current : Source_Id;
|
||||
|
||||
Encapsulated_Libs : Boolean;
|
||||
-- True if we want to include the sources from encapsulated libs
|
||||
end record;
|
||||
|
||||
procedure Add_To_Buffer
|
||||
|
|
|
|||
|
|
@ -1423,6 +1423,9 @@ package body Sem_Ch13 is
|
|||
-- Make sure we have a freeze node (it might otherwise be
|
||||
-- missing in cases like subtype X is Y, and we would not
|
||||
-- have a place to build the predicate function).
|
||||
-- If the type is private, indicate that its completion
|
||||
-- has a freeze node, because that is the one that will be
|
||||
-- visible at freeze time.
|
||||
|
||||
Set_Has_Predicates (E);
|
||||
|
||||
|
|
@ -1431,6 +1434,7 @@ package body Sem_Ch13 is
|
|||
then
|
||||
Set_Has_Predicates (Full_View (E));
|
||||
Set_Has_Delayed_Aspects (Full_View (E));
|
||||
Ensure_Freeze_Node (Full_View (E));
|
||||
end if;
|
||||
|
||||
Ensure_Freeze_Node (E);
|
||||
|
|
@ -5056,6 +5060,14 @@ package body Sem_Ch13 is
|
|||
Set_Has_Predicates (SId);
|
||||
Set_Predicate_Function (Typ, SId);
|
||||
|
||||
-- The predicate function is shared between views of a type.
|
||||
|
||||
if Is_Private_Type (Typ)
|
||||
and then Present (Full_View (Typ))
|
||||
then
|
||||
Set_Predicate_Function (Full_View (Typ), SId);
|
||||
end if;
|
||||
|
||||
Spec :=
|
||||
Make_Function_Specification (Loc,
|
||||
Defining_Unit_Name => SId,
|
||||
|
|
|
|||
|
|
@ -18180,7 +18180,7 @@ package body Sem_Ch3 is
|
|||
|
||||
if Has_Predicates (Priv_T) then
|
||||
Set_Predicate_Function (Priv_T, Predicate_Function (Full_T));
|
||||
Set_Has_Predicates (Priv_T);
|
||||
Set_Has_Predicates (Full_T);
|
||||
end if;
|
||||
end Process_Full_View;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue