exp_ch4.adb (Expand_N_Selected_Component): If the component is the discriminant…

exp_ch4.adb (Expand_N_Selected_Component): If the component is the discriminant of a constrained subtype...

	* exp_ch4.adb (Expand_N_Selected_Component): If the component is the
	discriminant of a constrained subtype, analyze the copy of the
	corresponding constraint, because in some cases it may be only
	partially analyzed.
	Removes long-lived ??? comments.

	* exp_ch7.adb (Establish_Transient_Scope): Remove complex code that
	handled controlled or secondary-stack expressions within the
	iteration_scheme of a loop.

	* sem_ch5.adb (Analyze_Iteration_Scheme): Build a block to evaluate
	bounds that may contain functions calls, to prevent memory leaks when
	the bound contains a call to a function that uses the secondary stack.
	(Check_Complex_Bounds): Subsidiary of Analyze_Iteration_Scheme, to
	generate temporaries for loop bounds that might contain function calls
	that require secondary stack and/or finalization actions.

	* sem_ch4.adb (Analyze_Indexed_Component_Form): If the prefix is a
	selected component and the selector is overloadable (not just a
	function) treat as function call, Analyze_Call will disambiguate if
	necessary.
	(Analyze_Selected_Component): Do not generate an actual subtype for the
	selected component if expansion is disabled. The actual subtype is only
	needed for constraint checks.
	(Analyze_Allocator): If restriction No_Streams is set, then do
	not permit objects to be declared of a stream type, or of a
	composite type containing a stream.

	* restrict.ads: Remove the a-stream entry from Unit_Array, since
	No_Streams no longer prohibits with'ing this package.

	* sem_ch3.adb (Build_Derived_Record_Type): If the parent type has
	discriminants, but the parent base has unknown discriminants, there is
	no discriminant constraint to inherit. Such a discrepancy can arise
	when the actual for a formal type with unknown discriminants is a
	similar private type whose full view has discriminants.
	(Analyze_Object_Declaration): If restriction No_Streams is set, then
	do not permit objects to be declared of a stream type, or of a
	composite type containing a stream.

From-SVN: r90906

gcc/ada/exp_ch4.adb

@@ -5900,22 +5900,13 @@ package body Exp_Ch4 is
                      elsif Nkind (Parent (N)) = N_Case_Statement
                        and then Etype (Node (Dcon)) /= Etype (Disc)
                      then
-                        --  RBKD is suspicious of the following code. The
-                        --  call to New_Copy instead of New_Copy_Tree is
-                        --  suspicious, and the call to Analyze instead
-                        --  of Analyze_And_Resolve is also suspicious ???
-
-                        --  Wouldn't it be good enough to do a perfectly
-                        --  normal Analyze_And_Resolve call using the
-                        --  subtype of the discriminant here???
-
                         Rewrite (N,
                           Make_Qualified_Expression (Loc,
                             Subtype_Mark =>
                               New_Occurrence_Of (Etype (Disc), Loc),
                             Expression   =>
-                              New_Copy (Node (Dcon))));
-                        Analyze (N);
+                              New_Copy_Tree (Node (Dcon))));
+                        Analyze_And_Resolve (N, Etype (Disc));
 
                         --  In case that comes out as a static expression,
                         --  reset it (a selected component is never static).
@@ -5924,13 +5915,15 @@ package body Exp_Ch4 is
                         return;
 
                      --  Otherwise we can just copy the constraint, but the
-                     --  result is certainly not static!
-
-                     --  Again the New_Copy here and the failure to even
-                     --  to an analyze call is uneasy ???
+                     --  result is certainly not static! In some cases the
+                     --  discriminant constraint has been analyzed in the
+                     --  context of the original subtype indication, but for
+                     --  itypes the constraint might not have been analyzed
+                     --  yet, and this must be done now.
 
                      else
-                        Rewrite (N, New_Copy (Node (Dcon)));
+                        Rewrite (N, New_Copy_Tree (Node (Dcon)));
+                        Analyze_And_Resolve (N);
                         Set_Is_Static_Expression (N, False);
                         return;
                      end if;

gcc/ada/exp_ch7.adb

@@ -1050,77 +1050,13 @@ package body Exp_Ch7 is
       if No (Wrap_Node) then
          null;
 
-      elsif Nkind (Wrap_Node) = N_Iteration_Scheme then
-
-         --  Create a declaration followed by an assignment, so that
-         --  the assignment can have its own transient scope.
-         --  We generate the equivalent of:
-
-         --  type Ptr is access all expr_type;
-         --  Var : Ptr;
-         --  begin
-         --     Var := Expr'reference;
-         --  end;
-
-         --  This closely resembles what is done in Remove_Side_Effect,
-         --  but it has to be done here, before the analysis of the call
-         --  is completed.
+      --  If the node to wrap is an iteration_scheme, the expression is
+      --  one of the bounds, and the expansion will make an explicit
+      --  declaration for it (see Analyze_Iteration_Scheme, sem_ch5.adb),
+      --  so do not apply any transformations here.
 
