[multiple changes]

2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb Flag286 is now used as Is_Exception_Handler.
	(Is_Exception_Handler): New routine.
	(Set_Is_Exception_Handler): New routine.
	(Write_Entity_Flags): Output the status of Is_Exception_Handler.
	* einfo.ads New attribute Is_Exception_Handler along with
	occurrences in entities.
	(Is_Exception_Handler): New routine along with pragma Inline.
	(Set_Is_Exception_Handler): New routine along with pragma Inline.
	* exp_ch7.adb (Make_Transient_Block): Ignore blocks generated
	for exception handlers with a choice parameter.
	* sem_ch11.adb (Analyze_Exception_Handlers): Mark the scope
	generated for a choice parameter as an exception handler.

2016-04-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Build_Derived_Access_Type): Remove dead code.
	(Constrain_Discriminated_Type): In an instance, if the type has
	unknown discriminants, use its full view.
	(Process_Subtype): Check that the base type is private before
	adding subtype to Private_Dependents list.

2016-04-20  Bob Duff  <duff@adacore.com>

	* sem_ch13.adb: Minor comment fix.

From-SVN: r235264

7 files changed, 102 insertions, 34 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1409c79..b187ef1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* einfo.adb Flag286 is now used as Is_Exception_Handler.
+	(Is_Exception_Handler): New routine.
+	(Set_Is_Exception_Handler): New routine.
+	(Write_Entity_Flags): Output the status of Is_Exception_Handler.
+	* einfo.ads New attribute Is_Exception_Handler along with
+	occurrences in entities.
+	(Is_Exception_Handler): New routine along with pragma Inline.
+	(Set_Is_Exception_Handler): New routine along with pragma Inline.
+	* exp_ch7.adb (Make_Transient_Block): Ignore blocks generated
+	for exception handlers with a choice parameter.
+	* sem_ch11.adb (Analyze_Exception_Handlers): Mark the scope
+	generated for a choice parameter as an exception handler.
+
+2016-04-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Build_Derived_Access_Type): Remove dead code.
+	(Constrain_Discriminated_Type): In an instance, if the type has
+	unknown discriminants, use its full view.
+	(Process_Subtype): Check that the base type is private before
+	adding subtype to Private_Dependents list.
+
+2016-04-20  Bob Duff  <duff@adacore.com>
+
+	* sem_ch13.adb: Minor comment fix.
+
 2016-04-20  Yannick Moy  <moy@adacore.com>
 
 	* sem_ch4.adb: Fix typos in comments.
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 99e52d3..5586ea7 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -597,7 +597,7 @@ package body Einfo is
    --    Is_Uplevel_Referenced_Entity    Flag283
    --    Is_Unimplemented                Flag284
    --    Is_Volatile_Full_Access         Flag285
-   --    (unused)                        Flag286
+   --    Is_Exception_Handler            Flag286
    --    Rewritten_For_C                 Flag287
 
    --    (unused)                        Flag288
@@ -1976,12 +1976,6 @@ package body Einfo is
       return Flag146 (Id);
    end Is_Abstract_Type;
 
-   function Is_Local_Anonymous_Access (Id : E) return B is
-   begin
-      pragma Assert (Is_Access_Type (Id));
-      return Flag194 (Id);
-   end Is_Local_Anonymous_Access;
-
    function Is_Access_Constant (Id : E) return B is
    begin
       pragma Assert (Is_Access_Type (Id));
@@ -2137,6 +2131,12 @@ package body Einfo is
       return Flag52 (Id);
    end Is_Entry_Formal;
 
+   function Is_Exception_Handler (Id : E) return B is
+   begin
+      pragma Assert (Ekind (Id) = E_Block);
+      return Flag286 (Id);
+   end Is_Exception_Handler;
+
    function Is_Exported (Id : E) return B is
    begin
       return Flag99 (Id);
@@ -2307,6 +2307,12 @@ package body Einfo is
       return Flag25 (Id);
    end Is_Limited_Record;
 
+   function Is_Local_Anonymous_Access (Id : E) return B is
+   begin
+      pragma Assert (Is_Access_Type (Id));
+      return Flag194 (Id);
+   end Is_Local_Anonymous_Access;
+
    function Is_Machine_Code_Subprogram (Id : E) return B is
    begin
       pragma Assert (Is_Subprogram (Id));
@@ -5146,6 +5152,12 @@ package body Einfo is
       Set_Flag52 (Id, V);
    end Set_Is_Entry_Formal;
 
+   procedure Set_Is_Exception_Handler (Id : E; V : B := True) is
+   begin
+      pragma Assert (Ekind (Id) = E_Block);
+      Set_Flag286 (Id, V);
+   end Set_Is_Exception_Handler;
+
    procedure Set_Is_Exported (Id : E; V : B := True) is
    begin
       Set_Flag99 (Id, V);
