From 2c9beb8a814141d774eb69ce9d1d088280a4ab6b Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Thu, 23 Sep 2004 09:00:08 +0000 Subject: [PATCH] re PR ada/17540 (Duplicate symbols while building Ada) 2004-09-23 Robert Dewar PR ada/17540 * sem_prag.adb (Process_Import_Or_Interface): Don't set Is_Public here, instead do this at freeze time (we won't do it if there is an address clause). Change "pragma inline" to "pragma Inline" in information and error messages. Minor reformatting. * freeze.adb (Check_Address_Clause): Remove previous change, not the right way of doing things after all. (Freeze_Entity): For object, set Is_Public for imported entities unless there is an address clause present. From-SVN: r87936 --- gcc/ada/ChangeLog | 16 +++++++++++++ gcc/ada/freeze.adb | 38 +++++++++++++++++++++---------- gcc/ada/sem_prag.adb | 53 +++++++++++++++++++++++++++++++------------- 3 files changed, 79 insertions(+), 28 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ca0256667f4..3b042591110 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2004-09-23 Robert Dewar + + PR ada/17540 + + * sem_prag.adb (Process_Import_Or_Interface): Don't set Is_Public here, + instead do this at freeze time (we won't do it if there is an address + clause). + Change "pragma inline" to "pragma Inline" in information and error + messages. + Minor reformatting. + + * freeze.adb (Check_Address_Clause): Remove previous change, not the + right way of doing things after all. + (Freeze_Entity): For object, set Is_Public for imported entities + unless there is an address clause present. + 2004-09-21 Olivier Hainque * decl.c (gnat_to_gnu_entity) : Check for a diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index e58a987d899..1623b41f7b0 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -82,9 +82,7 @@ package body Freeze is procedure Check_Address_Clause (E : Entity_Id); -- Apply legality checks to address clauses for object declarations, - -- at the point the object is frozen. Also deals with cancelling effect - -- of Import pragma which has no effect (other than to eliminate any - -- implicit initialization) if an address clause is present. + -- at the point the object is frozen. procedure Check_Strict_Alignment (E : Entity_Id); -- E is a base type. If E is tagged or has a component that is aliased @@ -499,11 +497,6 @@ package body Freeze is then Warn_Overlay (Expr, Typ, Name (Addr)); end if; - - -- Cancel effect of any Import pragma - - Set_Is_Imported (E, False); - Set_Is_Public (E, False); end if; end Check_Address_Clause; @@ -2198,14 +2191,35 @@ package body Freeze is Freeze_And_Append (Etype (E), Loc, Result); end if; - -- For object created by object declaration, perform required - -- categorization (preelaborate and pure) checks. Defer these - -- checks to freeze time since pragma Import inhibits default - -- initialization and thus pragma Import affects these checks. + -- Special processing for objects created by object declaration if Nkind (Declaration_Node (E)) = N_Object_Declaration then + + -- For object created by object declaration, perform required + -- categorization (preelaborate and pure) checks. Defer these + -- checks to freeze time since pragma Import inhibits default + -- initialization and thus pragma Import affects these checks. + Validate_Object_Declaration (Declaration_Node (E)); + + -- If there is an address clause, check it is valid + Check_Address_Clause (E); + + -- For imported objects, set Is_Public unless there is also + -- an address clause, which means that there is no external + -- symbol needed for the Import (Is_Public may still be set + -- for other unrelated reasons). Note that we delayed this + -- processing till freeze time so that we can be sure not + -- to set the flag if there is an address clause. If there + -- is such a clause, then the only purpose of the import + -- pragma is to suppress implicit initialization. + + if Is_Imported (E) + and then not Present (Address_Clause (E)) + then + Set_Is_Public (E); + end if; end if; -- Check that a constant which has a pragma Volatile[_Components] diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 6fd97d8a269..ae4aa108d5e 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -922,7 +922,6 @@ package body Sem_Prag is begin if Arg_Count > N then Arg := Arg1; - for J in 1 .. N loop Next (Arg); Error_Pragma_Arg ("too many arguments for pragma%", Arg); @@ -1608,7 +1607,6 @@ package body Sem_Prag is -- Otherwise first deal with any positional parameters present Arg := First (Pragma_Argument_Associations (N)); - for Index in Args'Range loop exit when No (Arg) or else Chars (Arg) /= No_Name; Args (Index) := Expression (Arg); @@ -2720,6 +2718,7 @@ package body Sem_Prag is -- Deal with positional ones first Formal := First_Formal (Ent); + if Present (Expressions (Arg_Mechanism)) then Mname := First (Expressions (Arg_Mechanism)); @@ -2900,9 +2899,13 @@ package body Sem_Prag is else Set_Imported (Def_Id); - Set_Is_Public (Def_Id); Process_Interface_Name (Def_Id, Arg3, Arg4); + -- Note that we do not set Is_Public here. That's because we + -- only want to set if if there is no address clause, and we + -- don't know that yet, so we delay that processing till + -- freeze time. + -- pragma Import completes deferred constants if Ekind (Def_Id) = E_Constant then @@ -2959,8 +2962,8 @@ package body Sem_Prag is else Set_Imported (Def_Id); - -- If Import intrinsic, set intrinsic flag - -- and verify that it is known as such. + -- If Import intrinsic, set intrinsic flag and verify + -- that it is known as such. if C = Convention_Intrinsic then Set_Is_Intrinsic_Subprogram (Def_Id); @@ -2968,9 +2971,9 @@ package body Sem_Prag is (Def_Id, Expression (Arg2)); end if; - -- All interfaced procedures need an external - -- symbol created for them since they are - -- always referenced from another object file. + -- All interfaced procedures need an external symbol + -- created for them since they are always referenced + -- from another object file. Set_Is_Public (Def_Id); @@ -3271,7 +3274,7 @@ package body Sem_Prag is elsif not Effective and then Warn_On_Redundant_Constructs then - Error_Msg_NE ("pragma inline on& is redundant?", + Error_Msg_NE ("pragma Inline for& is redundant?", N, Entity (Subp_Id)); end if; @@ -3298,6 +3301,10 @@ package body Sem_Prag is -- particular that no spaces or other obviously incorrect characters -- appear. This is only a warning, since any characters are allowed. + ---------------------------------- + -- Check_Form_Of_Interface_Name -- + ---------------------------------- + procedure Check_Form_Of_Interface_Name (SN : Node_Id) is S : constant String_Id := Strval (Expr_Value_S (SN)); SL : constant Nat := String_Length (S); @@ -3834,13 +3841,17 @@ package body Sem_Prag is -- Import or Export pragma), then the external names must match if Present (Interface_Name (Internal_Ent)) then - declare + Check_Matching_Internal_Names : declare S1 : constant String_Id := Strval (Old_Name); S2 : constant String_Id := Strval (New_Name); procedure Mismatch; -- Called if names do not match + -------------- + -- Mismatch -- + -------------- + procedure Mismatch is begin Error_Msg_Sloc := Sloc (Old_Name); @@ -3849,6 +3860,8 @@ package body Sem_Prag is Arg_External); end Mismatch; + -- Start of processing for Check_Matching_Internal_Names + begin if String_Length (S1) /= String_Length (S2) then Mismatch; @@ -3860,7 +3873,7 @@ package body Sem_Prag is end if; end loop; end if; - end; + end Check_Matching_Internal_Names; -- Otherwise set the given name @@ -3924,11 +3937,19 @@ package body Sem_Prag is procedure Bad_Mechanism; -- Signal bad mechanism name + --------------- + -- Bad_Class -- + --------------- + procedure Bad_Class is begin Error_Pragma_Arg ("unrecognized descriptor class name", Class); end Bad_Class; + ------------------------- + -- Bad_Mechanism_Value -- + ------------------------- + procedure Bad_Mechanism is begin Error_Pragma_Arg ("unrecognized mechanism name", Mech_Name); @@ -6208,9 +6229,7 @@ package body Sem_Prag is -- UPPERCASE | LOWERCASE -- [, AS_IS | UPPERCASE | LOWERCASE]); - when Pragma_External_Name_Casing => - - External_Name_Casing : declare + when Pragma_External_Name_Casing => External_Name_Casing : declare begin GNAT_Pragma; Check_No_Identifiers; @@ -10584,6 +10603,10 @@ package body Sem_Prag is -- Stores encoded value of character code CC. The encoding we -- use an underscore followed by four lower case hex digits. + ------------ + -- Encode -- + ------------ + procedure Encode is begin Store_String_Char (Get_Char_Code ('_')); @@ -10686,7 +10709,6 @@ package body Sem_Prag is Pref := Prefix (N); Scop := Scope (Entity (N)); - while Nkind (Pref) = N_Selected_Component loop Change_Selected_Component_To_Expanded_Name (Pref); Set_Entity (Selector_Name (Pref), Scop); @@ -10698,5 +10720,4 @@ package body Sem_Prag is Set_Entity (Pref, Scop); end if; end Set_Unit_Name; - end Sem_Prag;