[multiple changes]

2017-01-19  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.adb (Expand_Call): Remove side effects on
	actuals that are allocators with qualified expression since the
	initialization of the object is performed by means of individual
	statements (and hence it must be done before the call).

2017-01-19  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Declarations): Minor reformatting.
	(Build_Derived_Enumeration_Type): If the derived type inherits a
	dynamic predicate from its parent, the bounds of the type must
	freeze because an explicit constraint is constructed for the
	type and the corresponding range is elaborated now.

2017-01-19  Arnaud Charlet  <charlet@adacore.com>

	* sem_attr.ads: minor fix of inconsistent casing in comment
	* lib-writ.ads: minor align comments in columns
	* sem_ch3.adb: Minor reformatting.
	* spark_xrefs.ads: minor fix typo in SPARK-related comment
	* table.ads: minor style fix in comment
	* lib-xref-spark_specific.adb
	(Add_SPARK_Xrefs): simplify processing of SPARK cross-references.
	* sem_ch12.adb: minor whitespace fix
	* freeze.adb: Add comment.
	* sem_util.adb (Unique_Name): for instances of
	generic subprograms ignore the name of the wrapper package.

2017-01-19  Javier Miranda  <miranda@adacore.com>

	* exp_aggr.adb (Resolve_Record_Aggregate):
	Factorize code needed for aggregates of limited and unlimited
	types in a new routine.
	(Pass_Aggregate_To_Back_End): New subprogram.

2017-01-19  Yannick Moy  <moy@adacore.com>

	* sinfo.adb (Pragma_Name): Only access up to Last_Pair of Pragma_Map.

From-SVN: r244622

gcc/ada/ChangeLog

@@ -1,3 +1,43 @@
+2017-01-19  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch6.adb (Expand_Call): Remove side effects on
+	actuals that are allocators with qualified expression since the
+	initialization of the object is performed by means of individual
+	statements (and hence it must be done before the call).
+
+2017-01-19  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Analyze_Declarations): Minor reformatting.
+	(Build_Derived_Enumeration_Type): If the derived type inherits a
+	dynamic predicate from its parent, the bounds of the type must
+	freeze because an explicit constraint is constructed for the
+	type and the corresponding range is elaborated now.
+
+2017-01-19  Arnaud Charlet  <charlet@adacore.com>
+
+	* sem_attr.ads: minor fix of inconsistent casing in comment
+	* lib-writ.ads: minor align comments in columns
+	* sem_ch3.adb: Minor reformatting.
+	* spark_xrefs.ads: minor fix typo in SPARK-related comment
+	* table.ads: minor style fix in comment
+	* lib-xref-spark_specific.adb
+	(Add_SPARK_Xrefs): simplify processing of SPARK cross-references.
+	* sem_ch12.adb: minor whitespace fix
+	* freeze.adb: Add comment.
+	* sem_util.adb (Unique_Name): for instances of
+	generic subprograms ignore the name of the wrapper package.
+
+2017-01-19  Javier Miranda  <miranda@adacore.com>
+
+	* exp_aggr.adb (Resolve_Record_Aggregate):
+	Factorize code needed for aggregates of limited and unlimited
+	types in a new routine.
+	(Pass_Aggregate_To_Back_End): New subprogram.
+
+2017-01-19  Yannick Moy  <moy@adacore.com>
+
+	* sinfo.adb (Pragma_Name): Only access up to Last_Pair of Pragma_Map.
+
 2017-01-19  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch4.ads, sem_ch4.adb (Try_Object_Operation): Make subprogram

gcc/ada/exp_aggr.adb

@@ -6545,6 +6545,9 @@ package body Exp_Aggr is
       --  because it will not be set when type and its parent are in the
       --  same scope, and the parent component needs expansion.
 
+      procedure Pass_Aggregate_To_Back_End;
+      --  Build a proper aggregate to be handled by the back-end
+
       function Top_Level_Aggregate (N : Node_Id) return Node_Id;
       --  For nested aggregates return the ultimate enclosing aggregate; for
       --  non-nested aggregates return N.
@@ -6723,155 +6726,16 @@ package body Exp_Aggr is
          end loop;
       end Has_Visible_Private_Ancestor;
 
-      -------------------------
+      --------------------------------
-      -- Top_Level_Aggregate --
+      -- Pass_Aggregate_To_Back_End --
-      -------------------------
+      --------------------------------
 
