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
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;
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]
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);
-- 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);
-- Deal with positional ones first
Formal := First_Formal (Ent);
+
if Present (Expressions (Arg_Mechanism)) then
Mname := First (Expressions (Arg_Mechanism));
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
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);
(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);
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;
-- 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);
-- 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);
Arg_External);
end Mismatch;
+ -- Start of processing for Check_Matching_Internal_Names
+
begin
if String_Length (S1) /= String_Length (S2) then
Mismatch;
end if;
end loop;
end if;
- end;
+ end Check_Matching_Internal_Names;
-- Otherwise set the given name
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);
-- 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;
-- 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 ('_'));
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);
Set_Entity (Pref, Scop);
end if;
end Set_Unit_Name;
-
end Sem_Prag;
OSDN Git Service