-         declare
-            Ptr_Typ : constant Entity_Id :=
-                        Make_Defining_Identifier (Loc,
-                          Chars => New_Internal_Name ('A'));
-            Ptr     : constant Entity_Id :=
-                        Make_Defining_Identifier (Loc,
-                          Chars => New_Internal_Name ('T'));
-
-            Expr_Type    : constant Entity_Id := Etype (N);
-            New_Expr     : constant Node_Id := Relocate_Node (N);
-            Decl         : Node_Id;
-            Ptr_Typ_Decl : Node_Id;
-            Stmt         : Node_Id;
-
-         begin
-            Ptr_Typ_Decl :=
-              Make_Full_Type_Declaration (Loc,
-                Defining_Identifier => Ptr_Typ,
-                Type_Definition =>
-                  Make_Access_To_Object_Definition (Loc,
-                    All_Present => True,
-                    Subtype_Indication =>
-                      New_Reference_To (Expr_Type, Loc)));
-
-            Decl :=
-              Make_Object_Declaration (Loc,
-                 Defining_Identifier => Ptr,
-                 Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc));
-
-            Set_Etype (Ptr, Ptr_Typ);
-            Stmt :=
-               Make_Assignment_Statement (Loc,
-                  Name => New_Occurrence_Of (Ptr, Loc),
-                  Expression => Make_Reference (Loc, New_Expr));
-
-            Set_Analyzed (New_Expr, False);
-
-            Insert_List_Before_And_Analyze
-              (Parent (Wrap_Node),
-                 New_List (
-                   Ptr_Typ_Decl,
-                   Decl,
-                   Make_Block_Statement (Loc,
-                     Handled_Statement_Sequence =>
-                       Make_Handled_Sequence_Of_Statements (Loc,
-                         New_List (Stmt)))));
-
-            Rewrite (N,
-              Make_Explicit_Dereference (Loc,
-                Prefix => New_Reference_To (Ptr, Loc)));
-            Analyze_And_Resolve (N, Expr_Type);
-
-         end;
-
-      --  Transient scope is required
+      elsif Nkind (Wrap_Node) = N_Iteration_Scheme then
+         null;
 
       else
          New_Scope (New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'));

gcc/ada/restrict.ads

@@ -93,7 +93,6 @@ package Restrict is
      (No_IO,                       "text_io "),
      (No_IO,                       "a-witeio"),
      (No_Task_Attributes_Package,  "a-tasatt"),
-     (No_Streams,                  "a-stream"),
      (No_Unchecked_Conversion,     "a-unccon"),
      (No_Unchecked_Conversion,     "unchconv"),
      (No_Unchecked_Deallocation,   "a-uncdea"),

gcc/ada/sem_ch4.adb

@@ -498,6 +498,18 @@ package body Sem_Ch4 is
          Check_Restriction (No_Task_Allocators, N);
       end if;
 
+      --  If the No_Streams restriction is set, check that the type of the
+      --  object is not, and does not contain, any subtype derived from
+      --  Ada.Streams.Root_Stream_Type. Note that we guard the call to
+      --  Has_Stream just for efficiency reasons. There is no point in
+      --  spending time on a Has_Stream check if the restriction is not set.
+
+      if Restrictions.Set (No_Streams) then
+         if Has_Stream (Designated_Type (Acc_Type)) then
+            Check_Restriction (No_Streams, N);
+         end if;
+      end if;
+
       Set_Etype (N, Acc_Type);
 
       if not Is_Library_Level_Entity (Acc_Type) then
@@ -1662,7 +1674,7 @@ package body Sem_Ch4 is
             Process_Function_Call;
 
          elsif Nkind (P) = N_Selected_Component
-           and then Ekind (Entity (Selector_Name (P))) = E_Function
+           and then Is_Overloadable (Entity (Selector_Name (P)))
          then
             Process_Function_Call;
 
@@ -2630,7 +2642,10 @@ package body Sem_Ch4 is
                --  not make an actual subtype, we end up getting a direct
                --  reference to a discriminant which will not do.
 
-               else
+               --  Comment needs revision, "in all other cases" does not
+               --  reasonably describe the situation below with an elsif???
+
+               elsif Expander_Active then
                   Act_Decl :=
                     Build_Actual_Subtype_Of_Component (Etype (Comp), N);
                   Insert_Action (N, Act_Decl);
@@ -2652,6 +2667,9 @@ package body Sem_Ch4 is
                         Set_Etype (N, Subt);
                      end;
                   end if;
+
+               else
+                  Set_Etype (N, Etype (Comp));
                end if;
 
                return;

gcc/ada/sem_ch5.adb

@@ -1105,12 +1105,111 @@ package body Sem_Ch5 is
    ------------------------------
 
    procedure Analyze_Iteration_Scheme (N : Node_Id) is
+
+      procedure Process_Bounds (R : Node_Id);
+      --  If the iteration is given by a range, create temporaries and
+      --  assignment statements block to capture the bounds and perform
+      --  required finalization actions in case a bound includes a function
+      --  call that uses the temporary stack.
+
       procedure Check_Controlled_Array_Attribute (DS : Node_Id);
       --  If the bounds are given by a 'Range reference on a function call
       --  that returns a controlled array, introduce an explicit declaration
       --  to capture the bounds, so that the function result can be finalized
       --  in timely fashion.
 
+      --------------------
+      -- Process_Bounds --
+      --------------------
+
+      procedure Process_Bounds (R : Node_Id) is
+         Loc          : constant Source_Ptr := Sloc (N);
+         Lo           : constant Node_Id := Low_Bound  (R);
+         Hi           : constant Node_Id := High_Bound (R);
+         New_Lo_Bound : Node_Id := Empty;
+         New_Hi_Bound : Node_Id := Empty;
+         Typ          : constant Entity_Id := Etype (R);
+
+         function One_Bound (Bound : Node_Id) return Node_Id;
+         --  Create one declaration followed by one assignment statement
+         --  to capture the value of bound. We create a separate assignment
+         --  in order to force the creation of a block in case the bound
+         --  contains a call that uses the secondary stack.
+
+         ---------------
+         -- One_Bound --
+         ---------------
+
+         function One_Bound (Bound : Node_Id) return Node_Id is
+            Assign : Node_Id;
+            Id     : Entity_Id;
+            Decl   : Node_Id;
+
+         begin
+            --  If the bound is a constant or an object, no need for a
+            --  separate declaration. If the bound is the result of previous
+            --  expansion it is already analyzed and should not be modified.
+
+            if Nkind (Bound) = N_Integer_Literal
+              or else Is_Entity_Name (Bound)
+              or else Analyzed (Bound)
+            then
+               Resolve (Bound, Typ);
+               return Bound;
+            end if;
+
+            Id :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_Internal_Name ('S'));
+
+            Decl :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Id,
+                Object_Definition   => New_Occurrence_Of (Typ, Loc));
+
+            Insert_Before (Parent (N), Decl);
+            Analyze (Decl);
+
+            Assign :=
+              Make_Assignment_Statement (Loc,
+                Name        => New_Occurrence_Of (Id, Loc),
+                Expression  => Relocate_Node (Bound));
+
+            Save_Interps (Bound, Expression (Assign));
+            Insert_Before (Parent (N), Assign);
+            Analyze (Assign);
+
+            Rewrite (Bound, New_Occurrence_Of (Id, Loc));
+
+            if Nkind (Assign) = N_Assignment_Statement then
+               return Expression (Assign);
+            else
+               return Bound;
+            end if;
+         end One_Bound;
+
+      --  Start of processing for Process_Bounds
+
+      begin
+         New_Lo_Bound := One_Bound (Lo);
+         New_Hi_Bound := One_Bound (Hi);
+
+         --  Propagate staticness to loop range itself, in case the
+         --  corresponding subtype is static.
+
+         if New_Lo_Bound /= Lo
+           and then Is_Static_Expression (New_Lo_Bound)
+         then
+            Rewrite  (Low_Bound (R), New_Copy (New_Lo_Bound));
+         end if;
+
+         if New_Hi_Bound /= Hi
+           and then Is_Static_Expression (New_Hi_Bound)
+         then
+            Rewrite (High_Bound (R), New_Copy (New_Hi_Bound));
+         end if;
+      end Process_Bounds;
+
       --------------------------------------
       -- Check_Controlled_Array_Attribute --
       --------------------------------------
@@ -1212,9 +1311,17 @@ package body Sem_Ch5 is
                      end if;
                   end;
 
-                  --  Now analyze the subtype definition
+                  --  Now analyze the subtype definition. If it is
+                  --  a range, create temporaries for bounds.
 
+                  if Nkind (DS) = N_Range
+                    and then Expander_Active
+                  then
+                     Pre_Analyze_And_Resolve (DS);
+                     Process_Bounds (DS);
+                  else
                      Analyze (DS);
+                  end if;
 
                   if DS = Error then
                      return;
@@ -1238,6 +1345,7 @@ package body Sem_Ch5 is
                   end if;
 
                   Check_Controlled_Array_Attribute (DS);
+
                   Make_Index (DS, LP);
 
                   Set_Ekind          (Id, E_Loop_Parameter);