aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2012-01-30 11:35:19 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2012-01-30 11:35:19 +0100
commitde6e4fc49410404bb589a382822a37656b37c577 (patch)
treeaea86832d6154b5897072ec342e07628034557e9
parenta76b09dce5542b4eacfe5c0ec495cb708feb2a4c (diff)
downloadgcc-de6e4fc49410404bb589a382822a37656b37c577.zip
gcc-de6e4fc49410404bb589a382822a37656b37c577.tar.gz
gcc-de6e4fc49410404bb589a382822a37656b37c577.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog22
-rw-r--r--gcc/ada/prj-nmsc.adb292
-rw-r--r--gcc/ada/prj.adb35
-rw-r--r--gcc/ada/prj.ads18
-rw-r--r--gcc/ada/sem_ch13.adb12
-rw-r--r--gcc/ada/sem_ch3.adb2
6 files changed, 179 insertions, 202 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1389ebf..cfc585f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,27 @@
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
boolean value to true in the process list created by this routine.
* prj.ads (Project_List_Element): New field From_Encapsulated_Lib.
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 06450b1..00cc88a 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -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 attribute
- -- Library_Interface is defined.
+ -- It is a stand-alone library project file if there is at least one
+ -- unit in the declared or inherited interface.
- 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;
-
- begin
- if Lib_Standalone.Default then
- Project.Standalone_Library := Standard;
-
- 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;
+ if Lib_Standalone.Default then
+ Project.Standalone_Library := Standard;
- elsif Name_Buffer (1 .. Name_Len) = "encapsulated" then
- Project.Standalone_Library := Encapsulated;
+ else
+ Get_Name_String (Lib_Standalone.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
- 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);
+ if Name_Buffer (1 .. Name_Len) = "standard" then
+ Project.Standalone_Library := Standard;
- else
- Error_Msg
- (Data.Flags,
- "invalid value for attribute Library_Standalone",
- Lib_Standalone.Location, Project);
- end if;
- end if;
+ elsif Name_Buffer (1 .. Name_Len) = "encapsulated" then
+ Project.Standalone_Library := Encapsulated;
- -- Library_Interface cannot be an empty list
+ 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);
- if Interfaces = Nil_String then
+ else
Error_Msg
(Data.Flags,
- "Library_Interface cannot be an empty list",
- Lib_Interfaces.Location, Project);
+ "invalid value for attribute Library_Standalone",
+ Lib_Standalone.Location, Project);
end if;
+ 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.
+ -- Check value of attribute Library_Auto_Init and set
+ -- Lib_Auto_Init accordingly.
- Project.Lib_Auto_Init := Auto_Init_Supported;
+ if Lib_Auto_Init.Default then
- else
- Get_Name_String (Lib_Auto_Init.Value);
- To_Lower (Name_Buffer (1 .. Name_Len));
+ -- If no attribute Library_Auto_Init is declared, then set auto
+ -- init only if it is supported.
- if Name_Buffer (1 .. Name_Len) = "false" then
- Project.Lib_Auto_Init := False;
+ Project.Lib_Auto_Init := Auto_Init_Supported;
- elsif Name_Buffer (1 .. Name_Len) = "true" then
- if Auto_Init_Supported then
- Project.Lib_Auto_Init := True;
+ else
+ Get_Name_String (Lib_Auto_Init.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
- else
- -- Library_Auto_Init cannot be "true" if auto init is not
- -- supported.
+ if Name_Buffer (1 .. Name_Len) = "false" then
+ Project.Lib_Auto_Init := False;
- Error_Msg
- (Data.Flags,
- "library auto init not supported " &
- "on this platform",
- Lib_Auto_Init.Location, Project);
- end if;
+ 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
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index efbdaf9..f4226c2 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -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);
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index c185aef..830f511 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -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
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 978c6ba..d3761b3 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -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,
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 7ad0d24..3afea79 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -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;