[multiple changes]

2015-05-26  Robert Dewar  <dewar@adacore.com>

	* aspects.ads, aspects.adb: Add aspect Disable_Controlled.
	* einfo.ads, einfo.adb (Disable_Controlled): New flag.
	(Is_Controlled_Active): New function.
	* exp_ch3.adb (Expand_Freeze_Record_Type): Use
	Is_Controlled_Active.
	* exp_util.adb (Needs_Finalization): Finalization not needed
	if Disable_Controlled set.
	* freeze.adb (Freeze_Array_Type): Do not set
	Has_Controlled_Component if the component has Disable_Controlled.
	(Freeze_Record_Type): ditto.
	* sem_ch13.adb (Decorate): Minor reformatting.
	(Analyze_Aspect_Specifications): Implement Disable_Controlled.
	* sem_ch3.adb (Analyze_Object_Declaration): Handle
	Disable_Controlled.
	(Array_Type_Declaration): ditto.
	(Build_Derived_Private_Type): ditto.
	(Build_Derived_Type): ditto.
	(Record_Type_Definition): ditto.
	* snames.ads-tmpl: Add Name_Disable_Controlled.

2015-05-26  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_ch6.adb (Expand_Actuals): Use a constant declaration instead
	of a renaming to capture the return value of a function call.
	(Expand_Simple_Function_Return): Call Remove_Side_Effects
	instead of removing side effects manually before the call to
	_Postconditions.

From-SVN: r223667

12 files changed, 150 insertions, 138 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c0d03c3..accd480 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,35 @@
 2015-05-26  Robert Dewar  <dewar@adacore.com>
 
+	* aspects.ads, aspects.adb: Add aspect Disable_Controlled.
+	* einfo.ads, einfo.adb (Disable_Controlled): New flag.
+	(Is_Controlled_Active): New function.
+	* exp_ch3.adb (Expand_Freeze_Record_Type): Use
+	Is_Controlled_Active.
+	* exp_util.adb (Needs_Finalization): Finalization not needed
+	if Disable_Controlled set.
+	* freeze.adb (Freeze_Array_Type): Do not set
+	Has_Controlled_Component if the component has Disable_Controlled.
+	(Freeze_Record_Type): ditto.
+	* sem_ch13.adb (Decorate): Minor reformatting.
+	(Analyze_Aspect_Specifications): Implement Disable_Controlled.
+	* sem_ch3.adb (Analyze_Object_Declaration): Handle
+	Disable_Controlled.
+	(Array_Type_Declaration): ditto.
+	(Build_Derived_Private_Type): ditto.
+	(Build_Derived_Type): ditto.
+	(Record_Type_Definition): ditto.
+	* snames.ads-tmpl: Add Name_Disable_Controlled.
+
+2015-05-26  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_ch6.adb (Expand_Actuals): Use a constant declaration instead
+	of a renaming to capture the return value of a function call.
+	(Expand_Simple_Function_Return): Call Remove_Side_Effects
+	instead of removing side effects manually before the call to
+	_Postconditions.
+
+2015-05-26  Robert Dewar  <dewar@adacore.com>
+
 	* exp_ch4.adb (Expand_N_Op_Expon): Deal with problem of wrong
 	order in calling Duplicate_Subexpr.
 	* einfo.ads: Fix documentation of Object/Value size for scalar types.
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 976b89d..bf01f77 100644
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -517,6 +517,7 @@ package body Aspects is
     Aspect_Depends                      => Aspect_Depends,
     Aspect_Dimension                    => Aspect_Dimension,
     Aspect_Dimension_System             => Aspect_Dimension_System,
+    Aspect_Disable_Controlled           => Aspect_Disable_Controlled,
     Aspect_Discard_Names                => Aspect_Discard_Names,
     Aspect_Dispatching_Domain           => Aspect_Dispatching_Domain,
     Aspect_Dynamic_Predicate            => Aspect_Predicate,
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 41fa9610..e215622 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -171,6 +171,7 @@ package Aspects is
       Aspect_Asynchronous,
       Aspect_Atomic,
       Aspect_Atomic_Components,