-      function Top_Level_Aggregate (N : Node_Id) return Node_Id is
+      procedure Pass_Aggregate_To_Back_End is
-         Aggr : Node_Id;
+         Comp      : Entity_Id;
+         New_Comp  : Node_Id;
+         Tag_Value : Node_Id;
 
       begin
-         Aggr := N;
-         while Present (Parent (Aggr))
-           and then Nkind_In (Parent (Aggr), N_Component_Association,
-                                             N_Aggregate)
-         loop
-            Aggr := Parent (Aggr);
-         end loop;
-
-         return Aggr;
-      end Top_Level_Aggregate;
-
-      --  Local variables
-
-      Top_Level_Aggr : constant Node_Id := Top_Level_Aggregate (N);
-      Tag_Value      : Node_Id;
-      Comp           : Entity_Id;
-      New_Comp       : Node_Id;
-
-   --  Start of processing for Expand_Record_Aggregate
-
-   begin
-      --  If the aggregate is to be assigned to an atomic/VFA 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_VFA_Aggregate (N) then
-         return;
-
-      --  No special management required for aggregates used to initialize
-      --  statically allocated dispatch tables
-
-      elsif Is_Static_Dispatch_Table_Aggregate (N) then
-         return;
-      end if;
-
-      --  Ada 2005 (AI-318-2): We need to convert to assignments if components
-      --  are build-in-place function calls. The assignments will each turn
-      --  into a build-in-place function call. If components are all static,
-      --  we can pass the aggregate to the backend regardless of limitedness.
-
-      --  Extension aggregates, aggregates in extended return statements, and
-      --  aggregates for C++ imported types must be expanded.
-
-      if Ada_Version >= Ada_2005 and then Is_Limited_View (Typ) then
-         if not Nkind_In (Parent (N), N_Object_Declaration,
-                                      N_Component_Association)
-         then
-            Convert_To_Assignments (N, Typ);
-
-         elsif Nkind (N) = N_Extension_Aggregate
-           or else Convention (Typ) = Convention_CPP
-         then
-            Convert_To_Assignments (N, Typ);
-
-         elsif not Size_Known_At_Compile_Time (Typ)
-           or else Component_Not_OK_For_Backend
-           or else not Static_Components
-         then
-            Convert_To_Assignments (N, Typ);
-
-         else
-            Set_Compile_Time_Known_Aggregate (N);
-            Set_Expansion_Delayed (N, False);
-         end if;
-
-      --  Gigi doesn't properly handle temporaries of variable size so we
-      --  generate it in the front-end
-
-      elsif not Size_Known_At_Compile_Time (Typ)
-        and then Tagged_Type_Expansion
-      then
-         Convert_To_Assignments (N, Typ);
-
-      --  An aggregate used to initialize a controlled object must be turned
-      --  into component assignments as the components themselves may require
-      --  finalization actions such as adjustment.
-
-      elsif Needs_Finalization (Typ) then
-         Convert_To_Assignments (N, Typ);
-
-      --  Ada 2005 (AI-287): In case of default initialized components we
-      --  convert the aggregate into assignments.
-
-      elsif Has_Default_Init_Comps (N) then
-         Convert_To_Assignments (N, Typ);
-
-      --  Check components
-
-      elsif Component_Not_OK_For_Backend then
-         Convert_To_Assignments (N, Typ);
-
-      --  If an ancestor is private, some components are not inherited and we
-      --  cannot expand into a record aggregate.
-
-      elsif Has_Visible_Private_Ancestor (Typ) then
-         Convert_To_Assignments (N, Typ);
-
-      --  ??? The following was done to compile fxacc00.ads in the ACVCs. Gigi
-      --  is not able to handle the aggregate for Late_Request.
-
-      elsif Is_Tagged_Type (Typ) and then Has_Discriminants (Typ) then
-         Convert_To_Assignments (N, Typ);
-
-      --  If the tagged types covers interface types we need to initialize all
-      --  hidden components containing pointers to secondary dispatch tables.
-
-      elsif Is_Tagged_Type (Typ) and then Has_Interfaces (Typ) then
-         Convert_To_Assignments (N, Typ);
-
-      --  If some components are mutable, the size of the aggregate component
-      --  may be distinct from the default size of the type component, so
-      --  we need to expand to insure that the back-end copies the proper
-      --  size of the data. However, if the aggregate is the initial value of
-      --  a constant, the target is immutable and might be built statically
-      --  if components are appropriate.
-
-      elsif Has_Mutable_Components (Typ)
-        and then
-          (Nkind (Parent (Top_Level_Aggr)) /= N_Object_Declaration
-            or else not Constant_Present (Parent (Top_Level_Aggr))
-            or else not Static_Components)
-      then
-         Convert_To_Assignments (N, Typ);
-
-      --  If the type involved has bit aligned components, then we are not sure
-      --  that the back end can handle this case correctly.
-
-      elsif Type_May_Have_Bit_Aligned_Components (Typ) then
-         Convert_To_Assignments (N, Typ);
-
-      --  When generating C, only generate an aggregate when declaring objects
-      --  since C does not support aggregates in e.g. assignment statements.
-
-      elsif Modify_Tree_For_C and then not In_Object_Declaration (N) then
-         Convert_To_Assignments (N, Typ);
-
-      --  In all other cases, build a proper aggregate to be handled by gigi
-
-      else
          if Nkind (N) = N_Aggregate then
 
             --  If the aggregate is static and can be handled by the back-end,
