[multiple changes]

2010-06-22  Robert Dewar  <dewar@adacore.com>

	* errout.adb (Finalize): Set Prev pointers.
	(Finalize): Delete continuations for deletion by warnings off(str).
	* erroutc.ads: Add Prev pointer to error message structure.

2010-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem.adb (Do_Unit_And_Dependents): If the spec of the main unit is a
	child unit, examine context of parent units to locate instantiated
	generics whose bodies may be needed. 
	* sem_ch12.adb: (Mark_Context): if the enclosing unit does not have a
	with_clause for the instantiated generic, examine the context of its
	parents, to set Withed_Body flag, so that it can be visited earlier.
	* exp_ch4.adb (Expand_N_Op_Not): If this is a VMS operator applied to
	an unsigned type, use a type of the proper size for the intermediate
	value, to prevent alignment problems on unchecked conversion.

2010-06-22  Geert Bosch  <bosch@adacore.com>

	* s-rannum.ads Change Generator type to be self-referential to allow
	Random to update its argument. Use "in" mode for the generator in the
	Reset procedures to allow them to be called from the Ada.Numerics
	packages without tricks.
	* s-rannum.adb: Use the self-referencing argument to get write access
	to the internal state of the random generator.
	* a-nudira.ads: Make Generator a derived type of
	System.Random_Numbers.Generator.
	* a-nudira.adb: Remove use of 'Unrestricted_Access.
	Put subprograms in alpha order and add headers.
	* g-mbdira.ads: Change Generator type to be self-referential.
	* g-mbdira.adb: Remove use of 'Unrestricted_Access.

From-SVN: r161215

gcc/ada/ChangeLog

 2010-06-22  Robert Dewar  <dewar@adacore.com>
 
+	* errout.adb (Finalize): Set Prev pointers.
+	(Finalize): Delete continuations for deletion by warnings off(str).
+	* erroutc.ads: Add Prev pointer to error message structure.
+
+2010-06-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem.adb (Do_Unit_And_Dependents): If the spec of the main unit is a
+	child unit, examine context of parent units to locate instantiated
+	generics whose bodies may be needed. 
+	* sem_ch12.adb: (Mark_Context): if the enclosing unit does not have a
+	with_clause for the instantiated generic, examine the context of its
+	parents, to set Withed_Body flag, so that it can be visited earlier.
+	* exp_ch4.adb (Expand_N_Op_Not): If this is a VMS operator applied to
+	an unsigned type, use a type of the proper size for the intermediate
+	value, to prevent alignment problems on unchecked conversion.
+
+2010-06-22  Geert Bosch  <bosch@adacore.com>
+
+	* s-rannum.ads Change Generator type to be self-referential to allow
+	Random to update its argument. Use "in" mode for the generator in the
+	Reset procedures to allow them to be called from the Ada.Numerics
+	packages without tricks.
+	* s-rannum.adb: Use the self-referencing argument to get write access
+	to the internal state of the random generator.
+	* a-nudira.ads: Make Generator a derived type of
+	System.Random_Numbers.Generator.
+	* a-nudira.adb: Remove use of 'Unrestricted_Access.
+	Put subprograms in alpha order and add headers.
+	* g-mbdira.ads: Change Generator type to be self-referential.
+	* g-mbdira.adb: Remove use of 'Unrestricted_Access.
+
+2010-06-22  Robert Dewar  <dewar@adacore.com>
+
 	* freeze.adb: Minor reformatting
 	Minor code reorganization (use Nkind_In and Ekind_In).
 

gcc/ada/a-nudira.adb

@@ -29,80 +29,66 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with System.Random_Numbers; use System.Random_Numbers;
-
 package body Ada.Numerics.Discrete_Random is
 
-   -------------------------
-   -- Implementation Note --
-   -------------------------
-
-   --  The design of this spec is a bit awkward, as a result of Ada 95 not
-   --  permitting in-out parameters for function formals (most naturally
-   --  Generator values would be passed this way). In pure Ada 95, the only
-   --  solution would be to add a self-referential component to the generator
-   --  allowing access to the generator object from inside the function. This
-   --  would work because the generator is limited, which prevents any copy.
+   package SRN renames System.Random_Numbers;
+   use SRN;
 