+      Aspect_Disable_Controlled,            -- GNAT
       Aspect_Discard_Names,
       Aspect_Effective_Reads,               -- GNAT
       Aspect_Effective_Writes,              -- GNAT
@@ -414,6 +415,7 @@ package Aspects is
       Aspect_Depends                      => Name_Depends,
       Aspect_Dimension                    => Name_Dimension,
       Aspect_Dimension_System             => Name_Dimension_System,
+      Aspect_Disable_Controlled           => Name_Disable_Controlled,
       Aspect_Discard_Names                => Name_Discard_Names,
       Aspect_Dispatching_Domain           => Name_Dispatching_Domain,
       Aspect_Dynamic_Predicate            => Name_Dynamic_Predicate,
@@ -704,6 +706,7 @@ package Aspects is
       Aspect_Depends                      => Never_Delay,
       Aspect_Dimension                    => Never_Delay,
       Aspect_Dimension_System             => Never_Delay,
+      Aspect_Disable_Controlled           => Never_Delay,
       Aspect_Effective_Reads              => Never_Delay,
       Aspect_Effective_Writes             => Never_Delay,
       Aspect_Extensions_Visible           => Never_Delay,
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 2c9a4ba..285e924 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -558,6 +558,7 @@ package body Einfo is
 
    --    Has_Implicit_Dereference        Flag251
    --    Is_Processed_Transient          Flag252
+   --    Disable_Controlled              Flag253
    --    Is_Implementation_Defined       Flag254
    --    Is_Predicate_Function           Flag255
    --    Is_Predicate_Function_M         Flag256
@@ -595,7 +596,6 @@ package body Einfo is
    --    Is_Volatile_Full_Access         Flag285
    --    Needs_Typedef                   Flag286
 
-   --    (unused)                        Flag253
    --    (unused)                        Flag287
    --    (unused)                        Flag288
    --    (unused)                        Flag289
@@ -1026,6 +1026,11 @@ package body Einfo is
       return Node20 (Id);
    end Directly_Designated_Type;
 
+   function Disable_Controlled (Id : E) return B is
+   begin
+      return Flag253 (Base_Type (Id));
+   end Disable_Controlled;
+
    function Discard_Names (Id : E) return B is
    begin
       return Flag88 (Id);
@@ -3941,6 +3946,12 @@ package body Einfo is
       Set_Node20 (Id, V);
    end Set_Directly_Designated_Type;
 