@@ -7164,8 +7028,158 @@ package body Exp_Aggr is
                end;
             end if;
          end if;
+      end Pass_Aggregate_To_Back_End;
+
+      -------------------------
+      -- Top_Level_Aggregate --
+      -------------------------
+
+      function Top_Level_Aggregate (N : Node_Id) return Node_Id is
+         Aggr : Node_Id;
+
+      begin
+         Aggr := N;
+         while Present (Parent (Aggr))
+           and then Nkind_In (Parent (Aggr), N_Component_Association,
+                                             N_Aggregate)
+         loop
+            Aggr := Parent (Aggr);
+         end loop;
+
+         return Aggr;
+      end Top_Level_Aggregate;
+
+      --  Local variables
+
+      Top_Level_Aggr : constant Node_Id := Top_Level_Aggregate (N);
+
+   --  Start of processing for Expand_Record_Aggregate
+
+   begin
+      --  If the aggregate is to be assigned to an atomic/VFA 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_VFA_Aggregate (N) then
+         return;
+
+      --  No special management required for aggregates used to initialize
+      --  statically allocated dispatch tables
+
+      elsif Is_Static_Dispatch_Table_Aggregate (N) then
+         return;
       end if;
 
+      --  Ada 2005 (AI-318-2): We need to convert to assignments if components
+      --  are build-in-place function calls. The assignments will each turn
+      --  into a build-in-place function call. If components are all static,
+      --  we can pass the aggregate to the backend regardless of limitedness.
+
+      --  Extension aggregates, aggregates in extended return statements, and
+      --  aggregates for C++ imported types must be expanded.
+
+      if Ada_Version >= Ada_2005 and then Is_Limited_View (Typ) then
+         if not Nkind_In (Parent (N), N_Object_Declaration,
+                                      N_Component_Association)
+         then
+            Convert_To_Assignments (N, Typ);
+
+         elsif Nkind (N) = N_Extension_Aggregate
+           or else Convention (Typ) = Convention_CPP
+         then
+            Convert_To_Assignments (N, Typ);
+
+         elsif not Size_Known_At_Compile_Time (Typ)
+           or else Component_Not_OK_For_Backend
+           or else not Static_Components
+         then
+            Convert_To_Assignments (N, Typ);
+
+         --  In all other cases, build a proper aggregate to be handled by
+         --  the back-end
+
+         else
+            Pass_Aggregate_To_Back_End;
+         end if;
+
+      --  Gigi doesn't properly handle temporaries of variable size so we
+      --  generate it in the front-end
+
+      elsif not Size_Known_At_Compile_Time (Typ)
+        and then Tagged_Type_Expansion
+      then
+         Convert_To_Assignments (N, Typ);
+
+      --  An aggregate used to initialize a controlled object must be turned
+      --  into component assignments as the components themselves may require
+      --  finalization actions such as adjustment.
+
+      elsif Needs_Finalization (Typ) then
+         Convert_To_Assignments (N, Typ);
+
+      --  Ada 2005 (AI-287): In case of default initialized components we
+      --  convert the aggregate into assignments.
+
+      elsif Has_Default_Init_Comps (N) then
+         Convert_To_Assignments (N, Typ);
+
+      --  Check components
+
+      elsif Component_Not_OK_For_Backend then
+         Convert_To_Assignments (N, Typ);
+
+      --  If an ancestor is private, some components are not inherited and we
+      --  cannot expand into a record aggregate.
+
+      elsif Has_Visible_Private_Ancestor (Typ) then
+         Convert_To_Assignments (N, Typ);
+
+      --  ??? The following was done to compile fxacc00.ads in the ACVCs. Gigi
+      --  is not able to handle the aggregate for Late_Request.
+
+      elsif Is_Tagged_Type (Typ) and then Has_Discriminants (Typ) then
+         Convert_To_Assignments (N, Typ);
+
+      --  If the tagged types covers interface types we need to initialize all
+      --  hidden components containing pointers to secondary dispatch tables.
+
+      elsif Is_Tagged_Type (Typ) and then Has_Interfaces (Typ) then
+         Convert_To_Assignments (N, Typ);
+
+      --  If some components are mutable, the size of the aggregate component
+      --  may be distinct from the default size of the type component, so
+      --  we need to expand to insure that the back-end copies the proper
+      --  size of the data. However, if the aggregate is the initial value of
+      --  a constant, the target is immutable and might be built statically
+      --  if components are appropriate.
+
+      elsif Has_Mutable_Components (Typ)
+        and then
+          (Nkind (Parent (Top_Level_Aggr)) /= N_Object_Declaration
+            or else not Constant_Present (Parent (Top_Level_Aggr))
+            or else not Static_Components)
+      then
+         Convert_To_Assignments (N, Typ);
+
+      --  If the type involved has bit aligned components, then we are not sure
+      --  that the back end can handle this case correctly.
+
+      elsif Type_May_Have_Bit_Aligned_Components (Typ) then
+         Convert_To_Assignments (N, Typ);
+
+      --  When generating C, only generate an aggregate when declaring objects
+      --  since C does not support aggregates in e.g. assignment statements.
+
+      elsif Modify_Tree_For_C and then not In_Object_Declaration (N) then
+         Convert_To_Assignments (N, Typ);
+
+      --  In all other cases, build a proper aggregate to be handled by gigi
+
+      else
+         Pass_Aggregate_To_Back_End;
+      end if;
    end Expand_Record_Aggregate;
 
    ----------------------------

