[multiple changes]
2012-10-03 Gary Dismukes <dismukes@adacore.com> * sem_ch6.adb: Minor typo fix. 2012-10-03 Robert Dewar <dewar@adacore.com> * checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated): Set Top_Level properly (to False) for operand of range of membership test. * exp_ch4.adb (Expand_Membership_Minimize_Eliminate_Overflow): Fix crash with -gnato3 and membership operations. (Expand_Membership_Minimize_Eliminate_Overflow): Fix error message and wrong results for -gnato3 large expression and predicated subtype. (Expand_Membership_Minimize_Eliminate_Overflow): Use expression action node to avoid using insert actions (bombs in some cases). (Expand_Compare_Minimize_Eliminate_Overflow): Use expression action node to avoid using insert actions (bombs in some cases). 2012-10-03 Javier Miranda <miranda@adacore.com> * exp_disp.adb (Set_CPP_Constructors_Old): Handle constructor of untagged type that has all its parameters with defaults and hence it covers the default constructor. From-SVN: r192027
This commit is contained in:
Arnaud Charlet
parent
3ada950b10
commit
71fb4dc8c8
|
|
@ -1,3 +1,29 @@
|
|||
2012-10-03 Gary Dismukes <dismukes@adacore.com>
|
||||
|
||||
* sem_ch6.adb: Minor typo fix.
|
||||
|
||||
2012-10-03 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated):
|
||||
Set Top_Level properly (to False) for operand of range of
|
||||
membership test.
|
||||
* exp_ch4.adb (Expand_Membership_Minimize_Eliminate_Overflow):
|
||||
Fix crash with -gnato3 and membership operations.
|
||||
(Expand_Membership_Minimize_Eliminate_Overflow): Fix error message
|
||||
and wrong results for -gnato3 large expression and predicated
|
||||
subtype.
|
||||
(Expand_Membership_Minimize_Eliminate_Overflow): Use
|
||||
expression action node to avoid using insert actions (bombs in
|
||||
some cases).
|
||||
(Expand_Compare_Minimize_Eliminate_Overflow): Use expression action
|
||||
node to avoid using insert actions (bombs in some cases).
|
||||
|
||||
2012-10-03 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* exp_disp.adb (Set_CPP_Constructors_Old): Handle constructor of
|
||||
untagged type that has all its parameters with defaults and hence it
|
||||
covers the default constructor.
|
||||
|
||||
2012-10-03 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* checks.adb, sem_prag.adb, s-bignum.ads: Minor typo fixes.
|
||||
|
|
|
|||
|
|
@ -1101,17 +1101,16 @@ package body Checks is
|
|||
|
||||
-- In all these cases, we will process at the higher level (and then
|
||||
-- this node will be processed during the downwards recursion that
|
||||
-- is part of the processing in Minimize_Eliminate_Overflow_Checks.
|
||||
-- is part of the processing in Minimize_Eliminate_Overflow_Checks).
|
||||
|
||||
if Is_Signed_Integer_Arithmetic_Op (P)
|
||||
or else Nkind (Op) in N_Membership_Test
|
||||
or else Nkind (Op) in N_Op_Compare
|
||||
or else Nkind (P) in N_Membership_Test
|
||||
or else Nkind (P) in N_Op_Compare
|
||||
|
||||
-- We may also be a range operand in a membership test
|
||||
|
||||
or else (Nkind (Op) = N_Range
|
||||
and then Nkind (Parent (Op)) in N_Membership_Test)
|
||||
|
||||
or else (Nkind (P) = N_Range
|
||||
and then Nkind (Parent (P)) in N_Membership_Test)
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -2308,6 +2308,9 @@ package body Exp_Ch4 is
|
|||
procedure Expand_Compare_Minimize_Eliminate_Overflow (N : Node_Id) is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
|
||||
Result_Type : constant Entity_Id := Etype (N);
|
||||
-- Capture result type (could be a derived boolean type)
|
||||
|
||||
Llo, Lhi : Uint;
|
||||
Rlo, Rhi : Uint;
|
||||
|
||||
|
|
@ -2452,22 +2455,22 @@ package body Exp_Ch4 is
|
|||
Right := Convert_To_Bignum (Right);
|
||||
end if;
|
||||
|
||||
-- We need a sequence that looks like
|
||||
-- We rewrite our node with:
|
||||
|
||||
-- Bnn : Boolean;
|
||||
|
||||
-- declare
|
||||
-- M : Mark_Id := SS_Mark;
|
||||
-- begin
|
||||
-- Bnn := Big_xx (Left, Right); (xx = EQ, NT etc)
|
||||
-- SS_Release (M);
|
||||
-- end;
|
||||
|
||||
-- This block is inserted (using Insert_Actions), and then the
|
||||
-- node is replaced with a reference to Bnn.
|
||||
-- do
|
||||
-- Bnn : Result_Type;
|
||||
-- declare
|
||||
-- M : Mark_Id := SS_Mark;
|
||||
-- begin
|
||||
-- Bnn := Big_xx (Left, Right); (xx = EQ, NT etc)
|
||||
-- SS_Release (M);
|
||||
-- end;
|
||||
-- in
|
||||
-- Bnn
|
||||
-- end
|
||||
|
||||
declare
|
||||
Blk : constant Node_Id := Make_Bignum_Block (Loc);
|
||||
Blk : constant Node_Id := Make_Bignum_Block (Loc);
|
||||
Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
|
||||
Ent : RE_Id;
|
||||
|
||||
|
|
@ -2481,7 +2484,7 @@ package body Exp_Ch4 is
|
|||
when N_Op_Ne => Ent := RE_Big_NE;
|
||||
end case;
|
||||
|
||||
-- Insert assignment to Bnn
|
||||
-- Insert assignment to Bnn into the bignum block
|
||||
|
||||
Insert_Before
|
||||
(First (Statements (Handled_Statement_Sequence (Blk))),
|
||||
|
|
@ -2493,19 +2496,18 @@ package body Exp_Ch4 is
|
|||
New_Occurrence_Of (RTE (Ent), Loc),
|
||||
Parameter_Associations => New_List (Left, Right))));
|
||||
|
||||
-- Insert actions (declaration of Bnn and block)
|
||||
-- Now do the rewrite with expression actions
|
||||
|
||||
Insert_Actions (N, New_List (
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Bnn,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Standard_Boolean, Loc)),
|
||||
Blk));
|
||||
|
||||
-- Rewrite node with reference to Bnn
|
||||
|
||||
Rewrite (N, New_Occurrence_Of (Bnn, Loc));
|
||||
Analyze_And_Resolve (N);
|
||||
Rewrite (N,
|
||||
Make_Expression_With_Actions (Loc,
|
||||
Actions => New_List (
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Bnn,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Result_Type, Loc)),
|
||||
Blk),
|
||||
Expression => New_Occurrence_Of (Bnn, Loc)));
|
||||
Analyze_And_Resolve (N, Result_Type);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
|
@ -3736,6 +3738,9 @@ package body Exp_Ch4 is
|
|||
-- Despite the name, this routine applies only to N_In, not to
|
||||
-- N_Not_In. The latter is always rewritten as not (X in Y).
|
||||
|
||||
Result_Type : constant Entity_Id := Etype (N);
|
||||
-- Capture result type, may be a derived boolean type
|
||||
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Lop : constant Node_Id := Left_Opnd (N);
|
||||
Rop : constant Node_Id := Right_Opnd (N);
|
||||
|
|
@ -3801,35 +3806,42 @@ package body Exp_Ch4 is
|
|||
declare
|
||||
Blk : constant Node_Id := Make_Bignum_Block (Loc);
|
||||
Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
|
||||
L : constant Entity_Id :=
|
||||
Make_Defining_Identifier (Loc, Name_uL);
|
||||
Lopnd : constant Node_Id := Convert_To_Bignum (Lop);
|
||||
Lbound : constant Node_Id :=
|
||||
Convert_To_Bignum (Low_Bound (Rop));
|
||||
Hbound : constant Node_Id :=
|
||||
Convert_To_Bignum (High_Bound (Rop));
|
||||
|
||||
-- Now we insert code that looks like
|
||||
-- Now we rewrite the membership test node to look like
|
||||
|
||||
-- Bnn : Boolean;
|
||||
|
||||
-- declare
|
||||
-- M : Mark_Id := SS_Mark;
|
||||
-- L : Bignum := Lopnd;
|
||||
-- begin
|
||||
-- Bnn := Big_GE (L, Lbound) and then Big_LE (L, Hbound)
|
||||
-- SS_Release (M);
|
||||
-- end;
|
||||
|
||||
-- and rewrite the membership test as a reference to Bnn
|
||||
-- do
|
||||
-- Bnn : Result_Type;
|
||||
-- declare
|
||||
-- M : Mark_Id := SS_Mark;
|
||||
-- L : Bignum := Lopnd;
|
||||
-- begin
|
||||
-- Bnn := Big_GE (L, Lbound) and then Big_LE (L, Hbound)
|
||||
-- SS_Release (M);
|
||||
-- end;
|
||||
-- in
|
||||
-- Bnn
|
||||
-- end
|
||||
|
||||
begin
|
||||
-- Insert declaration of L into declarations of bignum block
|
||||
|
||||
Insert_After
|
||||
(Last (Declarations (Blk)),
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Bnn,
|
||||
Defining_Identifier => L,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (RTE (RE_Bignum), Loc),
|
||||
Expression => Lopnd));
|
||||
|
||||
-- Insert assignment to Bnn into expressions of bignum block
|
||||
|
||||
Insert_Before
|
||||
(First (Statements (Handled_Statement_Sequence (Blk))),
|
||||
Make_Assignment_Statement (Loc,
|
||||
|
|
@ -3840,22 +3852,29 @@ package body Exp_Ch4 is
|
|||
Make_Function_Call (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of (RTE (RE_Big_GE), Loc),
|
||||
Parameter_Associations => New_List (Lbound)),
|
||||
Parameter_Associations => New_List (
|
||||
New_Occurrence_Of (L, Loc),
|
||||
Lbound)),
|
||||
Right_Opnd =>
|
||||
Make_Function_Call (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of (RTE (RE_Big_GE), Loc),
|
||||
Parameter_Associations => New_List (Hbound)))));
|
||||
New_Occurrence_Of (RTE (RE_Big_LE), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
New_Occurrence_Of (L, Loc),
|
||||
Hbound)))));
|
||||
|
||||
Insert_Actions (N, New_List (
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Bnn,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Standard_Boolean, Loc)),
|
||||
Blk));
|
||||
-- Now rewrite the node
|
||||
|
||||
Rewrite (N, New_Occurrence_Of (Bnn, Loc));
|
||||
Analyze_And_Resolve (N);
|
||||
Rewrite (N,
|
||||
Make_Expression_With_Actions (Loc,
|
||||
Actions => New_List (
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Bnn,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Result_Type, Loc)),
|
||||
Blk),
|
||||
Expression => New_Occurrence_Of (Bnn, Loc)));
|
||||
Analyze_And_Resolve (N, Result_Type);
|
||||
return;
|
||||
end;
|
||||
|
||||
|
|
@ -3876,12 +3895,16 @@ package body Exp_Ch4 is
|
|||
|
||||
else
|
||||
Convert_To_And_Rewrite (LLIB, Lop);
|
||||
Analyze_And_Resolve (Lop, LLIB, Suppress => All_Checks);
|
||||
Set_Analyzed (Lop, False);
|
||||
Analyze_And_Resolve (Lop, LLIB);
|
||||
|
||||
-- For the right operand, avoid unnecessary recursion into
|
||||
-- this routine, we know that overflow is not possible.
|
||||
|
||||
Convert_To_And_Rewrite (LLIB, Low_Bound (Rop));
|
||||
Convert_To_And_Rewrite (LLIB, High_Bound (Rop));
|
||||
Set_Analyzed (Rop, False);
|
||||
Analyze_And_Resolve (Rop, LLIB, Suppress => All_Checks);
|
||||
Analyze_And_Resolve (Rop, LLIB, Suppress => Overflow_Check);
|
||||
end if;
|
||||
|
||||
-- Now the three operands are of the same signed integer type,
|
||||
|
|
@ -3909,29 +3932,34 @@ package body Exp_Ch4 is
|
|||
|
||||
elsif Is_RTE (Etype (Lop), RE_Bignum) then
|
||||
|
||||
-- For X in T, we want to insert code that looks like
|
||||
-- For X in T, we want to rewrite our node as
|
||||
|
||||
-- Bnn : Boolean;
|
||||
-- do
|
||||
-- Bnn : Result_Type;
|
||||
|
||||
-- declare
|
||||
-- M : Mark_Id := SS_Mark;
|
||||
-- Lnn : Long_Long_Integer'Base
|
||||
-- Nnn : Bignum;
|
||||
-- declare
|
||||
-- M : Mark_Id := SS_Mark;
|
||||
-- Lnn : Long_Long_Integer'Base
|
||||
-- Nnn : Bignum;
|
||||
|
||||
-- begin
|
||||
-- Nnn := X;
|
||||
-- begin
|
||||
-- Nnn := X;
|
||||
|
||||
-- if not Bignum_In_LLI_Range (Nnn) then
|
||||
-- Bnn := False;
|
||||
-- else
|
||||
-- Lnn := From_Bignum (Nnn);
|
||||
-- Bnn := Lnn in T'Base and then T'Base (Lnn) in T;
|
||||
-- end if;
|
||||
-- if not Bignum_In_LLI_Range (Nnn) then
|
||||
-- Bnn := False;
|
||||
-- else
|
||||
-- Lnn := From_Bignum (Nnn);
|
||||
-- Bnn :=
|
||||
-- Lnn in LLIB (T'Base'First) .. LLIB (T'Base'Last)
|
||||
-- and then T'Base (Lnn) in T;
|
||||
-- end if;
|
||||
--
|
||||
-- SS_Release (M);
|
||||
-- end;
|
||||
-- SS_Release (M);
|
||||
-- end
|
||||
-- in
|
||||
-- Bnn
|
||||
-- end
|
||||
|
||||
-- And then rewrite the original membership as a reference to Bnn.
|
||||
-- A bit gruesome, but here goes.
|
||||
|
||||
declare
|
||||
|
|
@ -3939,10 +3967,12 @@ package body Exp_Ch4 is
|
|||
Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
|
||||
Lnn : constant Entity_Id := Make_Temporary (Loc, 'L', N);
|
||||
Nnn : constant Entity_Id := Make_Temporary (Loc, 'N', N);
|
||||
T : constant Entity_Id := Etype (Rop);
|
||||
TB : constant Entity_Id := Base_Type (T);
|
||||
Nin : Node_Id;
|
||||
|
||||
begin
|
||||
-- The last membership test is marked to prevent recursion
|
||||
-- Mark the last membership operation to prevent recursion
|
||||
|
||||
Nin :=
|
||||
Make_In (Loc,
|
||||
|
|
@ -3976,12 +4006,14 @@ package body Exp_Ch4 is
|
|||
|
||||
Make_If_Statement (Loc,
|
||||
Condition =>
|
||||
Make_Function_Call (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of
|
||||
(RTE (RE_Bignum_In_LLI_Range), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
New_Occurrence_Of (Nnn, Loc))),
|
||||
Make_Op_Not (Loc,
|
||||
Right_Opnd =>
|
||||
Make_Function_Call (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of
|
||||
(RTE (RE_Bignum_In_LLI_Range), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
New_Occurrence_Of (Nnn, Loc)))),
|
||||
|
||||
Then_Statements => New_List (
|
||||
Make_Assignment_Statement (Loc,
|
||||
|
|
@ -4000,27 +4032,42 @@ package body Exp_Ch4 is
|
|||
New_Occurrence_Of (Nnn, Loc)))),
|
||||
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Occurrence_Of (Bnn, Loc),
|
||||
Name => New_Occurrence_Of (Bnn, Loc),
|
||||
Expression =>
|
||||
Make_And_Then (Loc,
|
||||
Left_Opnd =>
|
||||
Left_Opnd =>
|
||||
Make_In (Loc,
|
||||
Left_Opnd =>
|
||||
New_Occurrence_Of (Lnn, Loc),
|
||||
Left_Opnd => New_Occurrence_Of (Lnn, Loc),
|
||||
Right_Opnd =>
|
||||
New_Occurrence_Of
|
||||
(Base_Type (Etype (Rop)), Loc)),
|
||||
Make_Range (Loc,
|
||||
Low_Bound =>
|
||||
Convert_To (LLIB,
|
||||
Make_Attribute_Reference (Loc,
|
||||
Attribute_Name => Name_First,
|
||||
Prefix =>
|
||||
New_Occurrence_Of (TB, Loc))),
|
||||
|
||||
High_Bound =>
|
||||
Convert_To (LLIB,
|
||||
Make_Attribute_Reference (Loc,
|
||||
Attribute_Name => Name_Last,
|
||||
Prefix =>
|
||||
New_Occurrence_Of (TB, Loc))))),
|
||||
|
||||
Right_Opnd => Nin))))));
|
||||
|
||||
Insert_Actions (N, New_List (
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Bnn,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Standard_Boolean, Loc)),
|
||||
Blk));
|
||||
-- Now we can do the rewrite
|
||||
|
||||
Rewrite (N, New_Occurrence_Of (Bnn, Loc));
|
||||
Analyze_And_Resolve (N);
|
||||
Rewrite (N,
|
||||
Make_Expression_With_Actions (Loc,
|
||||
Actions => New_List (
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Bnn,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Result_Type, Loc)),
|
||||
Blk),
|
||||
Expression => New_Occurrence_Of (Bnn, Loc)));
|
||||
Analyze_And_Resolve (N, Result_Type);
|
||||
return;
|
||||
end;
|
||||
|
||||
|
|
@ -4030,11 +4077,15 @@ package body Exp_Ch4 is
|
|||
else
|
||||
pragma Assert (Base_Type (Etype (Lop)) = LLIB);
|
||||
|
||||
-- We rewrite the membership test as
|
||||
-- We rewrite the membership test as (where T is the type with
|
||||
-- the predicate, i.e. the type of the right operand)
|
||||
|
||||
-- Lop in T'Base and then T'Base (Lop) in T
|
||||
-- Lop in LLIB (T'Base'First) .. LLIB (T'Base'Last)
|
||||
-- and then T'Base (Lop) in T
|
||||
|
||||
declare
|
||||
T : constant Entity_Id := Etype (Rop);
|
||||
TB : constant Entity_Id := Base_Type (T);
|
||||
Nin : Node_Id;
|
||||
|
||||
begin
|
||||
|
|
@ -4042,24 +4093,32 @@ package body Exp_Ch4 is
|
|||
|
||||
Nin :=
|
||||
Make_In (Loc,
|
||||
Left_Opnd =>
|
||||
Convert_To (Base_Type (Etype (Rop)),
|
||||
Duplicate_Subexpr (Lop)),
|
||||
Right_Opnd => New_Occurrence_Of (Etype (Rop), Loc));
|
||||
Left_Opnd => Convert_To (TB, Duplicate_Subexpr (Lop)),
|
||||
Right_Opnd => New_Occurrence_Of (T, Loc));
|
||||
Set_No_Minimize_Eliminate (Nin);
|
||||
|
||||
-- Now do the rewrite
|
||||
|
||||
Rewrite (N,
|
||||
Make_And_Then (Loc,
|
||||
Left_Opnd =>
|
||||
Left_Opnd =>
|
||||
Make_In (Loc,
|
||||
Left_Opnd => Lop,
|
||||
Right_Opnd =>
|
||||
New_Occurrence_Of (Base_Type (Etype (Lop)), Loc)),
|
||||
Make_Range (Loc,
|
||||
Low_Bound =>
|
||||
Convert_To (LLIB,
|
||||
Make_Attribute_Reference (Loc,
|
||||
Attribute_Name => Name_First,
|
||||
Prefix => New_Occurrence_Of (TB, Loc))),
|
||||
High_Bound =>
|
||||
Convert_To (LLIB,
|
||||
Make_Attribute_Reference (Loc,
|
||||
Attribute_Name => Name_Last,
|
||||
Prefix => New_Occurrence_Of (TB, Loc))))),
|
||||
Right_Opnd => Nin));
|
||||
|
||||
Analyze_And_Resolve (N, Restype, Suppress => All_Checks);
|
||||
Set_Analyzed (N, False);
|
||||
Analyze_And_Resolve (N, Restype);
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -8459,6 +8459,8 @@ package body Exp_Disp is
|
|||
P : Node_Id;
|
||||
Parms : List_Id;
|
||||
|
||||
Covers_Default_Constructor : Entity_Id := Empty;
|
||||
|
||||
begin
|
||||
-- Look for the constructor entities
|
||||
|
||||
|
|
@ -8490,7 +8492,8 @@ package body Exp_Disp is
|
|||
Make_Defining_Identifier (Loc,
|
||||
Chars (Defining_Identifier (P))),
|
||||
Parameter_Type =>
|
||||
New_Copy_Tree (Parameter_Type (P))));
|
||||
New_Copy_Tree (Parameter_Type (P)),
|
||||
Expression => New_Copy_Tree (Expression (P))));
|
||||
Next (P);
|
||||
end loop;
|
||||
end if;
|
||||
|
|
@ -8508,6 +8511,17 @@ package body Exp_Disp is
|
|||
Set_Convention (Init, Convention_CPP);
|
||||
Set_Is_Public (Init);
|
||||
Set_Has_Completion (Init);
|
||||
|
||||
-- If this constructor has parameters and all its parameters
|
||||
-- have defaults then it covers the default constructor. The
|
||||
-- semantic analyzer ensures that only one constructor with
|
||||
-- defaults covers the default constructor.
|
||||
|
||||
if Present (Parameter_Specifications (Parent (E)))
|
||||
and then Needs_No_Actuals (E)
|
||||
then
|
||||
Covers_Default_Constructor := Init;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next_Entity (E);
|
||||
|
|
@ -8519,6 +8533,49 @@ package body Exp_Disp is
|
|||
if not Found then
|
||||
Set_Is_Abstract_Type (Typ);
|
||||
end if;
|
||||
|
||||
-- Handle constructor that has all its parameters with defaults and
|
||||
-- hence it covers the default constructor. We generate a wrapper IP
|
||||
-- which calls the covering constructor.
|
||||
|
||||
if Present (Covers_Default_Constructor) then
|
||||
declare
|
||||
Body_Stmts : List_Id;
|
||||
Wrapper_Id : Entity_Id;
|
||||
Wrapper_Body_Node : Node_Id;
|
||||
begin
|
||||
Loc := Sloc (Covers_Default_Constructor);
|
||||
|
||||
Body_Stmts := New_List (
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name => New_Reference_To (Covers_Default_Constructor, Loc),
|
||||
Parameter_Associations => New_List (
|
||||
Make_Identifier (Loc, Name_uInit))));
|
||||
|
||||
Wrapper_Id := Make_Defining_Identifier (Loc,
|
||||
Make_Init_Proc_Name (Typ));
|
||||
|
||||
Wrapper_Body_Node :=
|
||||
Make_Subprogram_Body (Loc,
|
||||
Specification =>
|
||||
Make_Procedure_Specification (Loc,
|
||||
Defining_Unit_Name => Wrapper_Id,
|
||||
Parameter_Specifications => New_List (
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier =>
|
||||
Make_Defining_Identifier (Loc, Name_uInit),
|
||||
Parameter_Type =>
|
||||
New_Reference_To (Typ, Loc)))),
|
||||
Declarations => No_List,
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => Body_Stmts,
|
||||
Exception_Handlers => No_List));
|
||||
|
||||
Discard_Node (Wrapper_Body_Node);
|
||||
Set_Init_Proc (Typ, Wrapper_Id);
|
||||
end;
|
||||
end if;
|
||||
end Set_CPP_Constructors_Old;
|
||||
|
||||
-- Local variables
|
||||
|
|
|
|||
|
|
@ -5764,7 +5764,7 @@ package body Sem_Ch6 is
|
|||
and then TSS_Name /= TSS_Stream_Output
|
||||
then
|
||||
-- Here we have a definite conformance error. It is worth
|
||||
-- special casesing the error message for the case of a
|
||||
-- special casing the error message for the case of a
|
||||
-- controlling formal (which excludes null).
|
||||
|
||||
if Is_Controlling_Formal (New_Formal) then
|
||||
|
|
|
|||
Loading…
Reference in New Issue