+   procedure Set_Disable_Controlled (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
+      Set_Flag253 (Id, V);
+   end Set_Disable_Controlled;
+
    procedure Set_Discard_Names (Id : E; V : B := True) is
    begin
       Set_Flag88 (Id, V);
@@ -7394,6 +7405,15 @@ package body Einfo is
         K = E_Constant or else K = E_In_Parameter or else K = E_Loop_Parameter;
    end Is_Constant_Object;
 
+   --------------------------
+   -- Is_Controlled_Active --
+   --------------------------
+
+   function Is_Controlled_Active (Id : E) return B is
+   begin
+      return Is_Controlled (Id) and then not Disable_Controlled (Id);
+   end Is_Controlled_Active;
+
    --------------------
    -- Is_Discriminal --
    --------------------
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index b5d7769..1c0ee51 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -911,6 +911,10 @@ package Einfo is
 --       Designated_Type obtains this full type in the case of access to an
 --       incomplete type.
 
+--    Disable_Controlled (Flag253)
+--      Present in all entities. Set for controlled type (Is_Controlled flag
+--      set) if the aspect Disable_Controlled is active for the type.
+
 --    Discard_Names (Flag88)
 --       Defined in types and exception entities. Set if pragma Discard_Names
 --       applies to the entity. It is also set for declarative regions and
@@ -2337,6 +2341,10 @@ package Einfo is
 --       i.e. is either a descendant of Ada.Finalization.Controlled or of
 --       Ada.Finalization.Limited_Controlled.
 
+--    Is_Controlled_Active (synth) [base type only]
+--       Defined in all type entities. Set if Is_Controlled is set for the
+--       type, and Disable_Controlled is not set.
+
 --    Is_Controlling_Formal (Flag97)
 --       Defined in all Formal_Kind entities. Marks the controlling parameters
 --       of dispatching operations.
@@ -5413,6 +5421,7 @@ package Einfo is
    --    Linker_Section_Pragma               (Node33)
 
    --    Depends_On_Private                  (Flag14)
+   --    Disable_Controlled                  (Flag253)
    --    Discard_Names                       (Flag88)
    --    Finalize_Storage_Only               (Flag158)  (base type only)
    --    From_Limited_With                   (Flag159)
@@ -5491,6 +5500,7 @@ package Einfo is
    --    Invariant_Procedure                 (synth)
    --    Is_Access_Protected_Subprogram_Type (synth)
    --    Is_Atomic_Or_VFA                    (synth)
+   --    Is_Controlled_Active                (synth)
    --    Predicate_Function                  (synth)
    --    Predicate_Function_M                (synth)
    --    Root_Type                           (synth)
@@ -6724,6 +6734,7 @@ package Einfo is
    function Digits_Value                        (Id : E) return U;
    function Direct_Primitive_Operations         (Id : E) return L;
    function Directly_Designated_Type            (Id : E) return E;
+   function Disable_Controlled                  (Id : E) return B;
    function Discard_Names                       (Id : E) return B;
    function Discriminal                         (Id : E) return E;
    function Discriminal_Link                    (Id : E) return E;
@@ -7206,6 +7217,7 @@ package Einfo is
    function Is_Base_Type                        (Id : E) return B;
    function Is_Boolean_Type                     (Id : E) return B;
    function Is_Constant_Object                  (Id : E) return B;
+   function Is_Controlled_Active                (Id : E) return B;
    function Is_Discriminal                      (Id : E) return B;
    function Is_Dynamic_Scope                    (Id : E) return B;
    function Is_External_State                   (Id : E) return B;
@@ -7380,6 +7392,7 @@ package Einfo is
    procedure Set_Digits_Value                    (Id : E; V : U);
    procedure Set_Direct_Primitive_Operations     (Id : E; V : L);
    procedure Set_Directly_Designated_Type        (Id : E; V : E);
+   procedure Set_Disable_Controlled              (Id : E; V : B := True);
    procedure Set_Discard_Names                   (Id : E; V : B := True);
    procedure Set_Discriminal                     (Id : E; V : E);
    procedure Set_Discriminal_Link                (Id : E; V : E);
@@ -8155,6 +8168,7 @@ package Einfo is
    pragma Inline (Digits_Value);
    pragma Inline (Direct_Primitive_Operations);
    pragma Inline (Directly_Designated_Type);
+   pragma Inline (Disable_Controlled);
    pragma Inline (Discard_Names);
    pragma Inline (Discriminal);
    pragma Inline (Discriminal_Link);
@@ -8658,6 +8672,7 @@ package Einfo is
    pragma Inline (Set_Digits_Value);
    pragma Inline (Set_Direct_Primitive_Operations);
    pragma Inline (Set_Directly_Designated_Type);
+   pragma Inline (Set_Disable_Controlled);
    pragma Inline (Set_Discard_Names);
    pragma Inline (Set_Discriminal);
    pragma Inline (Set_Discriminal_Link);
@@ -9062,6 +9077,7 @@ package Einfo is
 
    pragma Inline (Base_Type);
    pragma Inline (Is_Base_Type);
+   pragma Inline (Is_Controlled_Active);
    pragma Inline (Is_Package_Or_Generic_Package);
    pragma Inline (Is_Packed_Array);
    pragma Inline (Is_Subprogram_Or_Generic_Subprogram);
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 6223c97..0bb41fd 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6936,9 +6936,10 @@ package body Exp_Ch3 is
          --  type. See Make_CW_Equivalent_Type.
 
          if not Is_Class_Wide_Equivalent_Type (Def_Id)
-           and then (Has_Controlled_Component (Comp_Typ)
-                      or else (Chars (Comp) /= Name_uParent
-                                and then Is_Controlled (Comp_Typ)))
+           and then
+             (Has_Controlled_Component (Comp_Typ)
+               or else (Chars (Comp) /= Name_uParent
+                         and then (Is_Controlled_Active (Comp_Typ))))
          then
             Set_Has_Controlled_Component (Def_Id);
          end if;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 73ee513..e89103c 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1979,7 +1979,7 @@ package body Exp_Ch6 is
                --  To deal with this, we replace the call by
 
                --    do
-               --       Tnnn : function-result-type renames function-call;
+               --       Tnnn : constant function-result-type := function-call;
                --       Post_Call actions
                --    in
                --       Tnnn;
@@ -1996,10 +1996,11 @@ package body Exp_Ch6 is
 
                begin
                   Prepend_To (Post_Call,
-                    Make_Object_Renaming_Declaration (Loc,
+                    Make_Object_Declaration (Loc,
                       Defining_Identifier => Tnnn,
-                      Subtype_Mark        => New_Occurrence_Of (FRTyp, Loc),
-                      Name                => Name));
+                      Object_Definition   => New_Occurrence_Of (FRTyp, Loc),
+                      Constant_Present    => True,
+                      Expression          => Name));
 
                   Rewrite (N,
                     Make_Expression_With_Actions (Loc,
@@ -6619,111 +6620,23 @@ package body Exp_Ch6 is
       if Ekind (Scope_Id) = E_Function
         and then Present (Postconditions_Proc (Scope_Id))
       then
-         --  We are going to reference the returned value twice in this case,
-         --  once in the call to _Postconditions, and once in the actual return
-         --  statement, but we can't have side effects happening twice, and in
-         --  any case for efficiency we don't want to do the computation twice.
-
-         --  If the returned expression is an entity name, we don't need to
-         --  worry since it is efficient and safe to reference it twice, that's
-         --  also true for literals other than string literals, and for the
-         --  case of X.all where X is an entity name.
-
-         if Is_Entity_Name (Exp)
-           or else Nkind_In (Exp, N_Character_Literal,
-                                  N_Integer_Literal,
-                                  N_Real_Literal)
-           or else (Nkind (Exp) = N_Explicit_Dereference
-                     and then Is_Entity_Name (Prefix (Exp)))
+         --  In the case of discriminated objects, we have created a
+         --  constrained subtype above, and used the underlying type. This
+         --  transformation is post-analysis and harmless, except that now the
+         --  call to the post-condition will be analyzed and the type kinds
+         --  have to match.
+
+         if Nkind (Exp) = N_Unchecked_Type_Conversion
+           and then Is_Private_Type (R_Type) /= Is_Private_Type (Etype (Exp))
          then
-            null;
-
-         --  Otherwise we are going to need a temporary to capture the value
-
-         else
-            declare
-               ExpR : Node_Id            := Relocate_Node (Exp);
-               Tnn  : constant Entity_Id := Make_Temporary (Loc, 'T', ExpR);
-
-            begin
-               --  In the case of discriminated objects, we have created a
-               --  constrained subtype above, and used the underlying type.
-               --  This transformation is post-analysis and harmless, except
-               --  that now the call to the post-condition will be analyzed and
-               --  type kinds have to match.
-
-               if Nkind (ExpR) = N_Unchecked_Type_Conversion
-                 and then
-                   Is_Private_Type (R_Type) /= Is_Private_Type (Etype (ExpR))
-               then
-                  ExpR := Expression (ExpR);
-               end if;
-
-               --  For a complex expression of an elementary type, capture
-               --  value in the temporary and use it as the reference.
-
-               if Is_Elementary_Type (R_Type) then
-                  Insert_Action (Exp,
-                    Make_Object_Declaration (Loc,
-                      Defining_Identifier => Tnn,
-                      Constant_Present    => True,
-                      Object_Definition   => New_Occurrence_Of (R_Type, Loc),
-                      Expression          => ExpR),
-                    Suppress => All_Checks);
-
-                  Rewrite (Exp, New_Occurrence_Of (Tnn, Loc));
-
-               --  If we have something we can rename, generate a renaming of
-               --  the object and replace the expression with a reference
-
-               elsif Is_Object_Reference (Exp) then
-                  Insert_Action (Exp,
-                    Make_Object_Renaming_Declaration (Loc,
-                      Defining_Identifier => Tnn,
-                      Subtype_Mark        => New_Occurrence_Of (R_Type, Loc),
-                      Name                => ExpR),
-                    Suppress => All_Checks);
-
-                  Rewrite (Exp, New_Occurrence_Of (Tnn, Loc));
-
-               --  Otherwise we have something like a string literal or an
-               --  aggregate. We could copy the value, but that would be
-               --  inefficient. Instead we make a reference to the value and
-               --  capture this reference with a renaming, the expression is
-               --  then replaced by a dereference of this renaming.
+            Rewrite (Exp, Expression (Relocate_Node (Exp)));
+         end if;
 
-               else
-                  --  For now, copy the value, since the code below does not
-                  --  seem to work correctly ???
+         --  We are going to reference the returned value twice in this case,
+         --  once in the call to _Postconditions, and once in the actual return
+         --  statement, but we can't have side effects happening twice.
 
-                  Insert_Action (Exp,
-                    Make_Object_Declaration (Loc,
-                      Defining_Identifier => Tnn,
-                      Constant_Present    => True,
-                      Object_Definition   => New_Occurrence_Of (R_Type, Loc),
-                      Expression          => Relocate_Node (Exp)),
-                    Suppress => All_Checks);
-
-                  Rewrite (Exp, New_Occurrence_Of (Tnn, Loc));
-
-                  --  Insert_Action (Exp,
-                  --    Make_Object_Renaming_Declaration (Loc,
-                  --      Defining_Identifier => Tnn,
-                  --      Access_Definition =>
-                  --        Make_Access_Definition (Loc,
-                  --          All_Present  => True,
-                  --          Subtype_Mark => New_Occurrence_Of (R_Type, Loc)),
-                  --      Name =>
-                  --        Make_Reference (Loc,
-                  --          Prefix => Relocate_Node (Exp))),
-                  --    Suppress => All_Checks);
-
-                  --  Rewrite (Exp,
-                  --    Make_Explicit_Dereference (Loc,
-                  --      Prefix => New_Occurrence_Of (Tnn, Loc)));
-               end if;
-            end;
-         end if;
+         Remove_Side_Effects (Exp);
 
          --  Generate call to _Postconditions
 
@@ -6731,7 +6644,7 @@ package body Exp_Ch6 is
            Make_Procedure_Call_Statement (Loc,
              Name                   =>
                New_Occurrence_Of (Postconditions_Proc (Scope_Id), Loc),
-             Parameter_Associations => New_List (Duplicate_Subexpr (Exp))));
+             Parameter_Associations => New_List (New_Copy_Tree (Exp))));
       end if;
 
       --  Ada 2005 (AI-251): If this return statement corresponds with an
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 2aa6e97..046b189 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6848,12 +6848,16 @@ package body Exp_Util is
       then
          return False;
 
