2005-09-01 Thomas Quinot <quinot@adacore.com>

	* exp_dist.adb (Add_RACW_TypeCode, Add_RAS_TypeCode): Do not generate
	dummy access formal for RACW/RAS TypeCode TSS.
	(Build_TypeCode_Call): Do not generate dummy null access actual for
	calls to the TypeCode TSS.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103863 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index b3801f6..d0e016d 100644 (file)
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -483,7 +483,7 @@ package body Exp_Dist is
    --    Is_Known_Async... : True if we know that this is asynchronous
    --    Is_Known_Non_A... : True if we know that this is not asynchronous
    --    Spec              : a node with a Parameter_Specifications and
-   --                        a Subtype_Mark if applicable
+   --                        a Result_Definition if applicable
    --    Stub_Type         : in case of RACW stubs, parameters of type access
    --                        to Stub_Type will be marshalled using the
    --                        address of the object (the addr field) rather
@@ -1480,13 +1480,13 @@ package body Exp_Dist is
            Make_Function_Specification (Loc,
              Defining_Unit_Name       => Proc,
              Parameter_Specifications => Param_Specs,
-             Subtype_Mark             =>
+             Result_Definition        =>
                New_Occurrence_Of (
-                 Entity (Subtype_Mark (Spec)), Loc));
+                 Entity (Result_Definition (Spec)), Loc));
 
          Set_Ekind (Proc, E_Function);
          Set_Etype (Proc,
-           New_Occurrence_Of (Entity (Subtype_Mark (Spec)), Loc));
+           New_Occurrence_Of (Entity (Result_Definition (Spec)), Loc));
 
       else
          Proc_Spec :=
@@ -2313,8 +2313,8 @@ package body Exp_Dist is
                   Make_Defining_Identifier (Loc,
                     Chars => Name_For_New_Spec),
                 Parameter_Specifications => Parameters,
-                Subtype_Mark             =>
-                  New_Occurrence_Of (Entity (Subtype_Mark (Spec)), Loc));
+                Result_Definition        =>
+                  New_Occurrence_Of (Entity (Result_Definition (Spec)), Loc));
 
          when N_Procedure_Specification | N_Access_Procedure_Definition =>
             return
@@ -3230,7 +3230,7 @@ package body Exp_Dist is
                  Parameter_Type      =>
                    New_Occurrence_Of (Standard_Boolean, Loc))),
 
-            Subtype_Mark =>
+            Result_Definition =>
               New_Occurrence_Of (Fat_Type, Loc));
 
          --  Set the kind and return type of the function to prevent
@@ -3417,7 +3417,7 @@ package body Exp_Dist is
                        True,
                      Parameter_Type =>
                        New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc))),
-                 Subtype_Mark =>
+                 Result_Definition =>
                    New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)));
          Append_To (Decls, Current_Declaration);
          Analyze (Current_Declaration);
@@ -3992,7 +3992,7 @@ package body Exp_Dist is
                        Make_Attribute_Reference (Loc,
                          Prefix         =>
                            New_Occurrence_Of (
-                             Etype (Subtype_Mark (Spec)), Loc),
+                             Etype (Result_Definition (Spec)), Loc),
 
                          Attribute_Name => Name_Input,
 
@@ -4606,7 +4606,7 @@ package body Exp_Dist is
 
             declare
                Etyp   : constant Entity_Id :=
-                          Etype (Subtype_Mark (Specification (Vis_Decl)));
+                          Etype (Result_Definition (Specification (Vis_Decl)));
                Result : constant Node_Id   :=
                           Make_Defining_Identifier (Loc,
                              New_Internal_Name ('R'));
@@ -4873,7 +4873,7 @@ package body Exp_Dist is
           Specification              => Make_Function_Specification (Loc,
             Defining_Unit_Name =>
               Make_Defining_Identifier (Loc, New_Internal_Name ('S')),
-            Subtype_Mark       => New_Occurrence_Of (Var_Type, Loc)),
+            Result_Definition  => New_Occurrence_Of (Var_Type, Loc)),
           Declarations               => No_List,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc, New_List (
@@ -5413,7 +5413,7 @@ package body Exp_Dist is
                    Any_Parameter,
                  Parameter_Type =>
                    New_Occurrence_Of (RTE (RE_Any), Loc))),
-             Subtype_Mark => New_Occurrence_Of (RACW_Type, Loc));
+             Result_Definition => New_Occurrence_Of (RACW_Type, Loc));
 
          --  NOTE: The usage occurrences of RACW_Parameter must
          --  refer to the entity in the declaration spec, not those
