diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ac3238876ab..b50ef17dcc0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2012-10-02 Robert Dewar + + * sem_ch8.adb: Minor reformatting. + +2012-10-02 Javier Miranda + + * exp_disp.adb (Set_CPP_Constructors): Handle constructor with default + parameters that covers the default constructor. + +2012-10-02 Yannick Moy + + * s-bignum.adb: Minor stylistic and comment corrections. + +2012-10-02 Pascal Obry + + * prj-util.adb (For_Interface_Sources): Iterate over all sources in + aggregate library projects. + 2012-10-02 Ed Schonberg * sem_ch8.adb (Find_Direct_Name): The left-hand side of an diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index d5861b47807..53ef628f89b 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -8537,6 +8537,10 @@ package body Exp_Disp is Body_Stmts : List_Id; Init_Tags_List : List_Id; + Covers_Default_Constructor : Entity_Id := Empty; + + -- Start of processing for Set_CPP_Constructor + begin pragma Assert (Is_CPP_Class (Typ)); @@ -8622,7 +8626,9 @@ package body Exp_Disp is Defining_Identifier => Make_Defining_Identifier (Loc, 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); end loop; end if; @@ -8713,6 +8719,17 @@ package body Exp_Disp is Discard_Node (Wrapper_Body_Node); 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; Next_Entity (E); @@ -8725,6 +8742,46 @@ package body Exp_Disp is 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 + 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 -- C++ constructor. It is required for default initialization of objects -- of the type. It is also required to elaborate objects of Ada types diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index 1ad1aff58a7..2c70d1feeac 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.adb @@ -439,7 +439,7 @@ package body Prj.Util is -- Local declarations - Iter : Source_Iterator := For_Each_Source (Tree, Project); + Iter : Source_Iterator; Sid : Source_Id; ALI : ALI_Id; @@ -451,6 +451,12 @@ package body Prj.Util is -- Start of processing for For_Interface_Sources 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 loop diff --git a/gcc/ada/s-bignum.adb b/gcc/ada/s-bignum.adb index 39cae8a8659..41c0aa98636 100644 --- a/gcc/ada/s-bignum.adb +++ b/gcc/ada/s-bignum.adb @@ -98,7 +98,7 @@ package body System.Bignums is procedure Free_Bignum (X : Bignum) is null; -- 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 -- 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 begin - -- 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, + -- 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. if X_Neg = Y_Neg 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 @@ -151,9 +151,9 @@ package body System.Bignums is end; end if; - -- Signs are different so really this is an subtraction, we want to - -- make sure that the largest magnitude operand is the first one, and - -- then the result will have the sign of the first operand. + -- Signs are different so really this is a subtraction, we want to make + -- sure that the largest magnitude operand is the first one, and then + -- the result will have the sign of the first operand. else declare @@ -164,7 +164,7 @@ package body System.Bignums is return Normalize (Zero_Data); 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 pragma Assert (X_Neg /= Y_Neg and then CR = GT); @@ -173,7 +173,7 @@ package body System.Bignums is declare Diff : Digit_Vector (1 .. X'Length); - RD : DD; + RD : DD; begin RD := 0; @@ -401,7 +401,7 @@ package body System.Bignums is -- Big_EQ -- ------------ - function Big_EQ (X, Y : Bignum) return Boolean is + function Big_EQ (X, Y : Bignum) return Boolean is begin return Compare (X.D, Y.D, X.Neg, Y.Neg) = EQ; end Big_EQ; @@ -410,7 +410,7 @@ package body System.Bignums is -- Big_GE -- ------------ - function Big_GE (X, Y : Bignum) return Boolean is + function Big_GE (X, Y : Bignum) return Boolean is begin return Compare (X.D, Y.D, X.Neg, Y.Neg) /= LT; end Big_GE; @@ -419,7 +419,7 @@ package body System.Bignums is -- Big_GT -- ------------ - function Big_GT (X, Y : Bignum) return Boolean is + function Big_GT (X, Y : Bignum) return Boolean is begin return Compare (X.D, Y.D, X.Neg, Y.Neg) = GT; end Big_GT; @@ -428,7 +428,7 @@ package body System.Bignums is -- Big_LE -- ------------ - function Big_LE (X, Y : Bignum) return Boolean is + function Big_LE (X, Y : Bignum) return Boolean is begin return Compare (X.D, Y.D, X.Neg, Y.Neg) /= GT; end Big_LE; @@ -437,7 +437,7 @@ package body System.Bignums is -- Big_LT -- ------------ - function Big_LT (X, Y : Bignum) return Boolean is + function Big_LT (X, Y : Bignum) return Boolean is begin return Compare (X.D, Y.D, X.Neg, Y.Neg) = LT; end Big_LT; @@ -465,7 +465,7 @@ package body System.Bignums is -- 13 -5 -2 3 -13 -5 -3 -3 -- 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; begin @@ -474,7 +474,7 @@ package body System.Bignums is if X.Neg = Y.Neg then return Big_Rem (X, Y); - -- Case where mod is different + -- Case where Mod is different else -- Do division @@ -546,7 +546,7 @@ package body System.Bignums is -- Big_NE -- ------------ - function Big_NE (X, Y : Bignum) return Boolean is + function Big_NE (X, Y : Bignum) return Boolean is begin return Compare (X.D, Y.D, X.Neg, Y.Neg) /= EQ; end Big_NE; @@ -583,11 +583,11 @@ package body System.Bignums is -- 13 -5 3 -13 -5 -3 -- 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; begin 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; end Big_Rem; @@ -665,10 +665,10 @@ package body System.Bignums is if Compare (X.D, Y.D, False, False) = LT then Remainder := Normalize (X.D); - Quotient := Normalize (Zero_Data); + Quotient := Normalize (Zero_Data); 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 -- range check here since -2**63 / -1 overflows! @@ -703,7 +703,7 @@ package body System.Bignums is ND := ND rem Div; end loop; - Quotient := Normalize (Result); + Quotient := Normalize (Result); Remdr (1) := SD (ND); Remainder := Normalize (Remdr); return; @@ -1007,7 +1007,7 @@ package body System.Bignums is end loop; 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); return B; end Normalize; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index db47b4a3e74..ec94ed627f8 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -5027,9 +5027,8 @@ package body Sem_Ch8 is if Ada_Version >= Ada_2012 and then (Nkind (Parent (N)) in N_Subexpr - or else - Nkind_In (Parent (N), N_Object_Declaration, - N_Assignment_Statement)) + or else Nkind_In (Parent (N), N_Object_Declaration, + N_Assignment_Statement)) then Check_Implicit_Dereference (N, Etype (E)); end if;