+      --  Never needs finalization if Disable_Controlled set
+
+      elsif Disable_Controlled (T) then
+         return False;
+
       else
          --  Class-wide types are treated as controlled because derivations
          --  from the root type can introduce controlled components.
 
-         return
-           Is_Class_Wide_Type (T)
+         return Is_Class_Wide_Type (T)
              or else Is_Controlled (T)
              or else Has_Controlled_Component (T)
              or else Has_Some_Controlled_Component (T)
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 6436761..f411e1e 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2226,7 +2226,7 @@ package body Freeze is
 
             --  Propagate flags for component type
 
-            if Is_Controlled (Component_Type (Arr))
+            if Is_Controlled_Active (Component_Type (Arr))
               or else Has_Controlled_Component (Ctyp)
             then
                Set_Has_Controlled_Component (Arr);
@@ -4106,7 +4106,7 @@ package body Freeze is
                    (Has_Controlled_Component (Etype (Comp))
                      or else
                        (Chars (Comp) /= Name_uParent
-                         and then Is_Controlled (Etype (Comp)))
+                         and then Is_Controlled_Active (Etype (Comp)))
                      or else
                        (Is_Protected_Type (Etype (Comp))
                          and then
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index f9ec0ae..29153d7 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1205,8 +1205,7 @@ package body Sem_Ch13 is
 
    procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id) is
       procedure Decorate (Asp : Node_Id; Prag : Node_Id);
