2010-10-08 Thomas Quinot <quinot@adacore.com>

	* sem_prag.adb: Minor reformatting.

2010-10-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Derived_Type_Declaration): In the private part of an
	instance, it is legal to derive from a non-limited actual when the
	formal type is untagged limited.
	* sem_ch12.adb (Instantiate_Type): For a formal private type, use
	analyzed formal as Generic_Parent_Type, to simplify later checks.

2010-10-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Insert_Default): If default value is already a
	raise_constraint_error do not rewrite it as new raise node, to prevent
	infinite loops in the warning removal machinery.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165156 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9f90c6e..00e7dba 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2010-10-08  Thomas Quinot  <quinot@adacore.com>
+
+       * sem_prag.adb: Minor reformatting.
+
+2010-10-08  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Derived_Type_Declaration): In the private part of an
+       instance, it is legal to derive from a non-limited actual when the
+       formal type is untagged limited.
+       * sem_ch12.adb (Instantiate_Type): For a formal private type, use
+       analyzed formal as Generic_Parent_Type, to simplify later checks.
+
+2010-10-08  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_res.adb (Insert_Default): If default value is already a
+       raise_constraint_error do not rewrite it as new raise node, to prevent
+       infinite loops in the warning removal machinery.
+
 2010-10-08  Robert Dewar  <dewar@adacore.com>
 
        * sem_util.adb, sem_prag.adb: Minor reformatting

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5ef38fa..2b6a12c 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -10355,6 +10355,10 @@ package body Sem_Ch12 is
       --  parent, but the analyzed formal that includes the interface
       --  operations of all its progenitors.
 
+      --  Same treatment for formal private types, so we can check whether the
+      --  type is tagged limited when validating derivations in the private
+      --  part. (See AI05-096).
+
       if Nkind (Def) = N_Formal_Derived_Type_Definition then
          if Present (Interface_List (Def)) then
             Set_Generic_Parent_Type (Decl_Node, A_Gen_T);
@@ -10363,7 +10367,7 @@ package body Sem_Ch12 is
          end if;
 
       elsif Nkind (Def) = N_Formal_Private_Type_Definition then
-         Set_Generic_Parent_Type (Decl_Node, Ancestor);
+         Set_Generic_Parent_Type (Decl_Node, A_Gen_T);
       end if;
 
       --  If the actual is a synchronized type that implements an interface,

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index fcb7f6d..eee4dd7 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -13738,9 +13738,24 @@ package body Sem_Ch3 is
              (not Is_Interface (Parent_Type)
                or else not Is_Limited_Interface (Parent_Type))
          then
-            Error_Msg_NE
-              ("parent type& of limited type must be limited",
-               N, Parent_Type);
+
+            --  AI05-0096 : a derivation in the private part of an instance is
+            --  legal if the generic formal is untagged limited, and the actual
+            --  is non-limited.
+
+            if Is_Generic_Actual_Type (Parent_Type)
+              and then In_Private_Part (Current_Scope)
+              and then
+                not Is_Tagged_Type
+                  (Generic_Parent_Type (Parent (Parent_Type)))
+            then
+               null;
+
+            else
+               Error_Msg_NE
+                 ("parent type& of limited type must be limited",
+                  N, Parent_Type);
+            end if;
          end if;
       end if;
    end Derived_Type_Declaration;

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index c361161..84f50ac 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -8074,9 +8074,9 @@ package body Sem_Prag is
                return;
             end if;
 
-            --  Ada 2012 (AI05-0030): Cannot apply the Implementation_kind
-            --  "By_Protected_Procedure" to the primitive procedure of a
-            --  task interface.
+            --  Ada 2012 (AI05-0030): Cannot apply the implementation_kind
+            --  By_Protected_Procedure to the primitive procedure of a task
+            --  interface.
 
             if Chars (Arg2) = Name_By_Protected_Procedure
               and then Is_Interface (Typ)

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 56a53be..ecc1dfb 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3120,8 +3120,12 @@ package body Sem_Res is
          --  If the default expression raises constraint error, then just
          --  silently replace it with an N_Raise_Constraint_Error node,
          --  since we already gave the warning on the subprogram spec.
+         --  If node is already a Raise_Constraint_Error leave as is, to
+         --  prevent loops in the warnings removal machinery.
 
-         if Raises_Constraint_Error (Actval) then
+         if Raises_Constraint_Error (Actval)
+           and then Nkind (Actval) /= N_Raise_Constraint_Error
+         then
             Rewrite (Actval,
               Make_Raise_Constraint_Error (Loc,
                 Reason => CE_Range_Check_Failed));