@@ -5727,7 +5727,7 @@ package body Exp_Dist is
                    RACW_Parameter,
                  Parameter_Type =>
                    New_Occurrence_Of (RACW_Type, Loc))),
-             Subtype_Mark => New_Occurrence_Of (RTE (RE_Any), Loc));
+             Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
 
          --  NOTE: The usage occurrences of RACW_Parameter must
          --  refer to the entity in the declaration spec, not in
@@ -5771,9 +5771,6 @@ package body Exp_Dist is
          Func_Decl : Node_Id;
          Func_Body : Node_Id;
 
-         RACW_Parameter : constant Entity_Id :=
-                            Make_Defining_Identifier (Loc, Name_R);
-
       begin
          Fnam :=
            Make_Defining_Identifier (Loc,
@@ -5786,15 +5783,7 @@ package body Exp_Dist is
            Make_Function_Specification (Loc,
              Defining_Unit_Name =>
                Fnam,
-             Parameter_Specifications => New_List (
-               Make_Parameter_Specification (Loc,
-                 Defining_Identifier =>
-                   RACW_Parameter,
-                 Parameter_Type =>
-                   Make_Access_Definition (Loc,
-                     Subtype_Mark =>
-                       New_Occurrence_Of (RACW_Type, Loc)))),
-             Subtype_Mark => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
+             Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
 
          --  NOTE: The usage occurrences of RACW_Parameter must
          --  refer to the entity in the declaration spec, not those
@@ -6247,7 +6236,7 @@ package body Exp_Dist is
                  Parameter_Type      =>
                    New_Occurrence_Of (Standard_Boolean, Loc))),
 
-            Subtype_Mark =>
+            Result_Definition =>
               New_Occurrence_Of (Fat_Type, Loc));
 
          --  Set the kind and return type of the function to prevent
@@ -6309,7 +6298,7 @@ package body Exp_Dist is
                    Any_Parameter,
                  Parameter_Type =>
                    New_Occurrence_Of (RTE (RE_Any), Loc))),
-             Subtype_Mark => New_Occurrence_Of (RAS_Type, Loc));
+             Result_Definition => New_Occurrence_Of (RAS_Type, Loc));
 
          Discard_Node (
            Make_Subprogram_Body (Loc,
@@ -6383,7 +6372,7 @@ package body Exp_Dist is
                    RAS_Parameter,
                  Parameter_Type =>
                    New_Occurrence_Of (RAS_Type, Loc))),
-             Subtype_Mark => New_Occurrence_Of (RTE (RE_Any), Loc));
+             Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
 
          Discard_Node (
            Make_Subprogram_Body (Loc,
@@ -6410,25 +6399,12 @@ package body Exp_Dist is
          Decls : constant List_Id := New_List;
          Name_String, Repo_Id_String : String_Id;
 
-         RAS_Parameter : constant Entity_Id :=
-                           Make_Defining_Identifier (Loc, Name_R);
-
       begin
-         --  The spec for this subprogram has a dummy 'access RAS'
-         --  argument, which serves only for overloading purposes.
-
          Func_Spec :=
            Make_Function_Specification (Loc,
              Defining_Unit_Name =>
                Fnam,
-             Parameter_Specifications => New_List (
-               Make_Parameter_Specification (Loc,
-                 Defining_Identifier =>
-                   RAS_Parameter,
-                 Parameter_Type =>
-                   Make_Access_Definition (Loc,
-                     Subtype_Mark => New_Occurrence_Of (RAS_Type, Loc)))),
-             Subtype_Mark => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
+             Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
 
          PolyORB_Support.Helpers.Build_Name_And_Repository_Id
            (RAS_Type, Name_Str => Name_String, Repo_Id_Str => Repo_Id_String);
@@ -7018,7 +6994,7 @@ package body Exp_Dist is
 
          if Is_Function then
             Result_TC := PolyORB_Support.Helpers.Build_TypeCode_Call (Loc,
-              Etype (Subtype_Mark (Spec)), Decls);
+              Etype (Result_Definition (Spec)), Decls);
          else
             Result_TC := New_Occurrence_Of (RTE (RE_TC_Void), Loc);
          end if;
@@ -7315,7 +7291,7 @@ package body Exp_Dist is
                  Make_Tag_Check (Loc,
                    Make_Return_Statement (Loc,
                      PolyORB_Support.Helpers.Build_From_Any_Call (
-                         Etype (Subtype_Mark (Spec)),
+                         Etype (Result_Definition (Spec)),
                          Make_Selected_Component (Loc,
                            Prefix        => Result,
                            Selector_Name => Name_Argument),
@@ -7892,7 +7868,7 @@ package body Exp_Dist is
 
             declare
                Etyp   : constant Entity_Id :=
-                          Etype (Subtype_Mark (Specification (Vis_Decl)));
+                          Etype (Result_Definition (Specification (Vis_Decl)));
                Result : constant Node_Id   :=
                           Make_Defining_Identifier (Loc,
                             New_Internal_Name ('R'));
@@ -8271,7 +8247,7 @@ package body Exp_Dist is
                       Any_Parameter,
                     Parameter_Type =>
                       New_Occurrence_Of (RTE (RE_Any), Loc))),
-                Subtype_Mark => New_Occurrence_Of (Typ, Loc));
+                Result_Definition => New_Occurrence_Of (Typ, Loc));
 
             --  The following  is taken care of by Exp_Dist.Add_RACW_From_Any
 
@@ -9062,7 +9038,7 @@ package body Exp_Dist is
                       Expr_Parameter,
                     Parameter_Type =>
                       New_Occurrence_Of (Typ, Loc))),
