[multiple changes]

2014-08-01  Bob Duff  <duff@adacore.com>

	* gnat_ugn.texi: Minor updates.

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* atree.adb: Minor reformatting.

2014-08-01  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Init_Hidden_Discriminants): If some ancestor is a
	private extension, get stored constraint, if any, from full view.

From-SVN: r213479

4 files changed, 121 insertions, 107 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6b32f98..c4654d1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2014-08-01  Bob Duff  <duff@adacore.com>
+
+	* gnat_ugn.texi: Minor updates.
+
+2014-08-01  Robert Dewar  <dewar@adacore.com>
+
+	* atree.adb: Minor reformatting.
+
+2014-08-01  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_aggr.adb (Init_Hidden_Discriminants): If some ancestor is a
+	private extension, get stored constraint, if any, from full view.
+
 2014-08-01  Robert Dewar  <dewar@adacore.com>
 
 	* opt.ads (No_Elab_Code_All_Pragma): New global variable.
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 1951773..2af7e2e 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1800,18 +1800,17 @@ package body Atree is
       New_Node := New_Copy (Source);
       Fix_Parents (Ref_Node => Source, Fix_Node => New_Node);
 
-      --  We now set the parent of the new node to be the same as the
-      --  parent of the source. Almost always this parent will be
-      --  replaced by a new value when the relocated node is reattached
-      --  to the tree, but by doing it now, we ensure that this node is
-      --  not even temporarily disconnected from the tree. Note that this
-      --  does not happen free, because in the list case, the parent does
-      --  not get set.
+      --  We now set the parent of the new node to be the same as the parent of
+      --  the source. Almost always this parent will be replaced by a new value
+      --  when the relocated node is reattached to the tree, but by doing it
+      --  now, we ensure that this node is not even temporarily disconnected
+      --  from the tree. Note that this does not happen free, because in the
+      --  list case, the parent does not get set.
 
       Set_Parent (New_Node, Parent (Source));
 
-      --  If the node being relocated was a rewriting of some original
-      --  node, then the relocated node has the same original node.
+      --  If the node being relocated was a rewriting of some original node,
+      --  then the relocated node has the same original node.
 
       if Orig_Nodes.Table (Source) /= Source then
          Orig_Nodes.Table (New_Node) := Orig_Nodes.Table (Source);
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 0214a6b..378d66f 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -2132,10 +2132,19 @@ package body Exp_Aggr is
 
             Disc := First_Discriminant (Parent_Type);
 
-            --  We know that one of the stored-constraint lists is present.
+            --  We know that one of the stored-constraint lists is present
 
             if Present (Stored_Constraint (Btype)) then
                Discr_Val := First_Elmt (Stored_Constraint (Btype));
+
+            --  For private extension, stored constraint may be on full view
+
+            elsif Is_Private_Type (Btype)
+              and then Present (Full_View (Btype))
+              and then Present (Stored_Constraint (Full_View (Btype)))
+            then
+               Discr_Val := First_Elmt (Stored_Constraint (Full_View (Btype)));
+
             else
                Discr_Val := First_Elmt (Stored_Constraint (Typ));
             end if;
@@ -2197,10 +2206,10 @@ package body Exp_Aggr is
          Finalization_Done := True;
 
          --  Determine the external finalization list. It is either the
-         --  finalization list of the outer-scope or the one coming from
-         --  an outer aggregate. When the target is not a temporary, the
-         --  proper scope is the scope of the target rather than the
-         --  potentially transient current scope.
+         --  finalization list of the outer-scope or the one coming from an
+         --  outer aggregate. When the target is not a temporary, the proper
+         --  scope is the scope of the target rather than the potentially
+         --  transient current scope.
 
          if Is_Controlled (Typ) and then Ancestor_Is_Subtype_Mark then
             Ref := Convert_To (Init_Typ, New_Copy_Tree (Target));
@@ -2433,6 +2442,7 @@ package body Exp_Aggr is
             --  in the limited case, the ancestor part must be either a
             --  function call (possibly qualified, or wrapped in an unchecked
             --  conversion) or aggregate (definitely qualified).
+
             --  The ancestor part can also be a function call (that may be
             --  transformed into an explicit dereference) or a qualification
             --  of one such.
@@ -3009,10 +3019,10 @@ package body Exp_Aggr is
          Next (Comp);
       end loop;
 
