diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 38 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 53 |
3 files changed, 79 insertions, 28 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ca02566..3b04259 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2004-09-23 Robert Dewar <dewar@gnat.com> + + 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 <hainque@act-europe.fr> * decl.c (gnat_to_gnu_entity) <E_General_Access_Type>: Check for a diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index e58a987..1623b41 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 6fd97d8..ae4aa10 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; |