-   --  This is a bit heavy, so what we do is to use Unrestricted_Access to
-   --  get a pointer to the state in the passed Generator. This works because
-   --  Generator is a limited type and will thus always be passed by reference.
+   -----------
+   -- Image --
+   -----------
 
-   subtype Rep_Generator is System.Random_Numbers.Generator;
-   subtype Rep_State is System.Random_Numbers.State;
+   function Image (Of_State : State) return String is
+   begin
+      return Image (SRN.State (Of_State));
+   end Image;
 
-   function Rep_Random is
-      new Random_Discrete (Result_Subtype, Result_Subtype'First);
+   ------------
+   -- Random --
+   ------------
 
    function Random (Gen : Generator) return Result_Subtype is
+      function Random is
+        new SRN.Random_Discrete (Result_Subtype, Result_Subtype'First);
    begin
-      return Rep_Random (Gen.Rep);
+      return Random (SRN.Generator (Gen));
    end Random;
 
-   procedure Reset
-     (Gen       : Generator;
-      Initiator : Integer)
-   is
-      G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
-   begin
-      Reset (G, Initiator);
-   end Reset;
+   -----------
+   -- Reset --
+   -----------
 
    procedure Reset (Gen : Generator) is
-      G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
    begin
-      Reset (G);
+      Reset (SRN.Generator (Gen));
    end Reset;
 
-   procedure Save
-     (Gen        : Generator;
-      To_State   : out State)
-   is
+   procedure Reset (Gen : Generator; Initiator : Integer) is
    begin
-      Save (Gen.Rep, State (To_State));
-   end Save;
+      Reset (SRN.Generator (Gen), Initiator);
+   end Reset;
 
-   procedure Reset
-     (Gen        : Generator;
-      From_State : State)
-   is
-      G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
+   procedure Reset (Gen : Generator; From_State : State) is
    begin
-      Reset (G, From_State);
+      Reset (SRN.Generator (Gen), SRN.State (From_State));
    end Reset;
 
-   function Image (Of_State : State)  return String is
+   ----------
+   -- Save --
+   ----------
+
+   procedure Save (Gen : Generator; To_State   : out State) is
    begin
-      return Image (Rep_State (Of_State));
-   end Image;
+      Save (SRN.Generator (Gen), SRN.State (To_State));
+   end Save;
+
+   -----------
+   -- Value --
+   -----------
 
    function Value (Coded_State : String) return State is
-      G : Generator;
-      S : Rep_State;
    begin
-      Reset (G.Rep, Coded_State);
-      System.Random_Numbers.Save (G.Rep, S);
-      return State (S);
+      return State (SRN.State'(Value (Coded_State)));
    end Value;
 
 end Ada.Numerics.Discrete_Random;

gcc/ada/a-nudira.ads

@@ -66,9 +66,7 @@ package Ada.Numerics.Discrete_Random is
 
 private
 
-   type Generator is limited record
-      Rep : System.Random_Numbers.Generator;
-   end record;
+   type Generator is new System.Random_Numbers.Generator;
 
    type State is new System.Random_Numbers.State;
 

gcc/ada/a-nuflra.adb

@@ -29,29 +29,19 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Interfaces; use Interfaces;
-
-with System.Random_Numbers; use System.Random_Numbers;
-
 package body Ada.Numerics.Float_Random is
 
-   -------------------------
-   -- Implementation Note --
-   -------------------------
+   package SRN renames System.Random_Numbers;
+   use SRN;
 
-   --  The design of this spec is a bit awkward, as a result of Ada 95 not
-   --  permitting in-out parameters for function formals (most naturally
-   --  Generator values would be passed this way). In pure Ada 95, the only
-   --  solution would be to add a self-referential component to the generator
-   --  allowing access to the generator object from inside the function. This
-   --  would work because the generator is limited, which prevents any copy.
-
-   --  This is a bit heavy, so what we do is to use Unrestricted_Access to
-   --  get a pointer to the state in the passed Generator. This works because
-   --  Generator is a limited type and will thus always be passed by reference.
+   -----------
+   -- Image --
+   -----------
 
-   subtype Rep_Generator is System.Random_Numbers.Generator;
-   subtype Rep_State is System.Random_Numbers.State;
+   function Image (Of_State : State) return String is
+   begin
+      return Image (SRN.State (Of_State));
+   end Image;
 
    ------------
    -- Random --
@@ -59,35 +49,32 @@ package body Ada.Numerics.Float_Random is
 
    function Random (Gen : Generator) return Uniformly_Distributed is
    begin
-      return Random (Gen.Rep);
+      return Random (SRN.Generator (Gen));
    end Random;
 
    -----------
    -- Reset --
    -----------
 
-   --  Version that works from given initiator value
+   --  Version that works from calendar
 
-   procedure Reset (Gen : Generator; Initiator : Integer) is
-      G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
+   procedure Reset (Gen : Generator) is
    begin
-      Reset (G, Integer_32 (Initiator));
+      Reset (SRN.Generator (Gen));
    end Reset;
 
-   --  Version that works from calendar
+   --  Version that works from given initiator value
 
-   procedure Reset (Gen : Generator) is
-      G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
+   procedure Reset (Gen : Generator; Initiator : Integer) is
    begin
-      Reset (G);
+      Reset (SRN.Generator (Gen), Initiator);
    end Reset;
 
    --  Version that works from specific saved state
 
    procedure Reset (Gen : Generator; From_State : State) is
-      G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
    begin
-      Reset (G, From_State);
+      Reset (SRN.Generator (Gen), From_State);
    end Reset;
 
    ----------
@@ -96,28 +83,19 @@ package body Ada.Numerics.Float_Random is
 
    procedure Save  (Gen : Generator; To_State : out State) is
    begin
-      Save (Gen.Rep, State (To_State));
+      Save (SRN.Generator (Gen), To_State);
    end Save;
 
    -----------
-   -- Image --
-   -----------
-
-   function Image (Of_State : State) return String is
-   begin
-      return Image (Rep_State (Of_State));
-   end Image;
-
-   -----------
    -- Value --
    -----------
 
    function Value (Coded_State : String) return State is
-      G : Generator;
-      S : Rep_State;
+      G : SRN.Generator;
+      S : SRN.State;
    begin
-      Reset (G.Rep, Coded_State);
-      System.Random_Numbers.Save (G.Rep, S);
+      Reset (G, Coded_State);
+      Save (G, S);
       return State (S);
    end Value;
 

gcc/ada/a-nuflra.ads

@@ -65,9 +65,7 @@ package Ada.Numerics.Float_Random is
 
 private
 
-   type Generator is limited record
-      Rep : System.Random_Numbers.Generator;
-   end record;
+   type Generator is new System.Random_Numbers.Generator;
 
    type State is new System.Random_Numbers.State;
 

gcc/ada/errout.adb

@@ -881,6 +881,7 @@ package body Errout is
       Errors.Append
         ((Text     => new String'(Msg_Buffer (1 .. Msglen)),
           Next     => No_Error_Msg,
+          Prev     => No_Error_Msg,
           Sptr     => Sptr,
           Optr     => Optr,
           Sfile    => Get_Source_File_Index (Sptr),
@@ -1215,6 +1216,16 @@ package body Errout is
       F   : Error_Msg_Id;
 
    begin
+      --  Set Prev pointers
+
+      Cur := First_Error_Msg;
+      while Cur /= No_Error_Msg loop
+         Nxt := Errors.Table (Cur).Next;
+         exit when Nxt = No_Error_Msg;
+         Errors.Table (Nxt).Prev := Cur;
+         Cur := Nxt;
+      end loop;
+
       --  Eliminate any duplicated error messages from the list. This is
       --  done after the fact to avoid problems with Change_Error_Text.
 
@@ -1239,11 +1250,28 @@ package body Errout is
       while Cur /= No_Error_Msg loop
          if not Errors.Table (Cur).Deleted
            and then Warning_Specifically_Suppressed
-                     (Errors.Table (Cur).Sptr,
-                      Errors.Table (Cur).Text)
+                      (Errors.Table (Cur).Sptr, Errors.Table (Cur).Text)
          then
             Errors.Table (Cur).Deleted := True;
             Warnings_Detected := Warnings_Detected - 1;
+
+            --  If this is a continuation, delete previous messages
+
+            F := Cur;
+            while Errors.Table (F).Msg_Cont loop
+               F := Errors.Table (F).Prev;
+               Errors.Table (F).Deleted := True;
+            end loop;
+
+            --  Delete any following continuations
+
+            F := Cur;
+            loop
+               F := Errors.Table (F).Next;
+               exit when F = No_Error_Msg;
+               exit when not Errors.Table (F).Msg_Cont;
+               Errors.Table (F).Deleted := True;
+            end loop;
          end if;
 
          Cur := Errors.Table (Cur).Next;

gcc/ada/erroutc.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -147,6 +147,11 @@ package Erroutc is
       --  Pointer to next message in error chain. A value of No_Error_Msg
       --  indicates the end of the chain.
 
+      Prev : Error_Msg_Id;
+      --  Pointer to previous message in error chain. Only set during the
+      --  Finalize procedure. A value of No_Error_Msg indicates the first
+      --  message in the chain.
+
       Sfile : Source_File_Index;
       --  Source table index of source file. In the case of an error that
       --  refers to a template, always references the original template

gcc/ada/exp_ch4.adb

@@ -6905,12 +6905,39 @@ package body Exp_Ch4 is
 
       if Is_VMS_Operator (Entity (N)) then
          declare
-            LI : constant Entity_Id := RTE (RE_Unsigned_64);
+            Rtyp : Entity_Id;
+            Utyp : Entity_Id;
+
          begin
+            --  If this is a derived type, retrieve original VMS type so that
+            --  the proper sized type is used for intermediate values.
+
+            if Is_Derived_Type (Typ) then
+               Rtyp := First_Subtype (Etype (Typ));
+            else
+               Rtyp := Typ;
+            end if;
+
+            --  The proper unsigned type must have a size compatible with
+            --  the operand, to prevent misalignment..
+
+            if RM_Size (Rtyp) <= 8 then
+               Utyp := RTE (RE_Unsigned_8);
+
+            elsif RM_Size (Rtyp) <= 16 then
+               Utyp := RTE (RE_Unsigned_16);
+
+            elsif RM_Size (Rtyp) = RM_Size (Standard_Unsigned) then
+               Utyp := Typ;
+
+            else
+               Utyp := RTE (RE_Long_Long_Unsigned);
+            end if;
+
             Rewrite (N,
               Unchecked_Convert_To (Typ,
-                (Make_Op_Not (Loc,
-                   Right_Opnd => Unchecked_Convert_To (LI, Right_Opnd (N))))));
+                Make_Op_Not (Loc,
+                  Unchecked_Convert_To (Utyp, Right_Opnd (N)))));
             Analyze_And_Resolve (N, Typ);
             return;
          end;

gcc/ada/g-mbdira.adb

@@ -35,25 +35,8 @@ with Interfaces; use Interfaces;
 
 package body GNAT.MBBS_Discrete_Random is
 
-   -------------------------
-   -- Implementation Note --
-   -------------------------
-
-   --  The design of this spec is a bit awkward, as a result of Ada 95 not
-   --  permitting in-out parameters for function formals (most naturally
-   --  Generator values would be passed this way). In pure Ada 95, the only
-   --  solution would be to add a self-referential component to the generator
-   --  allowing access to the generator object from inside the function. This
-   --  would work because the generator is limited, which prevents any copy.
-
-   --  This is a bit heavy, so what we do is to use Unrestricted_Access to
-   --  get a pointer to the state in the passed Generator. This works because
-   --  Generator is a limited type and will thus always be passed by reference.
-
    package Calendar renames Ada.Calendar;
 
-   type Pointer is access all State;
-
    Fits_In_32_Bits : constant Boolean :=
                        Rst'Size < 31
                          or else (Rst'Size = 31
@@ -109,7 +92,7 @@ package body GNAT.MBBS_Discrete_Random is
    ------------
 
    function Random (Gen : Generator) return Rst is
-      Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
+      S    : State renames Gen.Writable.Self.Gen_State;
       Temp : Int;
       TF   : Flt;
 
@@ -124,21 +107,21 @@ package body GNAT.MBBS_Discrete_Random is
 
       --  Continue with computation if non-flat range
 
-      Genp.X1 := Square_Mod_N (Genp.X1, Genp.P);
-      Genp.X2 := Square_Mod_N (Genp.X2, Genp.Q);
-      Temp := Genp.X2 - Genp.X1;
+      S.X1 := Square_Mod_N (S.X1, S.P);
+      S.X2 := Square_Mod_N (S.X2, S.Q);
+      Temp := S.X2 - S.X1;
 
       --  Following duplication is not an error, it is a loop unwinding!
 
       if Temp < 0 then
-         Temp := Temp + Genp.Q;
+         Temp := Temp + S.Q;
       end if;
 
       if Temp < 0 then
-         Temp := Temp + Genp.Q;
+         Temp := Temp + S.Q;
       end if;
 
-      TF := Offs + (Flt (Temp) * Flt (Genp.P) + Flt (Genp.X1)) * Genp.Scl;
+      TF := Offs + (Flt (Temp) * Flt (S.P) + Flt (S.X1)) * S.Scl;
 
       --  Pathological, but there do exist cases where the rounding implicit
       --  in calculating the scale factor will cause rounding to 'Last + 1.
@@ -160,7 +143,7 @@ package body GNAT.MBBS_Discrete_Random is
    -----------
 
    procedure Reset (Gen : Generator; Initiator : Integer) is
-      Genp   : constant Pointer := Gen.Gen_State'Unrestricted_Access;
+      S      : State renames Gen.Writable.Self.Gen_State;
       X1, X2 : Int;
 
    begin
@@ -174,7 +157,7 @@ package body GNAT.MBBS_Discrete_Random is
 
       --  Eliminate effects of small Initiators
 
-      Genp.all :=
+      S :=
         (X1  => X1,
          X2  => X2,
          P   => K1,
@@ -188,7 +171,7 @@ package body GNAT.MBBS_Discrete_Random is
    -----------
 
    procedure Reset (Gen : Generator) is
-      Genp : constant Pointer       := Gen.Gen_State'Unrestricted_Access;
+      S    : State renames Gen.Writable.Self.Gen_State;
       Now  : constant Calendar.Time := Calendar.Clock;
       X1   : Int;
       X2   : Int;
@@ -210,7 +193,7 @@ package body GNAT.MBBS_Discrete_Random is
          X2 := Square_Mod_N (X2, K2);
       end loop;
 
-      Genp.all :=
+      S :=
         (X1  => X1,
          X2  => X2,
          P   => K1,
@@ -225,9 +208,8 @@ package body GNAT.MBBS_Discrete_Random is
    -----------
 
    procedure Reset (Gen : Generator; From_State : State) is
-      Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
    begin
-      Genp.all := From_State;
+      Gen.Writable.Self.Gen_State := From_State;
    end Reset;
 
    ----------

gcc/ada/g-mbdira.ads

@@ -111,7 +111,12 @@ private
       Scl : Flt := Scal;
    end record;
 
+   type Writable_Access (Self : access Generator) is limited null record;
+   --  Auxiliary type to make Generator a self-referential type
+
    type Generator is limited record
+      Writable  : Writable_Access (Generator'Access);
+      --  This self reference allows functions to modify Generator arguments
       Gen_State : State;
    end record;
 

gcc/ada/s-rannum.adb

@@ -95,21 +95,6 @@ use Ada;
 
 package body System.Random_Numbers is
 
-   -------------------------
-   -- Implementation Note --
-   -------------------------
-
-   --  The design of this spec is a bit awkward, as a result of Ada 95 not
-   --  permitting in-out parameters for function formals (most naturally
-   --  Generator values would be passed this way). In pure Ada 95, the only
-   --  solution would be to add a self-referential component to the generator
-   --  allowing access to the generator object from inside the function. This
-   --  would work because the generator is limited, which prevents any copy.
-
-   --  This is a bit heavy, so what we do is to use Unrestricted_Access to
-   --  get a pointer to the state in the passed Generator. This works because
-   --  Generator is a limited type and will thus always be passed by reference.
-
    Y2K : constant Calendar.Time :=
            Calendar.Time_Of
              (Year => 2000, Month => 1, Day => 1, Seconds => 0.0);
@@ -168,7 +153,7 @@ package body System.Random_Numbers is
    -- Local Subprograms --
    -----------------------
 
-   procedure Init (Gen : out Generator; Initiator : Unsigned_32);
+   procedure Init (Gen : Generator; Initiator : Unsigned_32);
    --  Perform a default initialization of the state of Gen. The resulting
    --  state is identical for identical values of Initiator.
 
@@ -192,7 +177,7 @@ package body System.Random_Numbers is
    ------------
 
    function Random (Gen : Generator) return Unsigned_32 is
-      G : Generator renames Gen'Unrestricted_Access.all;
+      G : Generator renames Gen.Writable.Self.all;
       Y : State_Val;
       I : Integer;      --  should avoid use of identifier I ???
 
@@ -498,23 +483,23 @@ package body System.Random_Numbers is
    -- Reset --
    -----------
 
-   procedure Reset (Gen : out Generator) is
+   procedure Reset (Gen : Generator) is
       X : constant Unsigned_32 := Unsigned_32 ((Calendar.Clock - Y2K) * 64.0);
    begin
       Init (Gen, X);
    end Reset;
 
-   procedure Reset (Gen : out Generator; Initiator : Integer_32) is
+   procedure Reset (Gen : Generator; Initiator : Integer_32) is
    begin
       Init (Gen, To_Unsigned (Initiator));
    end Reset;
 
-   procedure Reset (Gen : out Generator; Initiator : Unsigned_32) is
+   procedure Reset (Gen : Generator; Initiator : Unsigned_32) is
    begin
       Init (Gen, Initiator);
    end Reset;
 
-   procedure Reset (Gen : out Generator; Initiator : Integer) is
+   procedure Reset (Gen : Generator; Initiator : Integer) is
    begin
       pragma Warnings (Off, "condition is always *");
       --  This is probably an unnecessary precaution against future change, but
@@ -539,27 +524,27 @@ package body System.Random_Numbers is
       pragma Warnings (On, "condition is always *");
    end Reset;
 
-   procedure Reset (Gen : out Generator; Initiator : Initialization_Vector) is
+   procedure Reset (Gen : Generator; Initiator : Initialization_Vector) is
+      G    : Generator renames Gen.Writable.Self.all;
       I, J : Integer;
 
    begin
-      Init (Gen, Seed1);
+      Init (G, Seed1);
       I := 1;
       J := 0;
 
       if Initiator'Length > 0 then
          for K in reverse 1 .. Integer'Max (N, Initiator'Length) loop
-            Gen.S (I) :=
-              (Gen.S (I)
-               xor ((Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30))
-                    * Mult1))
+            G.S (I) :=
+              (G.S (I) xor ((G.S (I - 1)
+                               xor Shift_Right (G.S (I - 1), 30)) * Mult1))
               + Initiator (J + Initiator'First) + Unsigned_32 (J);
 
             I := I + 1;
             J := J + 1;
 
             if I >= N then
-               Gen.S (0) := Gen.S (N - 1);
+               G.S (0) := G.S (N - 1);
                I := 1;
             end if;
 
@@ -570,39 +555,42 @@ package body System.Random_Numbers is
       end if;
 
       for K in reverse 1 .. N - 1 loop
-         Gen.S (I) :=
-           (Gen.S (I) xor ((Gen.S (I - 1)
-                            xor Shift_Right (Gen.S (I - 1), 30)) * Mult2))
+         G.S (I) :=
+           (G.S (I) xor ((G.S (I - 1)
+                            xor Shift_Right (G.S (I - 1), 30)) * Mult2))
            - Unsigned_32 (I);
          I := I + 1;
 
          if I >= N then
-            Gen.S (0) := Gen.S (N - 1);
+            G.S (0) := G.S (N - 1);
             I := 1;
          end if;
       end loop;
 
-      Gen.S (0) := Upper_Mask;
+      G.S (0) := Upper_Mask;
    end Reset;
 
-   procedure Reset (Gen : out Generator; From_State : Generator) is
+   procedure Reset (Gen : Generator; From_State : Generator) is
+      G : Generator renames Gen.Writable.Self.all;
    begin
-      Gen.S := From_State.S;
-      Gen.I := From_State.I;
+      G.S := From_State.S;
+      G.I := From_State.I;
    end Reset;
 
-   procedure Reset (Gen : out Generator; From_State : State) is
+   procedure Reset (Gen : Generator; From_State : State) is
+      G : Generator renames Gen.Writable.Self.all;
    begin
-      Gen.I := 0;
-      Gen.S := From_State;
+      G.I := 0;
+      G.S := From_State;
    end Reset;
 
-   procedure Reset (Gen : out Generator; From_Image : String) is
+   procedure Reset (Gen : Generator; From_Image : String) is
+      G : Generator renames Gen.Writable.Self.all;
    begin
-      Gen.I := 0;
+      G.I := 0;
 
       for J in 0 .. N - 1 loop
-         Gen.S (J) := Extract_Value (From_Image, J);
+         G.S (J) := Extract_Value (From_Image, J);
       end loop;
    end Reset;
 
@@ -670,17 +658,18 @@ package body System.Random_Numbers is
    -- Init --
    ----------
 
-   procedure Init (Gen : out Generator; Initiator : Unsigned_32) is
+   procedure Init (Gen : Generator; Initiator : Unsigned_32) is
+      G : Generator renames Gen.Writable.Self.all;
    begin
-      Gen.S (0) := Initiator;
+      G.S (0) := Initiator;
 
       for I in 1 .. N - 1 loop
-         Gen.S (I) :=
-           Mult0 * (Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30)) +
-                                                             Unsigned_32 (I);
+         G.S (I) :=
+           (G.S (I - 1) xor Shift_Right (G.S (I - 1), 30)) * Mult0
+           + Unsigned_32 (I);
       end loop;
 
-      Gen.I := 0;
+      G.I := 0;
    end Init;
 
    ------------------
@@ -706,5 +695,4 @@ package body System.Random_Numbers is
    begin
       return State_Val'Value (S (Start .. Start + Image_Numeral_Length - 1));
    end Extract_Value;
-
 end System.Random_Numbers;

gcc/ada/s-rannum.ads

@@ -88,27 +88,27 @@ package System.Random_Numbers is
    --  in Reset).  In general, there is little point in providing more than
    --  a certain number of values (currently 624).
 
-   procedure Reset (Gen : out Generator);
+   procedure Reset (Gen : Generator);
    --  Re-initialize the state of Gen from the time of day
 
-   procedure Reset (Gen : out Generator; Initiator : Initialization_Vector);
-   procedure Reset (Gen : out Generator; Initiator : Interfaces.Integer_32);
-   procedure Reset (Gen : out Generator; Initiator : Interfaces.Unsigned_32);
-   procedure Reset (Gen : out Generator; Initiator : Integer);
+   procedure Reset (Gen : Generator; Initiator : Initialization_Vector);
+   procedure Reset (Gen : Generator; Initiator : Interfaces.Integer_32);
+   procedure Reset (Gen : Generator; Initiator : Interfaces.Unsigned_32);
+   procedure Reset (Gen : Generator; Initiator : Integer);
    --  Re-initialize Gen based on the Initiator in various ways. Identical
    --  values of Initiator cause identical sequences of values.
 
-   procedure Reset (Gen : out Generator; From_State : Generator);
+   procedure Reset (Gen : Generator; From_State : Generator);
    --  Causes the state of Gen to be identical to that of From_State; Gen
    --  and From_State will produce identical sequences of values subsequently.
 
-   procedure Reset (Gen : out Generator; From_State : State);
+   procedure Reset (Gen : Generator; From_State : State);
    procedure Save  (Gen : Generator; To_State : out State);
    --  The sequence
    --     Save (Gen2, S); Reset (Gen1, S)
    --  has the same effect as Reset (Gen2, Gen1).
 
-   procedure Reset (Gen : out Generator; From_Image : String);
+   procedure Reset (Gen : Generator; From_Image : String);
    function Image (Gen : Generator) return String;
    --  The call
    --     Reset (Gen2, Image (Gen1))
@@ -135,11 +135,15 @@ private
    subtype State_Val is Interfaces.Unsigned_32;
    type State is array (0 .. N - 1) of State_Val;
 
+   type Writable_Access (Self : access Generator) is limited null record;
+   --  Auxiliary type to make Generator a self-referential type
+
    type Generator is limited record
-      S : State := (others => 0);
+      Writable  : Writable_Access (Generator'Access);
+      --  This self reference allows functions to modify Generator arguments
+      S         : State := (others => 0);
       --  The shift register, a circular buffer
-
-      I : Integer := N;
+      I         : Integer := N;
       --  Current starting position in shift register S (N means uninitialized)
    end record;
 

gcc/ada/sem.adb

@@ -1728,7 +1728,9 @@ package body Sem is
 
       procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is
          Unit_Num : constant Unit_Number_Type :=
-                      Get_Cunit_Unit_Number (CU);
+           Get_Cunit_Unit_Number (CU);
+         Child     : Node_Id;
+         Parent_CU : Node_Id;
 
          procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
 
@@ -1758,6 +1760,20 @@ package body Sem is
 
                   if CU = Library_Unit (Main_CU) then
                      Process_Bodies_In_Context (CU);
+
+                     --  If main is a child unit, examine context of parent
+                     --  units to see if they include instantiated units.
+
+                     if Is_Child_Unit (Cunit_Entity (Main_Unit)) then
+                        Child := Cunit_Entity (Main_Unit);
+                        while Is_Child_Unit (Child) loop
+                           Parent_CU :=
+                             Cunit
+                               (Get_Cunit_Entity_Unit_Number (Scope (Child)));
+                           Process_Bodies_In_Context (Parent_CU);
+                           Child := Scope (Child);
+                        end loop;
+                     end if;
                   end if;
 
                   Do_Action (CU, Item);

gcc/ada/sem_ch12.adb

@@ -2598,7 +2598,7 @@ package body Sem_Ch12 is
          then
             Error_Msg_N ("premature usage of incomplete type", Def);
 
-         elsif Is_Internal (Designated_Type (T)) then
+         elsif not Is_Entity_Name (Subtype_Indication (Def)) then
             Error_Msg_N
               ("only a subtype mark is allowed in a formal", Def);
          end if;
@@ -10396,6 +10396,7 @@ package body Sem_Ch12 is
    procedure Mark_Context (Inst_Decl : Node_Id; Gen_Decl : Node_Id) is
       Inst_CU : constant Unit_Number_Type := Get_Code_Unit   (Inst_Decl);
       Gen_CU  : constant Unit_Number_Type := Get_Source_Unit (Gen_Decl);
+      Inst    : Entity_Id := Cunit_Entity (Inst_CU);
       Clause  : Node_Id;
 
    begin
@@ -10410,10 +10411,31 @@ package body Sem_Ch12 is
            and then  Library_Unit (Clause) = Cunit (Gen_CU)
          then
             Set_Withed_Body (Clause, Cunit (Gen_CU));
+            return;
          end if;
 
          Next (Clause);
       end loop;
+
+      --  If the with-clause for the generic unit was not found, it must
+      --  appear in some ancestor of the current unit.
+
+      while Is_Child_Unit (Inst) loop
+         Inst := Scope (Inst);
+         Clause :=
+           First (Context_Items (Parent (Unit_Declaration_Node (Inst))));
+
+         while Present (Clause) loop
+            if Nkind (Clause) = N_With_Clause
+              and then  Library_Unit (Clause) = Cunit (Gen_CU)
+            then
+               Set_Withed_Body (Clause, Cunit (Gen_CU));
+               return;
+            end if;
+
+            Next (Clause);
+         end loop;
+      end loop;
    end Mark_Context;
 
    ---------------------