gcc/ada/exp_ch6.adb

@@ -3315,6 +3315,17 @@ package body Exp_Ch6 is
             Add_View_Conversion_Invariants (Formal, Actual);
          end if;
 
+         --  Generating C the initialization of an allocator is performed by
+         --  means of individual statements, and hence it must be done before
+         --  the call.
+
+         if Modify_Tree_For_C
+           and then Nkind (Actual) = N_Allocator
+           and then Nkind (Expression (Actual)) = N_Qualified_Expression
+         then
+            Remove_Side_Effects (Actual);
+         end if;
+
          --  This label is required when skipping extra actual generation for
          --  Unchecked_Union parameters.
 

gcc/ada/freeze.adb

@@ -5305,6 +5305,9 @@ package body Freeze is
          --  trigger the analysis of aspect expressions, so in this case we
          --  want to continue the freezing process.
 
+         --  Is_Generic_Unit (Scope (E)) is dubious here, do we want instead
+         --  In_Generic_Scope (E)???
+
          if Present (Scope (E))
            and then Is_Generic_Unit (Scope (E))
            and then

gcc/ada/lib-writ.ads

@@ -192,8 +192,8 @@ package Lib.Writ is
    --              the units in this file, where x is the first character
    --              (upper case) of the policy name (e.g. 'C' for Concurrent).
 
-   --         FX  Units in this file use front-end exceptions, with explicit
+   --         FX   Units in this file use front-end exceptions, with explicit
-   --             handlers to trigger AT-END actions on exception paths.
+   --              handlers to trigger AT-END actions on exception paths.
 
    --         GP   Set if this compilation was done in GNATprove mode, either
    --              from direct use of GNATprove, or from use of -gnatdF.
@@ -240,12 +240,12 @@ package Lib.Writ is
    --              (upper case) of the corresponding policy name (e.g. 'F'
    --              for FIFO_Within_Priorities).
 
-   --         UA  Unreserve_All_Interrupts pragma was processed in one or
+   --         UA   Unreserve_All_Interrupts pragma was processed in one or
-   --             more units in this file
+   --              more units in this file
 
