re PR ada/17540 (Duplicate symbols while building Ada)
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. From-SVN: r87936
This commit is contained in:
Robert Dewar
Arnaud Charlet
parent
f8d1c4278b
commit
2c9beb8a81
@ -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
|
||||
|
||||
@ -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]
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user