[multiple changes]

2012-10-02  Robert Dewar  <dewar@adacore.com>

	* sem_ch8.adb: Minor reformatting.

2012-10-02  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Set_CPP_Constructors): Handle constructor with default
	parameters that covers the default constructor.

2012-10-02  Yannick Moy  <moy@adacore.com>

	* s-bignum.adb: Minor stylistic and comment corrections.

2012-10-02  Pascal Obry  <obry@adacore.com>

	* prj-util.adb (For_Interface_Sources): Iterate over all sources in
	aggregate library projects.

From-SVN: r191977
This commit is contained in:
Arnaud Charlet 2012-10-02 14:29:37 +02:00
parent 27dd0dde2d
commit 7353413840
5 changed files with 108 additions and 28 deletions

View File

@ -1,3 +1,21 @@
2012-10-02 Robert Dewar <dewar@adacore.com>
* sem_ch8.adb: Minor reformatting.
2012-10-02 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Set_CPP_Constructors): Handle constructor with default
parameters that covers the default constructor.
2012-10-02 Yannick Moy <moy@adacore.com>
* s-bignum.adb: Minor stylistic and comment corrections.
2012-10-02 Pascal Obry <obry@adacore.com>
* prj-util.adb (For_Interface_Sources): Iterate over all sources in
aggregate library projects.
2012-10-02 Ed Schonberg <schonberg@adacore.com> 2012-10-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Find_Direct_Name): The left-hand side of an * sem_ch8.adb (Find_Direct_Name): The left-hand side of an

View File

@ -8537,6 +8537,10 @@ package body Exp_Disp is
Body_Stmts : List_Id; Body_Stmts : List_Id;
Init_Tags_List : List_Id; Init_Tags_List : List_Id;
Covers_Default_Constructor : Entity_Id := Empty;
-- Start of processing for Set_CPP_Constructor
begin begin
pragma Assert (Is_CPP_Class (Typ)); pragma Assert (Is_CPP_Class (Typ));
@ -8622,7 +8626,9 @@ package body Exp_Disp is
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars (Defining_Identifier (P))), Chars (Defining_Identifier (P))),
Parameter_Type => New_Copy_Tree (Parameter_Type (P)))); Parameter_Type =>
New_Copy_Tree (Parameter_Type (P)),
Expression => New_Copy_Tree (Expression (P))));
Next (P); Next (P);
end loop; end loop;
end if; end if;
@ -8713,6 +8719,17 @@ package body Exp_Disp is
Discard_Node (Wrapper_Body_Node); Discard_Node (Wrapper_Body_Node);
Set_Init_Proc (Typ, Wrapper_Id); Set_Init_Proc (Typ, Wrapper_Id);
-- 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 := Wrapper_Id;
end if;
end if; end if;
Next_Entity (E); Next_Entity (E);
@ -8725,6 +8742,46 @@ package body Exp_Disp is
Set_Is_Abstract_Type (Typ); Set_Is_Abstract_Type (Typ);
end if; 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
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 if;
-- If the CPP type has constructors then it must import also the default -- If the CPP type has constructors then it must import also the default
-- C++ constructor. It is required for default initialization of objects -- C++ constructor. It is required for default initialization of objects
-- of the type. It is also required to elaborate objects of Ada types -- of the type. It is also required to elaborate objects of Ada types

View File

@ -439,7 +439,7 @@ package body Prj.Util is
-- Local declarations -- Local declarations
Iter : Source_Iterator := For_Each_Source (Tree, Project); Iter : Source_Iterator;
Sid : Source_Id; Sid : Source_Id;
ALI : ALI_Id; ALI : ALI_Id;
@ -451,6 +451,12 @@ package body Prj.Util is
-- Start of processing for For_Interface_Sources -- Start of processing for For_Interface_Sources
begin begin
if Project.Qualifier = Aggregate_Library then
Iter := For_Each_Source (Tree);
else
Iter := For_Each_Source (Tree, Project);
end if;
-- First look at each spec, check if the body is needed -- First look at each spec, check if the body is needed
loop loop

View File

