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

1 files changed, 37 insertions, 16 deletions

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;