From f4b049db7028a01ad082f923115e12ade77f917c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 10 Sep 2010 16:52:53 +0200 Subject: [PATCH] [multiple changes] 2010-09-10 Ed Schonberg * sem_ch3.adb (Build_Derived_Private_Type): Mark generated declaration of full view analyzed after analyzing the corresponding record declaration, to prevent spurious name conflicts with original declaration. 2010-09-10 Jerome Lambourg * sem_ch13.adb (Analyze_Attribute_Definition_Clause): In the VM case, just issue a warning, but continue with the normal processing. 2010-09-10 Robert Dewar * exp_attr.adb, prj-nmsc.adb, sem_ch4.adb, sem_res.adb: Minor reformatting. 2010-09-10 Thomas Quinot * exp_dist.adb (Build_From_Any_Call, Build_To_Any_Call, Build_TypeCode_Call): For a subtype inserted for the expansion of a generic actual type, go to the underlying type of the original actual type. 2010-09-10 Ed Schonberg * exp_ch5.adb (Expand_Assign_Array_Loop): In CodePeer mode, place a guard around the increment statement, to prevent an off-by-one-value on the last iteration. From-SVN: r164185 --- gcc/ada/ChangeLog | 30 +++++++++++++++++++++ gcc/ada/exp_attr.adb | 4 ++- gcc/ada/exp_ch5.adb | 62 +++++++++++++++++++++++++++++++++++--------- gcc/ada/exp_dist.adb | 73 ++++++++++++++++++++++++++++++++-------------------- gcc/ada/prj-nmsc.adb | 7 +++-- gcc/ada/sem_ch13.adb | 11 ++++---- gcc/ada/sem_ch3.adb | 10 ++++++- gcc/ada/sem_ch4.adb | 11 ++++---- gcc/ada/sem_res.adb | 3 ++- 9 files changed, 154 insertions(+), 57 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7613795..d093901 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2010-09-10 Ed Schonberg + + * sem_ch3.adb (Build_Derived_Private_Type): Mark generated declaration + of full view analyzed after analyzing the corresponding record + declaration, to prevent spurious name conflicts with original + declaration. + +2010-09-10 Jerome Lambourg + + * sem_ch13.adb (Analyze_Attribute_Definition_Clause): In the VM case, + just issue a warning, but continue with the normal processing. + +2010-09-10 Robert Dewar + + * exp_attr.adb, prj-nmsc.adb, sem_ch4.adb, sem_res.adb: Minor + reformatting. + +2010-09-10 Thomas Quinot + + * exp_dist.adb (Build_From_Any_Call, Build_To_Any_Call, + Build_TypeCode_Call): For a subtype inserted for the expansion of a + generic actual type, go to the underlying type of the original actual + type. + +2010-09-10 Ed Schonberg + + * exp_ch5.adb (Expand_Assign_Array_Loop): In CodePeer mode, place a + guard around the increment statement, to prevent an off-by-one-value + on the last iteration. + 2010-09-10 Vincent Celier * sem_aggr.adb, exp_prag.adb, sem_ch3.adb, exp_attr.adb, diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index b949447..ab48159 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -5519,9 +5519,11 @@ package body Exp_Attr is -- the compiler will generate in-place stream routines for string types -- that appear in GNAT's library, but will generate calls via rtsfind -- to library routines for user code. + -- ??? For now, disable this code for JVM, since this generates a -- VerifyError exception at run time on e.g. c330001. - -- This is disabled for AAMP, to avoid making dependences on files not + + -- This is disabled for AAMP, to avoid creating dependences on files not -- supported in the AAMP library (such as s-fileio.adb). if VM_Target /= JVM_Target diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 71b58ae..ec37bf5 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1007,6 +1007,55 @@ package body Exp_Ch5 is F_Or_L : Name_Id; S_Or_P : Name_Id; + function Build_Step (J : Nat) return Node_Id; + -- Note that on the last iteration of the loop, the index is increased + -- past the upper bound. This is consistent with the C semantics of the + -- back-end, where such an off-by-one value on a dead variable is OK. + -- However, in CodePeer mode this leads to spurious warnings, and thus + -- we place a guard around the attribute reference. + + ---------------- + -- Build_Step -- + ---------------- + + function Build_Step (J : Nat) return Node_Id is + Step : Node_Id; + Lim : Name_Id; + + begin + if Rev then + Lim := Name_First; + else + Lim := Name_Last; + end if; + + Step := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Rnn (J), Loc), + Expression => + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (R_Index_Type (J), Loc), + Attribute_Name => S_Or_P, + Expressions => New_List ( + New_Occurrence_Of (Rnn (J), Loc)))); + + if CodePeer_Mode then + Step := + Make_If_Statement (Loc, + Condition => + Make_Op_Ne (Loc, + Left_Opnd => New_Occurrence_Of (Lnn (J), Loc), + Right_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (L_Index_Type (J), Loc), + Attribute_Name => Lim)), + Then_Statements => New_List (Step)); + end if; + + return Step; + end Build_Step; + begin if Rev then F_Or_L := Name_Last; @@ -1103,18 +1152,7 @@ package body Exp_Ch5 is Discrete_Subtype_Definition => New_Reference_To (L_Index_Type (J), Loc))), - Statements => New_List ( - Assign, - - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Rnn (J), Loc), - Expression => - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (R_Index_Type (J), Loc), - Attribute_Name => S_Or_P, - Expressions => New_List ( - New_Occurrence_Of (Rnn (J), Loc))))))))); + Statements => New_List (Assign, Build_Step (J)))))); end loop; return Assign; diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 29aab34..6f23a83 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -8427,6 +8427,15 @@ package body Exp_Dist is Fnam := Find_Inherited_TSS (U_Type, TSS_From_Any); + -- For the subtype representing a generic actual type, go to the + -- actual type. + + if Is_Generic_Actual_Type (U_Type) then + U_Type := Underlying_Type (Base_Type (U_Type)); + end if; + + -- For a standard subtype, go to the base type + if Sloc (U_Type) <= Standard_Location then U_Type := Base_Type (U_Type); end if; @@ -8516,13 +8525,6 @@ package body Exp_Dist is Decl : Entity_Id; begin - -- For the subtype representing a generic actual type, go - -- to the base type. - - if Is_Generic_Actual_Type (U_Type) then - U_Type := Base_Type (U_Type); - end if; - Build_From_Any_Function (Loc, U_Type, Decl, Fnam); Append_To (Decls, Decl); end; @@ -9240,12 +9242,14 @@ package body Exp_Dist is Fnam := Find_Inherited_TSS (U_Type, TSS_To_Any); - -- Check first for Boolean and Character. These are enumeration - -- types, but we treat them specially, since they may require - -- special handling in the transfer protocol. However, this - -- special handling only applies if they have standard - -- representation, otherwise they are treated like any other - -- enumeration type. + -- For the subtype representing a generic actual type, go to the + -- actual type. + + if Is_Generic_Actual_Type (U_Type) then + U_Type := Underlying_Type (Base_Type (U_Type)); + end if; + + -- For a standard subtype, go to the base type if Sloc (U_Type) <= Standard_Location then U_Type := Base_Type (U_Type); @@ -9254,6 +9258,13 @@ package body Exp_Dist is if Present (Fnam) then null; + -- Check first for Boolean and Character. These are enumeration + -- types, but we treat them specially, since they may require + -- special handling in the transfer protocol. However, this + -- special handling only applies if they have standard + -- representation, otherwise they are treated like any other + -- enumeration type. + elsif U_Type = Standard_Boolean then Lib_RE := RE_TA_B; @@ -9380,14 +9391,11 @@ package body Exp_Dist is Decls : constant List_Id := New_List; Stms : constant List_Id := New_List; - Expr_Parameter : constant Entity_Id := - Make_Defining_Identifier (Loc, Name_E); - - Any : constant Entity_Id := - Make_Defining_Identifier (Loc, Name_A); + Expr_Parameter : Entity_Id; + Any : Entity_Id; + Result_TC : Node_Id; Any_Decl : Node_Id; - Result_TC : Node_Id := Build_TypeCode_Call (Loc, Typ, Decls); Use_Opaque_Representation : Boolean; -- When True, use stream attributes and represent type as an @@ -9402,12 +9410,16 @@ package body Exp_Dist is if Is_Itype (Typ) and then Typ /= Base_Type (Typ) then Build_To_Any_Function (Loc => Loc, - Typ => Etype (Typ), - Decl => Decl, - Fnam => Fnam); + Typ => Etype (Typ), + Decl => Decl, + Fnam => Fnam); return; end if; + Expr_Parameter := Make_Defining_Identifier (Loc, Name_E); + Any := Make_Defining_Identifier (Loc, Name_A); + Result_TC := Build_TypeCode_Call (Loc, Typ, Decls); + Fnam := Make_Helper_Function_Name (Loc, Typ, Name_To_Any); Spec := @@ -10017,15 +10029,20 @@ package body Exp_Dist is Fnam := Find_Inherited_TSS (U_Type, TSS_TypeCode); end if; - if No (Fnam) then - if Sloc (U_Type) <= Standard_Location then + -- For the subtype representing a generic actual type, go to the + -- actual type. - -- Do not try to build alias typecodes for subtypes from - -- Standard. + if Is_Generic_Actual_Type (U_Type) then + U_Type := Underlying_Type (Base_Type (U_Type)); + end if; - U_Type := Base_Type (U_Type); - end if; + -- For a standard subtype, go to the base type + if Sloc (U_Type) <= Standard_Location then + U_Type := Base_Type (U_Type); + end if; + + if No (Fnam) then if U_Type = Standard_Boolean then Lib_RE := RE_TC_B; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 4729ef6..af9a622 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -5220,6 +5220,7 @@ package body Prj.Nmsc is end if; if not Has_Error then + -- We have an existing directory, we register it and all of -- its subdirectories. @@ -5263,8 +5264,10 @@ package body Prj.Nmsc is end if; if not Has_Error then - -- links have been resolved if necessary, and Path_Name - -- always ends with a directory separator + + -- Links have been resolved if necessary, and Path_Name + -- always ends with a directory separator. + Add_To_Or_Remove_From_Source_Dirs (Path_Id => Path_Name.Name, Display_Path_Id => Path_Name.Display_Name, diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index f6d10e4..45453e65 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1532,17 +1532,16 @@ package body Sem_Ch13 is Error_Msg_N ("size cannot be given for unconstrained array", Nam); - elsif VM_Target /= No_VM then - - -- Size clauses are ignored for VM targets. Display a warning - -- unless we are in GNAT mode, in which case this is useless. + elsif Size /= No_Uint then - if not GNAT_Mode then + if VM_Target /= No_VM and then not GNAT_Mode then + -- Size clause is not handled properly on VM targets. + -- Display a warning unless we are in GNAT mode, in which + -- case this is useless. Error_Msg_N ("?size clauses are ignored in this configuration", N); end if; - elsif Size /= No_Uint then if Is_Type (U_Ent) then Etyp := U_Ent; else diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 43931b6..9662357 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5843,6 +5843,7 @@ package body Sem_Ch3 is Full_Der := New_Copy (Derived_Type); Set_Comes_From_Source (Full_Decl, False); Set_Comes_From_Source (Full_Der, False); + Set_Parent (Full_Der, Full_Decl); Insert_After (N, Full_Decl); @@ -5916,9 +5917,16 @@ package body Sem_Ch3 is Set_Defining_Identifier (Full_Decl, Full_Der); Build_Derived_Record_Type (Full_Decl, Parent_Type, Full_Der, Derive_Subps); - Set_Analyzed (Full_Decl); end if; + -- The full declaration has been introduced into the tree and + -- processed in the step above. It should not be analyzed again + -- (when encountered later in the current list of declarations) + -- to prevent spurious name conflicts. The full entity remains + -- invisible. + + Set_Analyzed (Full_Decl); + if Swapped then Uninstall_Declarations (Par_Scope); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ca4b051..4ba25d0 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3941,12 +3941,11 @@ package body Sem_Ch4 is else if Ekind (Prefix_Type) = E_Record_Subtype then - -- Check whether this is a component of the base type - -- which is absent from a statically constrained subtype. - -- This will raise constraint error at run time, but is - -- not a compile-time error. When the selector is illegal - -- for base type as well fall through and generate a - -- compilation error anyway. + -- Check whether this is a component of the base type which + -- is absent from a statically constrained subtype. This will + -- raise constraint error at run time, but is not a compile- + -- time error. When the selector is illegal for base type as + -- well fall through and generate a compilation error anyway. Comp := First_Component (Base_Type (Prefix_Type)); while Present (Comp) loop diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index efc0c18..7cca8ab 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -68,7 +68,7 @@ with Sem_Util; use Sem_Util; with Sem_Type; use Sem_Type; with Sem_Warn; use Sem_Warn; with Sinfo; use Sinfo; -with Sinfo.CN; use Sinfo.CN; +with Sinfo.CN; use Sinfo.CN; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; @@ -1066,6 +1066,7 @@ package body Sem_Res is -- Rewrite as call if overloadable entity that is (or could be, in the -- overloaded case) a function call. If we know for sure that the entity -- is an enumeration literal, we do not rewrite it. + -- If the entity is the name of an operator, it cannot be a call because -- operators cannot have default parameters. In this case, this must be -- a string whose contents coincide with an operator name. Set the kind -- 2.7.4