-      --  Establish linkages between an aspect and its corresponding
-      --  pragma.
+      --  Establish linkages between an aspect and its corresponding pragma
 
       procedure Insert_After_SPARK_Mode
         (Prag    : Node_Id;
@@ -1235,7 +1234,7 @@ package body Sem_Ch13 is
 
       procedure Decorate (Asp : Node_Id; Prag : Node_Id) is
       begin
-         Set_Aspect_Rep_Item           (Asp,  Prag);
+         Set_Aspect_Rep_Item           (Asp, Prag);
          Set_Corresponding_Aspect      (Prag, Asp);
          Set_From_Aspect_Specification (Prag);
          Set_Parent                    (Prag, Asp);
@@ -3055,7 +3054,7 @@ package body Sem_Ch13 is
                --  Case 5: Special handling for aspects with an optional
                --  boolean argument.
 
-               --  In the general case, the corresponding pragma cannot be
+               --  In the delayed case, the corresponding pragma cannot be
                --  generated yet because the evaluation of the boolean needs
                --  to be delayed till the freeze point.
 
@@ -3145,6 +3144,25 @@ package body Sem_Ch13 is
                      end if;
 
                      goto Continue;
+
+                  --  Disable_Controlled
+
+                  elsif A_Id = Aspect_Disable_Controlled then
+                     if Ekind (E) /= E_Record_Type
+                       or else not Is_Controlled (E)
+                     then
+                        Error_Msg_N
+                          ("aspect % requires controlled record type", Aspect);
+                        goto Continue;
+                     end if;
+
+                     if not Present (Expr)
+                       or else Is_True (Static_Boolean (Expr))
+                     then
+                        Set_Disable_Controlled (E);
+                     end if;
+
+                     goto Continue;
                   end if;
 
                   --  Library unit aspects require special handling in the case
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ecd1639..de8b1c4 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4386,7 +4386,7 @@ package body Sem_Ch3 is
         and then not Is_Constrained (Underlying_Type (T))
         and then not Is_Aliased (Id)
         and then not Is_Class_Wide_Type (T)
-        and then not Is_Controlled (T)
+        and then not Is_Controlled_Active (T)
         and then not Has_Controlled_Component (Base_Type (T))
         and then Expander_Active
       then
@@ -5614,7 +5614,7 @@ package body Sem_Ch3 is
          Set_Packed_Array_Impl_Type (Implicit_Base, Empty);
          Set_Has_Controlled_Component (Implicit_Base,
            Has_Controlled_Component (Element_Type)
-             or else Is_Controlled  (Element_Type));
+             or else Is_Controlled_Active  (Element_Type));
          Set_Finalize_Storage_Only (Implicit_Base,
            Finalize_Storage_Only (Element_Type));
 