@ -98,7 +98,7 @@ package body System.Bignums is
procedure Free_Bignum (X : Bignum) is null; procedure Free_Bignum (X : Bignum) is null;
-- Called to free a Bignum value used in intermediate computations. In -- Called to free a Bignum value used in intermediate computations. In
-- this implementation using the secondary stack, does nothing at all, -- this implementation using the secondary stack, it does nothing at all,
-- because we rely on Mark/Release, but it may be of use for some -- because we rely on Mark/Release, but it may be of use for some
-- alternative implementation. -- alternative implementation.
@ -115,12 +115,12 @@ package body System.Bignums is
function Add (X, Y : Digit_Vector; X_Neg, Y_Neg : Boolean) return Bignum is function Add (X, Y : Digit_Vector; X_Neg, Y_Neg : Boolean) return Bignum is
begin begin
-- If signs are the same we are doing an addition, it is convenient to -- If signs are the same, we are doing an addition, it is convenient to
-- ensure that the first operand is the longer of the two, -- ensure that the first operand is the longer of the two.
if X_Neg = Y_Neg then if X_Neg = Y_Neg then
if X'Last < Y'Last then if X'Last < Y'Last then
return Add (Y => X, X => Y, X_Neg => Y_Neg, Y_Neg => X_Neg); return Add (X => Y, Y => X, X_Neg => Y_Neg, Y_Neg => X_Neg);
-- Here signs are the same, and the first operand is the longer -- Here signs are the same, and the first operand is the longer
@ -151,9 +151,9 @@ package body System.Bignums is
end; end;
end if; end if;
-- Signs are different so really this is an subtraction, we want to -- Signs are different so really this is a subtraction, we want to make
-- make sure that the largest magnitude operand is the first one, and -- sure that the largest magnitude operand is the first one, and then
-- then the result will have the sign of the first operand. -- the result will have the sign of the first operand.
else else
declare declare
@ -164,7 +164,7 @@ package body System.Bignums is
return Normalize (Zero_Data); return Normalize (Zero_Data);
elsif CR = LT then elsif CR = LT then
return Add (Y => X, X => Y, X_Neg => Y_Neg, Y_Neg => X_Neg); return Add (X => Y, Y => X, X_Neg => Y_Neg, Y_Neg => X_Neg);
else else
pragma Assert (X_Neg /= Y_Neg and then CR = GT); pragma Assert (X_Neg /= Y_Neg and then CR = GT);
@ -173,7 +173,7 @@ package body System.Bignums is
declare declare
Diff : Digit_Vector (1 .. X'Length); Diff : Digit_Vector (1 .. X'Length);
RD : DD; RD : DD;
begin begin
RD := 0; RD := 0;
@ -401,7 +401,7 @@ package body System.Bignums is
-- Big_EQ -- -- Big_EQ --
------------ ------------
function Big_EQ (X, Y : Bignum) return Boolean is function Big_EQ (X, Y : Bignum) return Boolean is
begin begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) = EQ; return Compare (X.D, Y.D, X.Neg, Y.Neg) = EQ;
end Big_EQ; end Big_EQ;
@ -410,7 +410,7 @@ package body System.Bignums is
-- Big_GE -- -- Big_GE --
------------ ------------
function Big_GE (X, Y : Bignum) return Boolean is function Big_GE (X, Y : Bignum) return Boolean is
begin begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) /= LT; return Compare (X.D, Y.D, X.Neg, Y.Neg) /= LT;
end Big_GE; end Big_GE;
@ -419,7 +419,7 @@ package body System.Bignums is
-- Big_GT -- -- Big_GT --
------------ ------------
function Big_GT (X, Y : Bignum) return Boolean is function Big_GT (X, Y : Bignum) return Boolean is
begin begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) = GT; return Compare (X.D, Y.D, X.Neg, Y.Neg) = GT;
end Big_GT; end Big_GT;
@ -428,7 +428,7 @@ package body System.Bignums is
-- Big_LE -- -- Big_LE --
------------ ------------
function Big_LE (X, Y : Bignum) return Boolean is function Big_LE (X, Y : Bignum) return Boolean is
begin begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) /= GT; return Compare (X.D, Y.D, X.Neg, Y.Neg) /= GT;
end Big_LE; end Big_LE;
@ -437,7 +437,7 @@ package body System.Bignums is
-- Big_LT -- -- Big_LT --
------------ ------------
function Big_LT (X, Y : Bignum) return Boolean is function Big_LT (X, Y : Bignum) return Boolean is
begin begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) = LT; return Compare (X.D, Y.D, X.Neg, Y.Neg) = LT;
end Big_LT; end Big_LT;
@ -465,7 +465,7 @@ package body System.Bignums is
-- 13 -5 -2 3 -13 -5 -3 -3 -- 13 -5 -2 3 -13 -5 -3 -3
-- 14 -5 -1 4 -14 -5 -4 -4 -- 14 -5 -1 4 -14 -5 -4 -4
function Big_Mod (X, Y : Bignum) return Bignum is function Big_Mod (X, Y : Bignum) return Bignum is
Q, R : Bignum; Q, R : Bignum;
begin begin
@ -474,7 +474,7 @@ package body System.Bignums is
if X.Neg = Y.Neg then if X.Neg = Y.Neg then
return Big_Rem (X, Y); return Big_Rem (X, Y);
-- Case where mod is different -- Case where Mod is different
else else
-- Do division -- Do division
@ -546,7 +546,7 @@ package body System.Bignums is
-- Big_NE -- -- Big_NE --
------------ ------------
function Big_NE (X, Y : Bignum) return Boolean is function Big_NE (X, Y : Bignum) return Boolean is
begin begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) /= EQ; return Compare (X.D, Y.D, X.Neg, Y.Neg) /= EQ;
end Big_NE; end Big_NE;
@ -583,11 +583,11 @@ package body System.Bignums is
-- 13 -5 3 -13 -5 -3 -- 13 -5 3 -13 -5 -3
-- 14 -5 4 -14 -5 -4 -- 14 -5 4 -14 -5 -4
function Big_Rem (X, Y : Bignum) return Bignum is function Big_Rem (X, Y : Bignum) return Bignum is
Q, R : Bignum; Q, R : Bignum;
begin begin
Div_Rem (X, Y, Q, R, Discard_Quotient => True); Div_Rem (X, Y, Q, R, Discard_Quotient => True);
R.Neg := R.Len > 0 and then X.Neg; R.Neg := R.Len > 0 and then X.Neg;
return R; return R;
end Big_Rem; end Big_Rem;
@ -665,10 +665,10 @@ package body System.Bignums is
if Compare (X.D, Y.D, False, False) = LT then if Compare (X.D, Y.D, False, False) = LT then
Remainder := Normalize (X.D); Remainder := Normalize (X.D);
Quotient := Normalize (Zero_Data); Quotient := Normalize (Zero_Data);
return; return;
-- If both X and Y are comfortably less than 2**63-1 we can just use -- If both X and Y are comfortably less than 2**63-1, we can just use
-- Long_Long_Integer arithmetic. Note it is good not to do an accurate -- Long_Long_Integer arithmetic. Note it is good not to do an accurate
-- range check here since -2**63 / -1 overflows! -- range check here since -2**63 / -1 overflows!
@ -703,7 +703,7 @@ package body System.Bignums is
ND := ND rem Div; ND := ND rem Div;
end loop; end loop;
Quotient := Normalize (Result); Quotient := Normalize (Result);
Remdr (1) := SD (ND); Remdr (1) := SD (ND);
Remainder := Normalize (Remdr); Remainder := Normalize (Remdr);
return; return;
@ -1007,7 +1007,7 @@ package body System.Bignums is
end loop; end loop;
B := Allocate_Bignum (X'Last - J + 1); B := Allocate_Bignum (X'Last - J + 1);
B.Neg := B.Len > 0 and then Neg; B.Neg := B.Len > 0 and then Neg;
B.D := X (J .. X'Last); B.D := X (J .. X'Last);
return B; return B;
end Normalize; end Normalize;

View File

@ -5027,9 +5027,8 @@ package body Sem_Ch8 is
if Ada_Version >= Ada_2012 if Ada_Version >= Ada_2012
and then and then
(Nkind (Parent (N)) in N_Subexpr (Nkind (Parent (N)) in N_Subexpr
or else or else Nkind_In (Parent (N), N_Object_Declaration,
Nkind_In (Parent (N), N_Object_Declaration, N_Assignment_Statement))
N_Assignment_Statement))
then then
Check_Implicit_Dereference (N, Etype (E)); Check_Implicit_Dereference (N, Etype (E));
end if; end if;