-                Subtype_Mark => New_Occurrence_Of (RTE (RE_Any), Loc));
+                Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
             Set_Etype (Expr_Parameter, Typ);
 
             Any_Decl :=
@@ -9571,9 +9547,6 @@ package body Exp_Dist is
             --  if Typ is incomplete.
 
             Fnam    : Entity_Id := Empty;
-            Tnam    : Entity_Id := Empty;
-            Pnam    : Entity_Id := Empty;
-            Args    : List_Id := Empty_List;
             Lib_RE  : RE_Id := RE_Null;
 
             Expr : Node_Id;
@@ -9590,43 +9563,6 @@ package body Exp_Dist is
                --  in the type's TSS.
 
                Fnam := Find_Inherited_TSS (U_Type, TSS_TypeCode);
-
-               if Present (Fnam) then
-
-                  --  When a TypeCode TSS exists, it has a single parameter
-                  --  that is an anonymous access to the corresponding type.
-                  --  This parameter is not used in any way; its purpose is
-                  --  solely to provide overloading of the TSS.
-
-                  Tnam :=
-                    Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
-                  Pnam :=
-                    Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
-
-                  Append_To (Decls,
-                    Make_Full_Type_Declaration (Loc,
-                      Defining_Identifier => Tnam,
-                      Type_Definition =>
-                        Make_Access_To_Object_Definition (Loc,
-                          Subtype_Indication =>
-                            New_Occurrence_Of (U_Type, Loc))));
-                  Append_To (Decls,
-                    Make_Object_Declaration (Loc,
-                      Defining_Identifier => Pnam,
-                      Constant_Present    => True,
-                      Object_Definition   => New_Occurrence_Of (Tnam, Loc),
-
-                     --  Use a variable here to force proper freezing of Tnam
-
-                      Expression          => Make_Null (Loc)));
-
-                  --  Normally, calling _TypeCode with a null access parameter
-                  --  should raise Constraint_Error, but this check is
-                  --  suppressed for expanded code, and we do not care anyway
-                  --  because we do not actually ever use this value.
-
-                  Args := New_List (New_Occurrence_Of (Pnam, Loc));
-               end if;
             end if;
 
             if No (Fnam) then
@@ -9720,9 +9656,7 @@ package body Exp_Dist is
             --  Call the function
 
             Expr :=
-              Make_Function_Call (Loc,
-                Name => New_Occurrence_Of (Fnam, Loc),
-                Parameter_Associations => Args);
+              Make_Function_Call (Loc, Name => New_Occurrence_Of (Fnam, Loc));
 
             --  Allow Expr to be used as arg to Build_To_Any_Call immediately
 
@@ -10089,7 +10023,8 @@ package body Exp_Dist is
               Make_Function_Specification (Loc,
                 Defining_Unit_Name => Fnam,
                 Parameter_Specifications => Empty_List,
-                Subtype_Mark => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
+                Result_Definition =>
+                  New_Occurrence_Of (RTE (RE_TypeCode), Loc));
 
             Build_Name_And_Repository_Id (Typ,
               Name_Str => Type_Name_Str, Repo_Id_Str => Type_Repo_Id_Str);
@@ -10633,7 +10568,7 @@ package body Exp_Dist is
    begin
       if Nkind (Spec) = N_Function_Specification then
          Set_Ekind (Snam, E_Function);
-         Set_Etype (Snam, Entity (Subtype_Mark (Spec)));
+         Set_Etype (Snam, Entity (Result_Definition (Spec)));
       else
          Set_Ekind (Snam, E_Procedure);
          Set_Etype (Snam, Standard_Void_Type);