@@ -8956,6 +8968,7 @@ package body Einfo is
       W ("Is_Dispatching_Operation",        Flag6   (Id));
       W ("Is_Eliminated",                   Flag124 (Id));
       W ("Is_Entry_Formal",                 Flag52  (Id));
+      W ("Is_Exception_Handler",            Flag286 (Id));
       W ("Is_Exported",                     Flag99  (Id));
       W ("Is_First_Subtype",                Flag70  (Id));
       W ("Is_For_Access_Subtype",           Flag118 (Id));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index e55c676..535fa39 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2428,6 +2428,11 @@ package Einfo is
 --    Is_Enumeration_Type (synthesized)
 --       Defined in all entities, true for enumeration types and subtypes
 
+--    Is_Exception_Handler (Flag286)
+--       Defined in blocks. Set if the block serves only as a scope of an
+--       exception handler with a choice parameter. Such a block does not
+--       physically appear in the tree.
+
 --    Is_Exported (Flag99)
 --       Defined in all entities. Set if the entity is exported. For now we
 --       only allow the export of constants, exceptions, functions, procedures
@@ -5621,6 +5626,7 @@ package Einfo is
    --    Discard_Names                       (Flag88)
    --    Has_Master_Entity                   (Flag21)
    --    Has_Nested_Block_With_Handler       (Flag101)
+   --    Is_Exception_Handler                (Flag286)
    --    Sec_Stack_Needed_For_Return         (Flag167)
    --    Uses_Sec_Stack                      (Flag95)
    --    Scope_Depth                         (synth)
@@ -6971,6 +6977,7 @@ package Einfo is
    function Is_Dispatching_Operation            (Id : E) return B;
    function Is_Eliminated                       (Id : E) return B;
    function Is_Entry_Formal                     (Id : E) return B;
+   function Is_Exception_Handler                (Id : E) return B;
    function Is_Exported                         (Id : E) return B;
    function Is_First_Subtype                    (Id : E) return B;
    function Is_For_Access_Subtype               (Id : E) return B;
@@ -7634,6 +7641,7 @@ package Einfo is
    procedure Set_Is_Dispatching_Operation        (Id : E; V : B := True);
    procedure Set_Is_Eliminated                   (Id : E; V : B := True);
    procedure Set_Is_Entry_Formal                 (Id : E; V : B := True);
+   procedure Set_Is_Exception_Handler            (Id : E; V : B := True);
    procedure Set_Is_Exported                     (Id : E; V : B := True);
    procedure Set_Is_First_Subtype                (Id : E; V : B := True);
    procedure Set_Is_For_Access_Subtype           (Id : E; V : B := True);
@@ -8434,6 +8442,7 @@ package Einfo is
    pragma Inline (Is_Entry);
    pragma Inline (Is_Entry_Formal);
    pragma Inline (Is_Enumeration_Type);
+   pragma Inline (Is_Exception_Handler);
    pragma Inline (Is_Exported);
    pragma Inline (Is_First_Subtype);
    pragma Inline (Is_Fixed_Point_Type);
@@ -8923,6 +8932,7 @@ package Einfo is
    pragma Inline (Set_Is_Dispatching_Operation);
    pragma Inline (Set_Is_Eliminated);
    pragma Inline (Set_Is_Entry_Formal);
+   pragma Inline (Set_Is_Exception_Handler);
    pragma Inline (Set_Is_Exported);
    pragma Inline (Set_Is_First_Subtype);
    pragma Inline (Set_Is_For_Access_Subtype);
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 60ea45b..04b60b5 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -7993,14 +7993,22 @@ package body Exp_Ch7 is
                elsif Ekind_In (S, E_Entry, E_Loop) then
                   exit;
 
-               --  In a procedure or a block, we release on exit of the
-               --  procedure or block. ??? memory leak can be created by
-               --  recursive calls.
-
-               elsif Ekind_In (S, E_Block, E_Procedure) then
+               --  In a procedure or a block, release the sec stack on exit
+               --  from the construct. Note that an exception handler with a
+               --  choice parameter requires a declarative region in the form
+               --  of a block. The block does not physically manifest in the
+               --  tree as it only serves as a scope. Do not consider such a
+               --  block because it will never release the sec stack.
+
+               --  ??? Memory leak can be created by recursive calls
+
+               elsif Ekind (S) = E_Procedure
+                 or else (Ekind (S) = E_Block
+                           and then not Is_Exception_Handler (S))
+               then
+                  Set_Uses_Sec_Stack (Current_Scope, False);
                   Set_Uses_Sec_Stack (S, True);
                   Check_Restriction (No_Secondary_Stack, Action);