-      --  If the type is tagged, the tag needs to be initialized (unless
-      --  compiling for the Java VM where tags are implicit). It is done
-      --  late in the initialization process because in some cases, we call
-      --  the init proc of an ancestor which will not leave out the right tag
+      --  If the type is tagged, the tag needs to be initialized (unless we
+      --  are in VM-mode where tags are implicit). It is done late in the
+      --  initialization process because in some cases, we call the init
+      --  proc of an ancestor which will not leave out the right tag.
 
       if Ancestor_Is_Expression then
          null;
@@ -3042,7 +3052,7 @@ package body Exp_Aggr is
 
          Append_To (L, Instr);
 
-         --  Ada 2005 (AI-251): If the tagged type has been derived from
+         --  Ada 2005 (AI-251): If the tagged type has been derived from an
          --  abstract interfaces we must also initialize the tags of the
          --  secondary dispatch tables.
 
@@ -3378,16 +3388,16 @@ package body Exp_Aggr is
          or else (Parent_Kind = N_Assignment_Statement
                    and then Inside_Init_Proc)
 
-         --  (Ada 2005) An inherently limited type in a return statement,
-         --  which will be handled in a build-in-place fashion, and may be
-         --  rewritten as an extended return and have its own finalization
-         --  machinery. In the case of a simple return, the aggregate needs
-         --  to be delayed until the scope for the return statement has been
-         --  created, so that any finalization chain will be associated with
-         --  that scope. For extended returns, we delay expansion to avoid the
-         --  creation of an unwanted transient scope that could result in
-         --  premature finalization of the return object (which is built in
-         --  in place within the caller's scope).
+         --  (Ada 2005) An inherently limited type in a return statement, which
+         --  will be handled in a build-in-place fashion, and may be rewritten
+         --  as an extended return and have its own finalization machinery.
+         --  In the case of a simple return, the aggregate needs to be delayed
+         --  until the scope for the return statement has been created, so
+         --  that any finalization chain will be associated with that scope.
+         --  For extended returns, we delay expansion to avoid the creation
+         --  of an unwanted transient scope that could result in premature
+         --  finalization of the return object (which is built in in place
+         --  within the caller's scope).
 
          or else
            (Is_Limited_View (Typ)
@@ -3404,9 +3414,9 @@ package body Exp_Aggr is
       end if;
 
       --  If the aggregate is non-limited, create a temporary. If it is limited
-      --  and the context is an assignment, this is a subaggregate for an
-      --  enclosing aggregate being expanded. It must be built in place, so use
-      --  the target of the current assignment.
+      --  and context is an assignment, this is a subaggregate for an enclosing
+      --  aggregate being expanded. It must be built in place, so use target of
+      --  the current assignment.
 
       if Is_Limited_Type (Typ)
         and then Nkind (Parent (N)) = N_Assignment_Statement
@@ -3491,6 +3501,8 @@ package body Exp_Aggr is
       -- Check_Static_Components --
       -----------------------------
 
+      --  Could use some comments in this body ???
+
       procedure Check_Static_Components is
          Expr : Node_Id;
 
@@ -3777,15 +3789,16 @@ package body Exp_Aggr is
 
                      else
                         Choice_Index := UI_To_Int (Expr_Value (Choice));
+
                         if Choice_Index in Vals'Range then
                            Vals (Choice_Index) :=
                              New_Copy_Tree (Expression (Elmt));
                            goto Continue;
 
-                        else
-                           --  Choice is statically out-of-range, will be
-                           --  rewritten to raise Constraint_Error.
+                        --  Choice is statically out-of-range, will be
+                        --  rewritten to raise Constraint_Error.
 
+                        else
                            return False;
                         end if;
                      end if;
@@ -3798,6 +3811,7 @@ package body Exp_Aggr is
                      not Compile_Time_Known_Value (Hi)
                   then
                      return False;
+
                   else
                      for J in UI_To_Int (Expr_Value (Lo)) ..
                               UI_To_Int (Expr_Value (Hi))
@@ -4175,7 +4189,8 @@ package body Exp_Aggr is
          end if;
 
          Remainder := Value rem 2**System_Storage_Unit;
-         for I in 1 .. Nunits - 1 loop
+
+         for J in 1 .. Nunits - 1 loop
             Value := Value / 2**System_Storage_Unit;
 
             if Value rem 2**System_Storage_Unit /= Remainder then
@@ -4240,7 +4255,7 @@ package body Exp_Aggr is
          Decl :=
            Make_Full_Type_Declaration (Loc,
                Defining_Identifier => Agg_Type,
-               Type_Definition =>
+               Type_Definition     =>
                  Make_Constrained_Array_Definition (Loc,
                    Discrete_Subtype_Definitions => Indexes,
                    Component_Definition         =>
@@ -4274,7 +4289,7 @@ package body Exp_Aggr is
          Get_Index_Bounds (Index_Bounds, Ind_Lo, Ind_Hi);
 
          --  Generate the following test:
-         --
+
          --    [constraint_error when
          --      Aggr_Lo <= Aggr_Hi and then
          --        (Aggr_Lo < Ind_Lo or else Aggr_Hi > Ind_Hi)]
@@ -4364,8 +4379,7 @@ package body Exp_Aggr is
          if Index_Checks_Suppressed (Ind_Typ) then
             Cond := Empty;
 
-         elsif Dim = 1
-           or else (Aggr_Lo = Sub_Lo and then Aggr_Hi = Sub_Hi)
+         elsif Dim = 1 or else (Aggr_Lo = Sub_Lo and then Aggr_Hi = Sub_Hi)
          then
             Cond := Empty;
 
@@ -4588,12 +4602,12 @@ package body Exp_Aggr is
          --  Start of processing for Safe_Component
 
          begin
-            --  If the component appears in an association that may
-            --  correspond to more than one element, it is not analyzed
-            --  before the expansion into assignments, to avoid side effects.
-            --  We analyze, but do not resolve the copy, to obtain sufficient
-            --  entity information for the checks that follow. If component is
-            --  overloaded we assume an unsafe function call.
+            --  If the component appears in an association that may correspond
+            --  to more than one element, it is not analyzed before expansion
+            --  into assignments, to avoid side effects. We analyze, but do not
+            --  resolve the copy, to obtain sufficient entity information for
+            --  the checks that follow. If component is overloaded we assume
+            --  an unsafe function call.
 
             if not Analyzed (Comp) then
                if Is_Overloaded (Expr) then
@@ -4632,9 +4646,9 @@ package body Exp_Aggr is
             --  assignment in place unless the bounds of the aggregate are
             --  statically equal to those of the target.
 
-            --  If the aggregate is given by an others choice, the bounds
-            --  are derived from the left-hand side, and the assignment is
-            --  safe if the expression is.
+            --  If the aggregate is given by an others choice, the bounds are
+            --  derived from the left-hand side, and the assignment is safe if
+            --  the expression is.
 
             if Is_Others_Aggregate (N) then
                return
@@ -4648,8 +4662,8 @@ package body Exp_Aggr is
                Obj_In  := First_Index (Etype (Name (Parent (N))));
 
             else
-               --  Context is an allocator. Check bounds of aggregate
-               --  against given type in qualified expression.
+               --  Context is an allocator. Check bounds of aggregate against
+               --  given type in qualified expression.
 
                pragma Assert (Nkind (Parent (Parent (N))) = N_Allocator);
                Obj_In :=
@@ -4733,6 +4747,8 @@ package body Exp_Aggr is
                --  Count the number of discrete choices. Start with -1 because
                --  the others choice does not count.
 
+               --  Is there some reason we do not use List_Length here ???
+
                Nb_Choices := -1;
                Assoc := First (Component_Associations (Sub_Aggr));
                while Present (Assoc) loop
@@ -4834,7 +4850,7 @@ package body Exp_Aggr is
                         Expressions    =>
                           New_List
                             (Duplicate_Subexpr_Move_Checks (Aggr_Lo))),
-                    Right_Opnd => Make_Integer_Literal (Loc, Nb_Elements - 1)),
+                Right_Opnd => Make_Integer_Literal (Loc, Nb_Elements - 1)),
 
                 Right_Opnd =>
                   Make_Attribute_Reference (Loc,
@@ -4854,17 +4870,13 @@ package body Exp_Aggr is
               Make_Or_Else (Loc,
                 Left_Opnd =>
                   Make_Op_Lt (Loc,
-                    Left_Opnd  =>
-                      Duplicate_Subexpr_Move_Checks (Choices_Lo),
-                    Right_Opnd =>
-                      Duplicate_Subexpr_Move_Checks (Aggr_Lo)),
+                    Left_Opnd  => Duplicate_Subexpr_Move_Checks (Choices_Lo),
+                    Right_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo)),
 
                 Right_Opnd =>
                   Make_Op_Gt (Loc,
-                    Left_Opnd  =>
-                      Duplicate_Subexpr (Choices_Hi),
-                    Right_Opnd =>
-                      Duplicate_Subexpr (Aggr_Hi)));
+                    Left_Opnd  => Duplicate_Subexpr (Choices_Hi),
+                    Right_Opnd => Duplicate_Subexpr (Aggr_Hi)));
          end if;
 
          if Present (Cond) then
