[multiple changes]

2015-10-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch9.adb (Analyze_Single_Protected_Declaration): The anonymous
	object no longer comes from source.
	(Analyze_Single_Task_Declaration): The anonymous object no longer
	comes from source.
	* sem_prag.adb (Analyze_Pragma): The analysis of pragma SPARK_Mode
	now recognizes the internal anonymous object created for a single
	concurren type as a valid context.
	(Find_Related_Context): The internal anonymous object created for a
	single concurrent type is now a valid context.
	(Find_Related_Declaration_Or_Body): The internal anonymous object
	created for a single concurrent type is now a valid context.

2015-10-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Inherit_Rep_Item_Chain): Another another guard
	to prevent circularities in the rep_item_chain of the full view
	of a type extension in a child unit that extends a private type
	from the parent.

From-SVN: r229374

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cec92831d622635d42c6acb3138aa414c70d3154..86893ba18a1d9124fe30ec59afeea8679b83b501 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2015-10-26  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_ch9.adb (Analyze_Single_Protected_Declaration): The anonymous
+       object no longer comes from source.
+       (Analyze_Single_Task_Declaration): The anonymous object no longer
+       comes from source.
+       * sem_prag.adb (Analyze_Pragma): The analysis of pragma SPARK_Mode
+       now recognizes the internal anonymous object created for a single
+       concurren type as a valid context.
+       (Find_Related_Context): The internal anonymous object created for a
+       single concurrent type is now a valid context.
+       (Find_Related_Declaration_Or_Body): The internal anonymous object
+       created for a single concurrent type is now a valid context.
+
+2015-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_util.adb (Inherit_Rep_Item_Chain): Another another guard
+       to prevent circularities in the rep_item_chain of the full view
+       of a type extension in a child unit that extends a private type
+       from the parent.
+
 2015-10-26  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * atree.ads, atree.adb (Ekind_In): New 10 and 11 parameter versions.

diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 2b3e42bf0982c3be6533e601820d0c0afc59a97c..47cd3c663bb1ef9d21404b1aee267c527a0b8047 100644 (file)
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -2665,11 +2665,6 @@ package body Sem_Ch9 is
           Defining_Identifier => Obj_Id,
           Object_Definition   => New_Occurrence_Of (Typ, Loc));
 
-      --  Relocate the aspects that appear on the original single protected
-      --  declaration to the object as the object is the visible name.
-
-      Set_Comes_From_Source (Obj_Decl, True);
-
       Insert_After (N, Obj_Decl);
       Mark_Rewrite_Insertion (Obj_Decl);
 
@@ -2756,11 +2751,6 @@ package body Sem_Ch9 is
           Defining_Identifier => Obj_Id,
           Object_Definition   => New_Occurrence_Of (Typ, Loc));
 
-      --  Relocate the aspects that appear on the original single protected
-      --  declaration to the object as the object is the visible name.
-
-      Set_Comes_From_Source (Obj_Decl, True);
-
       Insert_After (N, Obj_Decl);
       Mark_Rewrite_Insertion (Obj_Decl);
 

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index c7c3f377ba839f7c5f2fb8df41e0f26df93a0be1..a8998cc78cf32c478cca0e4c7e7472b72544b15f 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -20543,6 +20543,20 @@ package body Sem_Prag is
                      Process_Overloadable (Stmt);
                      return;
 
+                  --  The pragma applies to the anonymous object created for a
+                  --  single concurrent type.
+
+                  --    protected type Anon_Prot_Typ ...;
+                  --    Obj : Anon_Prot_Typ;
+                  --    pragma SPARK_Mode ...;
+
+                  elsif Nkind (Stmt) = N_Object_Declaration
+                    and then Is_Single_Concurrent_Object
+                               (Defining_Entity (Stmt))
+                  then
+                     Process_Overloadable (Stmt);
+                     return;
+
                   --  Skip internally generated code
 
                   elsif not Comes_From_Source (Stmt) then
@@ -20567,20 +20581,6 @@ package body Sem_Prag is
                      Process_Overloadable (Stmt);
                      return;
 
-                  --  The pragma applies to the anonymous object created for a
-                  --  single concurrent type.
-
-                  --    protected type Anon_Prot_Typ ...;
-                  --    Obj : Anon_Prot_Typ;
-                  --    pragma SPARK_Mode ...;
-
-                  elsif Nkind (Stmt) = N_Object_Declaration
-                    and then Is_Single_Concurrent_Object
-                               (Defining_Entity (Stmt))
-                  then
-                     Process_Overloadable (Stmt);
-                     return;
-
                   --  Otherwise the pragma does not apply to a legal construct
                   --  or it does not appear at the top of a declarative or a
                   --  statement list. Issue an error and stop the analysis.
@@ -26697,7 +26697,15 @@ package body Sem_Prag is
          --  Skip internally generated code
 
          elsif not Comes_From_Source (Stmt) then
-            null;
+
+            --  The anonymous object created for a single concurrent type is a
+            --  suitable context.
+
+            if Nkind (Stmt) = N_Object_Declaration
+              and then Is_Single_Concurrent_Object (Defining_Entity (Stmt))
+            then
+               return Stmt;
+            end if;
 
          --  Return the current source construct
 
@@ -26800,7 +26808,16 @@ package body Sem_Prag is
          --  Skip internally generated code
 
          elsif not Comes_From_Source (Stmt) then
-            if Nkind (Stmt) = N_Subprogram_Declaration then
+
+            --  The anonymous object created for a single concurrent type is a
+            --  suitable context.
+
+            if Nkind (Stmt) = N_Object_Declaration
+              and then Is_Single_Concurrent_Object (Defining_Entity (Stmt))
+            then
+               return Stmt;
+
+            elsif Nkind (Stmt) = N_Subprogram_Declaration then
 
                --  The subprogram declaration is an internally generated spec
                --  for an expression function.

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 112c6e764ac6ca116a9c7a7b003418b971d16f3d..8e33f4c403630cd8b2a4a3e1bd4460c0a289e741 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10320,6 +10320,25 @@ package body Sem_Util is
          Item := Next_Rep_Item (Item);
       end loop;
 
+      Item := First_Rep_Item (From_Typ);
+
+      --  Additional check when both parent and current type have rep.
+      --  items, to prevent circularities when the derivation completes
+      --  a private declaration and inherits from both views of the parent.
+      --  There may be a remaining problem with the proper ordering of
+      --  attribute specifications and aspects on the chains of the four
+      --  entities involved. ???
+
+      if Present (Item) and then Present (From_Item) then
+         while Present (Item) loop
+            if Item = First_Rep_Item (Typ) then
+               return;
+            end if;
+
+            Item := Next_Rep_Item (Item);
+         end loop;
+      end if;
+
       --  When the destination type has a rep item chain, the chain of the
       --  source type is appended to it.