-   --         ZX  Units in this file use zero-cost exceptions and have
+   --         ZX   Units in this file use zero-cost exceptions and have
-   --             generated exception tables. If ZX is not present, the
+   --              generated exception tables. If ZX is not present, the
-   --             longjmp/setjmp exception scheme is in use.
+   --              longjmp/setjmp exception scheme is in use.
 
    --      Note that language defined units never output policy (Lx, Tx, Qx)
    --      parameters. Language defined units must correctly handle all
@@ -570,22 +570,22 @@ package Lib.Writ is
    --             code is required. Set if N_Compilation_Unit node has flag
    --             Has_No_Elaboration_Code set.
 
-   --         OL   The units in this file are compiled with a local pragma
+   --         OL  The units in this file are compiled with a local pragma
-   --              Optimize_Alignment, so no consistency requirement applies
+   --             Optimize_Alignment, so no consistency requirement applies
-   --              to these units. All internal units have this status since
+   --             to these units. All internal units have this status since
-   --              they have an automatic default of Optimize_Alignment (Off).
+   --             they have an automatic default of Optimize_Alignment (Off).
    --
-   --         OO   Optimize_Alignment (Off) is the default setting for all
+   --         OO  Optimize_Alignment (Off) is the default setting for all
-   --              units in this file. All files in the partition that specify
+   --             units in this file. All files in the partition that specify
-   --              a default must specify the same default.
+   --             a default must specify the same default.
 
-   --         OS   Optimize_Alignment (Space) is the default setting for all
+   --         OS  Optimize_Alignment (Space) is the default setting for all
-   --              units in this file. All files in the partition that specify
+   --             units in this file. All files in the partition that specify
-   --              a default must specify the same default.
+   --             a default must specify the same default.
 
-   --         OT   Optimize_Alignment (Time) is the default setting for all
+   --         OT  Optimize_Alignment (Time) is the default setting for all
-   --              units in this file. All files in the partition that specify
+   --             units in this file. All files in the partition that specify
-   --              a default must specify the same default.
+   --             a default must specify the same default.
 
    --         PF  The unit has a library-level (package) finalizer
 

gcc/ada/lib-xref-spark_specific.adb

@@ -381,7 +381,7 @@ package body SPARK_Specific is
       Rnums : array (0 .. Nrefs + Nrefs_Add) of Nat;
       --  This array contains numbers of references in the Xrefs table. This
       --  list is sorted in output order. The extra 0'th entry is convenient
-      --  for the call to sort. When we sort the table, we move the entries in
+      --  for the call to sort. When we sort the table, we move the indices in
       --  Rnums around, but we do not move the original table entries.
 
       ---------------------
@@ -683,7 +683,7 @@ package body SPARK_Specific is
       Col        : Nat;
       From_Index : Xref_Index;
       Line       : Nat;
-      Loc        : Source_Ptr;
+      Prev_Loc   : Source_Ptr;
       Prev_Typ   : Character;
       Ref_Count  : Nat;
       Ref_Id     : Entity_Id;
@@ -701,17 +701,9 @@ package body SPARK_Specific is
          end;
       end loop;
 
-      --  Set up the pointer vector for the sort
-
-      for Index in 1 .. Nrefs loop
-         Rnums (Index) := Index;
-      end loop;
-
       for Index in Drefs.First .. Drefs.Last loop
          Xrefs.Append (Drefs.Table (Index));
-
+         Nrefs := Nrefs + 1;
-         Nrefs         := Nrefs + 1;
-         Rnums (Nrefs) := Xrefs.Last;
       end loop;
 
       --  Capture the definition Sloc values. As in the case of normal cross
@@ -730,7 +722,7 @@ package body SPARK_Specific is
 
       for Index in 1 .. Ref_Count loop
          declare
-            Ref : Xref_Key renames Xrefs.Table (Rnums (Index)).Key;
+            Ref : Xref_Key renames Xrefs.Table (Index).Key;
 
          begin
             if SPARK_Entities (Ekind (Ref.Ent))
@@ -745,7 +737,7 @@ package body SPARK_Specific is
               and then Get_Scope_Num (Ref.Ref_Scope) /= No_Scope
             then
                Nrefs         := Nrefs + 1;
-               Rnums (Nrefs) := Rnums (Index);
+               Rnums (Nrefs) := Index;
             end if;
          end;
       end loop;
@@ -778,7 +770,7 @@ package body SPARK_Specific is
 
       Ref_Count := Nrefs;
       Nrefs     := 0;