@@ -5027,12 +5039,12 @@ package body Exp_Aggr is
          Compute_Others_Present (N, 1);
 
          for J in 1 .. Aggr_Dimension loop
-            --  There is no need to emit a check if an others choice is
-            --  present for this array aggregate dimension since in this
-            --  case one of N's sub-aggregates has taken its bounds from the
-            --  context and these bounds must have been checked already. In
-            --  addition all sub-aggregates corresponding to the same
-            --  dimension must all have the same bounds (checked in (c) below).
+            --  There is no need to emit a check if an others choice is present
+            --  for this array aggregate dimension since in this case one of
+            --  N's sub-aggregates has taken its bounds from the context and
+            --  these bounds must have been checked already. In addition all
+            --  sub-aggregates corresponding to the same dimension must all
+            --  have the same bounds (checked in (c) below).
 
             if not Range_Checks_Suppressed (Etype (Index_Constraint))
               and then not Others_Present (J)
@@ -5261,8 +5273,8 @@ package body Exp_Aggr is
           (Nkind (Parent (N)) = N_Assignment_Statement
             and then In_Place_Assign_OK)
 
-          or else
-            (Nkind (Parent (Parent (N))) = N_Allocator
+            or else
+             (Nkind (Parent (Parent (N))) = N_Allocator
               and then In_Place_Assign_OK);
       end if;
 
@@ -5365,10 +5377,9 @@ package body Exp_Aggr is
          Maybe_In_Place_OK := False;
          Tmp := Make_Temporary (Loc, 'A', N);
          Tmp_Decl :=
-           Make_Object_Declaration
-             (Loc,
-              Defining_Identifier => Tmp,
-              Object_Definition   => New_Occurrence_Of (Typ, Loc));
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Tmp,
+             Object_Definition   => New_Occurrence_Of (Typ, Loc));
          Set_No_Initialization (Tmp_Decl, True);
 
          --  If we are within a loop, the temporary will be pushed on the