@@ -5640,7 +5640,7 @@ package body Sem_Ch3 is
          Set_Has_Controlled_Component (T, Has_Controlled_Component
                                                         (Element_Type)
                                             or else
-                                          Is_Controlled (Element_Type));
+                                          Is_Controlled_Active (Element_Type));
          Set_Finalize_Storage_Only    (T, Finalize_Storage_Only
                                                         (Element_Type));
          Set_Default_SSO              (T);
@@ -7351,16 +7351,18 @@ package body Sem_Ch3 is
             Error_Msg_N ("cannot add discriminants to untagged type", N);
          end if;
 
-         Set_Stored_Constraint (Derived_Type, No_Elist);
-         Set_Is_Constrained    (Derived_Type, Is_Constrained (Parent_Type));
-         Set_Is_Controlled     (Derived_Type, Is_Controlled  (Parent_Type));
+         Set_Stored_Constraint  (Derived_Type, No_Elist);
+         Set_Is_Constrained     (Derived_Type, Is_Constrained (Parent_Type));
+         Set_Is_Controlled      (Derived_Type, Is_Controlled  (Parent_Type));
+         Set_Disable_Controlled (Derived_Type, Disable_Controlled
+                                                              (Parent_Type));
          Set_Has_Controlled_Component
-                               (Derived_Type, Has_Controlled_Component
-                                                             (Parent_Type));
+                                (Derived_Type, Has_Controlled_Component
+                                                              (Parent_Type));
 
          --  Direct controlled types do not inherit Finalize_Storage_Only flag
 