-      Loc       := No_Location;
+      Prev_Loc  := No_Location;
       Prev_Typ  := 'm';
 
       for Index in 1 .. Ref_Count loop
@@ -786,10 +778,10 @@ package body SPARK_Specific is
             Ref : Xref_Key renames Xrefs.Table (Rnums (Index)).Key;
 
          begin
-            if Ref.Loc /= Loc
+            if Ref.Loc /= Prev_Loc
               or else (Prev_Typ = 'm' and then Ref.Typ = 'r')
             then
-               Loc           := Ref.Loc;
+               Prev_Loc      := Ref.Loc;
                Prev_Typ      := Ref.Typ;
                Nrefs         := Nrefs + 1;
                Rnums (Nrefs) := Rnums (Index);

gcc/ada/sem_attr.ads

@@ -402,7 +402,7 @@ package Sem_Attr is
       --  fixed-point types and discrete types. For fixed-point types and
       --  discrete types, this attribute gives the size used for default
       --  allocation of objects and components of the size. See section in
-      --  Einfo ("Handling of type'Size values") for further details.
+      --  Einfo ("Handling of Type'Size values") for further details.
 
       -------------------------
       -- Passed_By_Reference --

gcc/ada/sem_ch12.adb

@@ -6372,8 +6372,7 @@ package body Sem_Ch12 is
 
             Set_Is_Generic_Actual_Type (E, True);
             Set_Is_Hidden (E, False);
-            Set_Is_Potentially_Use_Visible (E,
+            Set_Is_Potentially_Use_Visible (E, In_Use (Instance));
-              In_Use (Instance));
 
             --  We constructed the generic actual type as a subtype of the
             --  supplied type. This means that it normally would not inherit

gcc/ada/sem_ch3.adb

@@ -2466,6 +2466,8 @@ package body Sem_Ch3 is
                Freeze_All (First_Entity (Current_Scope), Decl);
                Freeze_From := Last_Entity (Current_Scope);
 
+            --  Current scope is a package specification
+
             elsif Scope (Current_Scope) /= Standard_Standard
               and then not Is_Child_Unit (Current_Scope)
               and then No (Generic_Parent (Parent (L)))
@@ -2485,6 +2487,8 @@ package body Sem_Ch3 is
             then
                Adjust_Decl;
 
+               --  End of a package declaration
+
                --  In compilation mode the expansion of freeze node takes care
                --  of resolving expressions of all aspects in the list. In ASIS
                --  mode this must be done explicitly.
@@ -2495,6 +2499,9 @@ package body Sem_Ch3 is
                   Resolve_Aspects;
                end if;
 
+               --  This is a freeze point because it is the end of a
+               --  compilation unit.
+
                Freeze_All (First_Entity (Current_Scope), Decl);
                Freeze_From := Last_Entity (Current_Scope);
 
@@ -2561,6 +2568,12 @@ package body Sem_Ch3 is
             end if;
 
             Adjust_Decl;
+
+            --  The generated body of an expression function does not freeze,
+            --  unless it is a completion, in which case only the expression
+            --  itself freezes. THis is handled when the body itself is
+            --  analyzed (see Freeze_Expr_Types, sem_ch6.adb).
+
             Freeze_All (Freeze_From, Decl);
             Freeze_From := Last_Entity (Current_Scope);
          end if;
@@ -6740,8 +6753,12 @@ package body Sem_Ch3 is
          --  If we constructed a default range for the case where no range
          --  was given, then the expressions in the range must not freeze
          --  since they do not correspond to expressions in the source.
+         --  However, if the type inherits predicates the expressions will
+         --  be elaborated earlier and must freeze.
 
-         if Nkind (Indic) /= N_Subtype_Indication then
+         if Nkind (Indic) /= N_Subtype_Indication
+           and then not Has_Predicates (Derived_Type)
+         then
             Set_Must_Not_Freeze (Lo);
             Set_Must_Not_Freeze (Hi);
             Set_Must_Not_Freeze (Rang_Expr);

gcc/ada/sem_util.adb

@@ -20971,48 +20971,78 @@ package body Sem_Util is
 
    function Unique_Name (E : Entity_Id) return String is
 
-      --  Names of E_Subprogram_Body or E_Package_Body entities are not
+      --  Names in E_Subprogram_Body or E_Package_Body entities are not
       --  reliable, as they may not include the overloading suffix. Instead,
       --  when looking for the name of E or one of its enclosing scope, we get
       --  the name of the corresponding Unique_Entity.
 