@@ -5398,7 +5409,6 @@ package body Exp_Aggr is
             Target := New_Occurrence_Of (Tmp, Loc);
 
          else
-
             if Has_Default_Init_Comps (N) then
 
                --  Ada 2005 (AI-287): This case has not been analyzed???
@@ -5606,6 +5616,7 @@ package body Exp_Aggr is
 
          Expand_Array_Aggregate (N);
       end if;
+
    exception
       when RE_Not_Available =>
          return;
@@ -5887,11 +5898,11 @@ package body Exp_Aggr is
    --  Start of processing for Expand_Record_Aggregate
 
    begin
-      --  If the aggregate is to be assigned to an atomic variable, we
-      --  have to prevent a piecemeal assignment even if the aggregate
-      --  is to be expanded. We create a temporary for the aggregate, and
-      --  assign the temporary instead, so that the back end can generate
-      --  an atomic move for it.
+      --  If the aggregate is to be assigned to an atomic variable, we have
+      --  to prevent a piecemeal assignment even if the aggregate is to be
+      --  expanded. We create a temporary for the aggregate, and assign the
+      --  temporary instead, so that the back end can generate an atomic move
+      --  for it.
 
       if Is_Atomic (Typ)
         and then Comes_From_Source (Parent (N))
@@ -6054,9 +6065,9 @@ package body Exp_Aggr is
                            New_List (New_Occurrence_Of (Discriminant, Loc)),
 
                          Expression =>
-                           New_Copy_Tree (
-                             Get_Discriminant_Value (
-                                 Discriminant,
+                           New_Copy_Tree
+                             (Get_Discriminant_Value
+                                (Discriminant,
                                  Typ,
                                  Discriminant_Constraint (Typ))));
 
@@ -6081,8 +6092,7 @@ package body Exp_Aggr is
                   Comp := First_Comp;
                   Next (First_Comp);
 
-                  if Ekind (Entity
-                             (First (Choices (Comp)))) = E_Discriminant
+                  if Ekind (Entity (First (Choices (Comp)))) = E_Discriminant
                   then
                      Remove (Comp);
                      Num_Disc := Num_Disc + 1;
@@ -6120,8 +6130,8 @@ package body Exp_Aggr is
                        New_Copy_Tree
                          (Get_Discriminant_Value
                             (Discriminant,
-                              Typ,
-                              Discriminant_Constraint (Typ)));
+                             Typ,
+                             Discriminant_Constraint (Typ)));
                      Append (New_Comp, Constraints);
                      Next_Stored_Discriminant (Discriminant);
                   end loop;