-         if not Is_Controlled  (Parent_Type) then
+         if not Is_Controlled_Active (Parent_Type) then
             Set_Finalize_Storage_Only
               (Base_Type (Derived_Type), Finalize_Storage_Only (Parent_Type));
          end if;
@@ -8974,16 +8976,18 @@ package body Sem_Ch3 is
    begin
       --  Set common attributes
 
-      Set_Scope          (Derived_Type, Current_Scope);
+      Set_Scope              (Derived_Type, Current_Scope);
+
+      Set_Etype              (Derived_Type,                Parent_Base);
+      Set_Ekind              (Derived_Type, Ekind         (Parent_Base));
+      Set_Has_Task           (Derived_Type, Has_Task      (Parent_Base));
+      Set_Has_Protected      (Derived_Type, Has_Protected (Parent_Base));
 
-      Set_Etype          (Derived_Type,                Parent_Base);
-      Set_Ekind          (Derived_Type, Ekind         (Parent_Base));
-      Set_Has_Task       (Derived_Type, Has_Task      (Parent_Base));
-      Set_Has_Protected  (Derived_Type, Has_Protected (Parent_Base));
+      Set_Size_Info          (Derived_Type,                     Parent_Type);
+      Set_RM_Size            (Derived_Type, RM_Size            (Parent_Type));
+      Set_Is_Controlled      (Derived_Type, Is_Controlled      (Parent_Type));
+      Set_Disable_Controlled (Derived_Type, Disable_Controlled (Parent_Type));
 
-      Set_Size_Info      (Derived_Type,                 Parent_Type);
-      Set_RM_Size        (Derived_Type, RM_Size        (Parent_Type));
-      Set_Is_Controlled  (Derived_Type, Is_Controlled  (Parent_Type));
       Set_Is_Tagged_Type (Derived_Type, Is_Tagged_Type (Parent_Type));
       Set_Is_Volatile    (Derived_Type, Is_Volatile    (Parent_Type));
 
@@ -21174,7 +21178,7 @@ package body Sem_Ch3 is
          end;
       end if;
 
-      Final_Storage_Only := not Is_Controlled (T);
+      Final_Storage_Only := not Is_Controlled_Active (T);
 
       --  Ada 2005: Check whether an explicit Limited is present in a derived
       --  type declaration.
@@ -21240,7 +21244,8 @@ package body Sem_Ch3 is
          elsif not Is_Class_Wide_Equivalent_Type (T)
            and then (Has_Controlled_Component (Etype (Component))
                       or else (Chars (Component) /= Name_uParent
-                                and then Is_Controlled (Etype (Component))))
+                                and then Is_Controlled_Active
+                                           (Etype (Component))))
          then
             Set_Has_Controlled_Component (T, True);
             Final_Storage_Only :=
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 9074552..b76e629 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -141,6 +141,7 @@ package Snames is
    Name_Default_Component_Value        : constant Name_Id := N + $;
    Name_Dimension                      : constant Name_Id := N + $;
    Name_Dimension_System               : constant Name_Id := N + $;
+   Name_Disable_Controlled             : constant Name_Id := N + $;
    Name_Dynamic_Predicate              : constant Name_Id := N + $;
    Name_Static_Predicate               : constant Name_Id := N + $;
    Name_Synchronization                : constant Name_Id := N + $;