-      function Get_Scoped_Name (E : Entity_Id) return String;
+      U : constant Entity_Id := Unique_Entity (E);
-      --  Return the name of E prefixed by all the names of the scopes to which
-      --  E belongs, except for Standard.
 
-      ---------------------
+      function This_Name return String;
-      -- Get_Scoped_Name --
-      ---------------------
 
-      function Get_Scoped_Name (E : Entity_Id) return String is
+      ---------------
-         Name : constant String := Get_Name_String (Chars (E));
+      -- This_Name --
+      ---------------
+
+      function This_Name return String is
       begin
-         if Has_Fully_Qualified_Name (E)
+         return Get_Name_String (Chars (U));
-           or else Scope (E) = Standard_Standard
+      end This_Name;
-         then
-            return Name;
-         else
-            return Get_Scoped_Name (Unique_Entity (Scope (E))) & "__" & Name;
-         end if;
-      end Get_Scoped_Name;
 
    --  Start of processing for Unique_Name
 
    begin
-      if E = Standard_Standard then
+      if E = Standard_Standard
-         return Get_Name_String (Name_Standard);
+        or else Has_Fully_Qualified_Name (E)
-
-      elsif Scope (E) = Standard_Standard
-        and then not (Ekind (E) = E_Package or else Is_Subprogram (E))
       then
-         return Get_Name_String (Name_Standard) & "__" &
+         return This_Name;
-           Get_Name_String (Chars (E));
 
       elsif Ekind (E) = E_Enumeration_Literal then
-         return Unique_Name (Etype (E)) & "__" & Get_Name_String (Chars (E));
+         return Unique_Name (Etype (E)) & "__" & This_Name;
 
       else
-         return Get_Scoped_Name (Unique_Entity (E));
+         declare
+            S : constant Entity_Id := Scope (U);
+            pragma Assert (Present (S));
+
+         begin
+            --  Prefix names of predefined types with standard__, but leave
+            --  names of user-defined packages and subprograms without prefix
+            --  (even if technically they are nested in the Standard package).
+
+            if S = Standard_Standard then
+               if Ekind (U) = E_Package or else Is_Subprogram (U) then
+                  return This_Name;
+               else
+                  return Unique_Name (S) & "__" & This_Name;
+               end if;
+
+            --  For intances of generic subprograms use the name of the related
+            --  instace and skip the scope of its wrapper package.
+
+            elsif Is_Wrapper_Package (S) then
+               pragma Assert (Scope (S) = Scope (Related_Instance (S)));
+               --  Wrapper package and the instantiation are in the same scope
+
+               declare
+                  Enclosing_Name : constant String :=
+                    Unique_Name (Scope (S)) & "__" &
+                      Get_Name_String (Chars (Related_Instance (S)));
+
+               begin
+                  if Is_Subprogram (U)
+                    and then not Is_Generic_Actual_Subprogram (U)
+                  then
+                     return Enclosing_Name;
+                  else
+                     return Enclosing_Name & "__" & This_Name;
+                  end if;
+               end;
+
+            else
+               return Unique_Name (S) & "__" & This_Name;
+            end if;
+         end;
       end if;
    end Unique_Name;
 

gcc/ada/sinfo.adb

@@ -6895,7 +6895,7 @@ package body Sinfo is
    function Pragma_Name (N : Node_Id) return Name_Id is
       Result : constant Name_Id := Pragma_Name_Unmapped (N);
    begin
-      for J in Pragma_Map'Range loop
+      for J in Pragma_Map'First .. Last_Pair loop
          if Result = Pragma_Map (J).Key then
             return Pragma_Map (J).Value;
          end if;

gcc/ada/spark_xrefs.ads

@@ -137,7 +137,7 @@ package SPARK_Xrefs is
    --      dependency-number and filename identify a file in FD lines
 
    --      entity-number and entity identify a scope in FS lines
-   --      for the file previously identified file.
+   --      for the previously identified file.
 
    --      (filename and entity are just a textual representations of
    --       dependency-number and entity-number)

gcc/ada/table.ads

@@ -221,8 +221,8 @@ package Table is
       --  Writes out contents of table using Tree_IO
 
       procedure Tree_Read;
-      --  Initializes table by reading contents previously written
+      --  Initializes table by reading contents previously written with the
-      --  with the Tree_Write call (also using Tree_IO)
+      --  Tree_Write call (also using Tree_IO).
 
    private