@@ -6129,11 +6139,11 @@ package body Exp_Aggr is
                   Decl :=
                     Make_Subtype_Declaration (Loc,
                       Defining_Identifier => Make_Temporary (Loc, 'T'),
-                      Subtype_Indication =>
+                      Subtype_Indication  =>
                         Make_Subtype_Indication (Loc,
                           Subtype_Mark =>
                             New_Occurrence_Of (Etype (Base_Type (Typ)), Loc),
-                          Constraint =>
+                          Constraint   =>
                             Make_Index_Or_Discriminant_Constraint
                               (Loc, Constraints)));
 
@@ -6175,18 +6185,16 @@ package body Exp_Aggr is
 
                   --  Skip all expander-generated components
 
-                  if
-                    not Comes_From_Source (Original_Record_Component (Comp))
+                  if not Comes_From_Source (Original_Record_Component (Comp))
                   then
                      null;
 
                   else
                      New_Comp :=
                        Make_Selected_Component (Loc,
-                         Prefix =>
+                         Prefix        =>
                            Unchecked_Convert_To (Typ,
                              Duplicate_Subexpr (Parent_Expr, True)),
-
                          Selector_Name => New_Occurrence_Of (Comp, Loc));
 
                      Append_To (Comps,
@@ -6311,6 +6319,7 @@ package body Exp_Aggr is
       Comps : constant List_Id := Component_Associations (N);
       C     : Node_Id;
       Expr  : Node_Id;
+
    begin
       pragma Assert (Nkind_In (N, N_Aggregate, N_Extension_Aggregate));
 
@@ -6471,7 +6480,6 @@ package body Exp_Aggr is
    is
    begin
       Set_Assignment_OK (Name);
-
       return Make_Assignment_Statement (Sloc, Name, Expression);
    end Make_OK_Assignment_Statement;
 
@@ -6977,14 +6985,12 @@ package body Exp_Aggr is
             Incr := +Comp_Size;
          end if;
 
-         Shift := Init_Shift;
-         One_Dim := First (Expressions (N));
-
          --  Iterate over each subaggregate
 
+         Shift := Init_Shift;
+         One_Dim := First (Expressions (N));
          while Present (One_Dim) loop
             One_Comp := First (Expressions (One_Dim));
-
             while Present (One_Comp) loop
                if Packed_Num = Byte_Size / Comp_Size then
 
@@ -7026,8 +7032,7 @@ package body Exp_Aggr is
              Unchecked_Convert_To (Typ,
                Make_Qualified_Expression (Loc,
                  Subtype_Mark => New_Occurrence_Of (Packed_Array, Loc),
-                 Expression   =>
-                   Make_Aggregate (Loc,  Expressions => Comps))));
+                 Expression   => Make_Aggregate (Loc, Expressions => Comps))));
          Analyze_And_Resolve (N);
          return True;
       end;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index fb84452..5293eab 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -14140,10 +14140,9 @@ tool argument.
 Incremental processing on a per-file basis. Source files are only
 processed if they have been modified, or if files they depend on have
 been modified. This is similar to the way gnatmake/gprbuild only
-compiles files that need to be recompiled. Note that in this mode
-@command{gnatpp} is acting in place of the compiler, so if a project
-file is used, the switches set for the compiler should not be set
-to switches recognized by @command{gcc}.
+compiles files that need to be recompiled. A project file is required
+in this mode, and the gnat driver (as in @command{gnat pretty}) is not
+supported.
 
 @item --pp-off=@var{xxx}
 @cindex @option{--pp-off} @command{gnatpp}
@@ -14577,10 +14576,8 @@ options:
 --incremental -- incremental processing on a per-file basis. Source files are
       only processed if they have been modified, or if files they depend
       on have been modified. This is similar to the way gnatmake/gprbuild
-      only compiles files that need to be recompiled. Note that in this mode
-      @command{gnat2xml} is acting in place of the compiler, so if a project
-      file is used, the switches set for the compiler should not be set
-      to switches recognized by @command{gcc}.
+      only compiles files that need to be recompiled. A project file
+      is required in this mode.
 
 -j@var{n} -- In @option{--incremental} mode, use @var{n} @command{gnat2xml}
       processes to perform XML generation in parallel. If @var{n} is 0, then