[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1389ebf4dd78b0bcbaba52a7d2919020de28e77d..cfc585f626e7979e4d3644195b696e903b026ced 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 06450b199c31bec5b8a6ba1ad45a5fb9ffc66bf6..00cc88ad6e4a319b5a38216e248d79f43aa21cc7 100644 (file)
--- 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 efbdaf97d75168b2d6d523b3e23a446112c2b053..f4226c21c6f27498c1cbf9ba77473390ebabe11f 100644 (file)
--- 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 c185aef6e01e000f249ebd171c10ee21911b871a..830f51158c52d7c0b49088ec9f0a9f010e4b692f 100644 (file)
--- 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 978c6ba060f11a8113e5baf1c65f123bef93546f..d3761b386c93cbbc9273b5d3d1397aac594f72f3 100644 (file)
--- 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 7ad0d24129801c3182102af2250a43f3eaea3b2a..3afea799d853c78f12b33c05a8c1c9e278c13a83 100644 (file)
--- 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;