+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
-- --
------------------------------------------------------------------------------
-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;
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;
-- --
------------------------------------------------------------------------------
-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 --
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;
----------
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;
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;
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),
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.
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;
-- --
-- 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- --
-- 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
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;
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
------------
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;
-- 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.
-----------
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
-- Eliminate effects of small Initiators
- Genp.all :=
+ S :=
(X1 => X1,
X2 => X2,
P => K1,
-----------
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;
X2 := Square_Mod_N (X2, K2);
end loop;
- Genp.all :=
+ S :=
(X1 => X1,
X2 => X2,
P => K1,
-----------
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;
----------
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;
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);
-- 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.
------------
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 ???
-- 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
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;
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;
-- 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;
------------------
begin
return State_Val'Value (S (Start .. Start + Image_Numeral_Length - 1));
end Extract_Value;
-
end System.Random_Numbers;
-- 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))
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;
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);
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);
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;
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
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;
---------------------
projects / gcc.git / commitdiff