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

gcc/ada/ChangeLog

+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

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]

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;