[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:
parent
27dd0dde2d
commit
7353413840
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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;
|
||||||
|
|
|
@ -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;
|
||||||
|
|
Loading…
Reference in New Issue