-                  Set_Uses_Sec_Stack (Current_Scope, False);
                   exit;
 
                else
diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb
index 0b9f8ef..e03ec1c 100644
--- a/gcc/ada/sem_ch11.adb
+++ b/gcc/ada/sem_ch11.adb
@@ -214,6 +214,7 @@ package body Sem_Ch11 is
                   H_Scope :=
                     New_Internal_Entity
                      (E_Block, Current_Scope, Sloc (Choice), 'E');
+                  Set_Is_Exception_Handler (H_Scope);
                end if;
 
                Push_Scope (H_Scope);
@@ -318,11 +319,11 @@ package body Sem_Ch11 is
                                            N_Formal_Package_Declaration
                            then
                               Error_Msg_NE
-                                ("exception& is declared in "  &
-                                 "generic formal package", Id, Ent);
+                                ("exception& is declared in generic formal "
+                                 & "package", Id, Ent);
                               Error_Msg_N
-                                ("\and therefore cannot appear in " &
-                                 "handler (RM 11.2(8))", Id);
+                                ("\and therefore cannot appear in handler "
+                                 & "(RM 11.2(8))", Id);
                               exit;
 
                            --  If the exception is declared in an inner
@@ -362,8 +363,8 @@ package body Sem_Ch11 is
 
             Analyze_Statements (Statements (Handler));
 
-            --  If a choice was present, we created a special scope for it,
-            --  so this is where we pop that special scope to get rid of it.
+            --  If a choice was present, we created a special scope for it, so
+            --  this is where we pop that special scope to get rid of it.
 
             if Present (Choice) then
                End_Scope;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 77909a6..859e67e 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -10847,10 +10847,10 @@ package body Sem_Ch13 is
       --  After all forms of overriding have been resolved, a tagged type may
       --  be left with a set of implicitly declared and possibly erroneous
       --  abstract subprograms, null procedures and subprograms that require
-      --  overriding. If this set contains fully conformat homographs, then one
-      --  is chosen arbitrarily (already done during resolution), otherwise all
-      --  remaining non-fully conformant homographs are hidden from visibility
-      --  (Ada RM 8.3 12.3/2).
+      --  overriding. If this set contains fully conformant homographs, then
+      --  one is chosen arbitrarily (already done during resolution), otherwise
+      --  all remaining non-fully conformant homographs are hidden from
+      --  visibility (Ada RM 8.3 12.3/2).
 
       if Is_Tagged_Type (E) then
          Hide_Non_Overridden_Subprograms (E);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index f2e1115..cc82e71 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5962,16 +5962,6 @@ package body Sem_Ch3 is
       if Null_Exclusion_Present (Type_Definition (N)) then
          Set_Can_Never_Be_Null (Derived_Type);
 
-         --  What is with the "AND THEN FALSE" here ???
-
-         if Can_Never_Be_Null (Parent_Type)
-           and then False
-         then
-            Error_Msg_NE
-              ("`NOT NULL` not allowed (& already excludes null)",
-                N, Parent_Type);
-         end if;
-
       elsif Can_Never_Be_Null (Parent_Type) then
          Set_Can_Never_Be_Null (Derived_Type);
       end if;
@@ -5983,6 +5973,7 @@ package body Sem_Ch3 is
       --  ??? THIS CODE SHOULD NOT BE HERE REALLY.
 
       Desig_Type := Designated_Type (Derived_Type);
+
       if Is_Composite_Type (Desig_Type)
         and then (not Is_Array_Type (Desig_Type))
         and then Has_Discriminants (Desig_Type)
@@ -13048,6 +13039,18 @@ package body Sem_Ch3 is
          T := Designated_Type (T);
       end if;
 
+      --  In an instance it may be necessary to retrieve the full view of a
+      --  type with unknown discriminants. In other contexts the constraint
+      --  is illegal.
+
+      if In_Instance
+        and then Is_Private_Type (T)
+        and then Has_Unknown_Discriminants (T)
+        and then Present (Full_View (T))
+      then
+         T := Full_View (T);
+      end if;
+
       --  Ada 2005 (AI-412): Constrained incomplete subtypes are illegal.
       --  Avoid generating an error for access-to-incomplete subtypes.
 
@@ -20745,7 +20748,13 @@ package body Sem_Ch3 is
 
             when Private_Kind =>
                Constrain_Discriminated_Type (Def_Id, S, Related_Nod);
-               Set_Private_Dependents (Def_Id, New_Elmt_List);
+
+               --  The base type may be private but Def_Id may be a full view
+               --  in an instance.
+
+               if Is_Private_Type (Def_Id) then
+                  Set_Private_Dependents (Def_Id, New_Elmt_List);
+               end if;
 
                --  In case of an invalid constraint prevent further processing
                --  since the type constructed is missing expected fields.