OSDN Git Service

2009-11-30 Ed Schonberg <schonberg@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 16:24:37 +0000 (16:24 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 16:24:37 +0000 (16:24 +0000)
* exp_ch9.ads (Build_Private_Protected_Declaration): For a protected
operation that is only declared in a protected body, create a
corresponding subprogram declaration.
* exp_ch9.adb (Expand_N_Protected_Body): Create protected body of
operation in all cases, including for an operation that is only
declared in the body.
* sem_ch6.adb: Call Build_Private_Protected_Declaration
* exp_ch6.adb (Expand_N_Subprogram_Declaration): For an operation
declared in a protected body, create the declaration for the
corresponding protected version of the operation.

2009-11-30  Arnaud Charlet  <charlet@adacore.com>

* gnat1drv.adb (Adjust_Global_Switches): Disable specific expansions
for Restrictions pragmas, to avoid tree inconsistencies between
compilations with different pragmas.

2009-11-30  Jerome Lambourg  <lambourg@adacore.com>

* sem_prag.adb (Check_Duplicated_Export_Name): Allow entities exported
to CIL to have duplicated export name.

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

gcc/ada/ChangeLog
gcc/ada/exp_ch6.adb
gcc/ada/exp_ch9.adb
gcc/ada/exp_ch9.ads
gcc/ada/gnat1drv.adb
gcc/ada/sem_ch6.adb
gcc/ada/sem_prag.adb

index ec1dc3c..39b56f0 100644 (file)
@@ -1,3 +1,27 @@
+2009-11-30  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_ch9.ads (Build_Private_Protected_Declaration): For a protected
+       operation that is only declared in a protected body, create a
+       corresponding subprogram declaration.
+       * exp_ch9.adb (Expand_N_Protected_Body): Create protected body of
+       operation in all cases, including for an operation that is only
+       declared in the body.
+       * sem_ch6.adb: Call Build_Private_Protected_Declaration
+       * exp_ch6.adb (Expand_N_Subprogram_Declaration): For an operation
+       declared in a protected body, create the declaration for the
+       corresponding protected version of the operation.
+
+2009-11-30  Arnaud Charlet  <charlet@adacore.com>
+
+       * gnat1drv.adb (Adjust_Global_Switches): Disable specific expansions
+       for Restrictions pragmas, to avoid tree inconsistencies between
+       compilations with different pragmas.
+
+2009-11-30  Jerome Lambourg  <lambourg@adacore.com>
+
+       * sem_prag.adb (Check_Duplicated_Export_Name): Allow entities exported
+       to CIL to have duplicated export name.
+
 2009-11-30  Robert Dewar  <dewar@adacore.com>
 
        * a-tiinio.adb: Remove extraneous pragma Warnings (Off).
index 1e4ea01..fa74f6c 100644 (file)
@@ -4502,6 +4502,21 @@ package body Exp_Ch6 is
             Analyze (Prot_Decl);
             Insert_Actions (N, Freeze_Entity (Prot_Id, Loc));
             Set_Protected_Body_Subprogram (Subp, Prot_Id);
+
+            --  Create protected operation as well. Even though the operation
+            --  is only accessible within the body, it is possible to make it
+            --  available outside of the protected object by using 'Access to
+            --  provide a callback, so we build the protected version in all
+            --  cases.
+
+            Prot_Decl :=
+                 Make_Subprogram_Declaration (Loc,
+                   Specification =>
+                     Build_Protected_Sub_Specification
+                      (N, Scop, Protected_Mode));
+            Insert_Before (Prot_Bod, Prot_Decl);
+            Analyze (Prot_Decl);
+
             Pop_Scope;
          end if;
 
index 7fe20b3..869a2f2 100644 (file)
@@ -2551,6 +2551,72 @@ package body Exp_Ch9 is
       end loop;
    end Build_Master_Entity;
 
+   -----------------------------------------
+   -- Build_Private_Protected_Declaration --
+   -----------------------------------------
+
+   function Build_Private_Protected_Declaration (N : Node_Id)
+     return Entity_Id
+   is
+      Loc      : constant Source_Ptr := Sloc (N);
+      Body_Id  : constant Entity_Id := Defining_Entity (N);
+      Decl     : Node_Id;
+      Plist    : List_Id;
+      Formal   : Entity_Id;
+      New_Spec : Node_Id;
+      Spec_Id  : Entity_Id;
+
+   begin
+      Formal := First_Formal (Body_Id);
+
+      --  The protected operation always has at least one formal, namely
+      --  the object itself, but it is only placed in the parameter list
+      --  if expansion is enabled.
+
+      if Present (Formal)
+        or else Expander_Active
+      then
+         Plist := Copy_Parameter_List (Body_Id);
+      else
+         Plist := No_List;
+      end if;
+
+      if Nkind (Specification (N)) = N_Procedure_Specification then
+         New_Spec :=
+           Make_Procedure_Specification (Loc,
+              Defining_Unit_Name =>
+                Make_Defining_Identifier (Sloc (Body_Id),
+                  Chars => Chars (Body_Id)),
+              Parameter_Specifications => Plist);
+      else
+         New_Spec :=
+           Make_Function_Specification (Loc,
+              Defining_Unit_Name =>
+                Make_Defining_Identifier (Sloc (Body_Id),
+                  Chars => Chars (Body_Id)),
+              Parameter_Specifications => Plist,
+              Result_Definition =>
+                New_Occurrence_Of (Etype (Body_Id), Loc));
+      end if;
+
+      Decl :=
+        Make_Subprogram_Declaration (Loc,
+          Specification => New_Spec);
+      Insert_Before (N, Decl);
+      Spec_Id := Defining_Unit_Name (New_Spec);
+
+      --  Indicate that the entity comes from source, to ensure that
+      --  cross-reference information is properly generated. The body
+      --  itself is rewritten during expansion, and the body entity will
+      --  not appear in calls to the operation.
+
+      Set_Comes_From_Source (Spec_Id, True);
+      Analyze (Decl);
+      Set_Has_Completion (Spec_Id);
+      Set_Convention (Spec_Id, Convention_Protected);
+      return Spec_Id;
+   end Build_Private_Protected_Declaration;
+
    ---------------------------
    -- Build_Protected_Entry --
    ---------------------------
@@ -7182,7 +7248,6 @@ package body Exp_Ch9 is
       New_Op_Body  : Node_Id;
       Num_Entries  : Natural := 0;
       Op_Body      : Node_Id;
-      Op_Decl      : Node_Id;
       Op_Id        : Entity_Id;
 
       Chain        : Entity_Id := Empty;
@@ -7344,41 +7409,36 @@ package body Exp_Ch9 is
                   --  to an external caller. This is the common idiom in code
                   --  that uses the Ada 2005 Timing_Events package. As a result
                   --  we need to produce the protected body for both visible
-                  --  and private operations.
+                  --  and private operations, as well as operations that only
+                  --  have a body in the source, and for which we create a
+                  --  declaration in the protected body itself.
 
                   if Present (Corresponding_Spec (Op_Body)) then
-                     Op_Decl :=
-                       Unit_Declaration_Node (Corresponding_Spec (Op_Body));
+                     New_Op_Body :=
+                       Build_Protected_Subprogram_Body (
+                         Op_Body, Pid, Specification (New_Op_Body));
 
-                     if Nkind (Parent (Op_Decl)) =
-                          N_Protected_Definition
-                     then
-                        New_Op_Body :=
-                          Build_Protected_Subprogram_Body (
-                            Op_Body, Pid, Specification (New_Op_Body));
-
-                        Insert_After (Current_Node, New_Op_Body);
-                        Analyze (New_Op_Body);
+                     Insert_After (Current_Node, New_Op_Body);
+                     Analyze (New_Op_Body);
 
-                        Current_Node := New_Op_Body;
+                     Current_Node := New_Op_Body;
 
-                        --  Generate an overriding primitive operation body for
-                        --  this subprogram if the protected type implements
-                        --  an interface.
+                     --  Generate an overriding primitive operation body for
+                     --  this subprogram if the protected type implements
+                     --  an interface.
 
-                        if Ada_Version >= Ada_05
-                          and then Present (Interfaces (
-                                     Corresponding_Record_Type (Pid)))
-                        then
-                           Disp_Op_Body :=
-                             Build_Dispatching_Subprogram_Body (
-                               Op_Body, Pid, New_Op_Body);
+                     if Ada_Version >= Ada_05
+                       and then Present (Interfaces (
+                                  Corresponding_Record_Type (Pid)))
+                     then
+                        Disp_Op_Body :=
+                          Build_Dispatching_Subprogram_Body (
+                            Op_Body, Pid, New_Op_Body);
 
-                           Insert_After (Current_Node, Disp_Op_Body);
-                           Analyze (Disp_Op_Body);
+                        Insert_After (Current_Node, Disp_Op_Body);
+                        Analyze (Disp_Op_Body);
 
-                           Current_Node := Disp_Op_Body;
-                        end if;
+                        Current_Node := Disp_Op_Body;
                      end if;
                   end if;
                end if;
index 61279d4..1bb8106 100644 (file)
@@ -81,6 +81,15 @@ package Exp_Ch9 is
    --  object at the outer level, but it is much easier to generate one per
    --  declarative part.
 
+   function Build_Private_Protected_Declaration (N : Node_Id) return Entity_Id;
+   --  A subprogram body without a previous spec that appears in a protected
+   --  body must be expanded separately to create a subprogram declaration
+   --  for it, in order to resolve internal calls to it from other protected
+   --  operations. It would seem that no locking version of the operation is
+   --  needed, but in fact, in Ada2005 the subprogram may be used in a call-
+   --  back, and therefore a protected version of the operation must be
+   --  generated as well.
+
    function Build_Protected_Sub_Specification
      (N        : Node_Id;
       Prot_Typ : Entity_Id;
index ca4fe86..cec9645 100644 (file)
@@ -158,10 +158,17 @@ procedure Gnat1drv is
          Front_End_Inlining := False;
          Inline_Active      := False;
 
-         --  Turn off ASIS mode: incompatible with front-end expansion.
+         --  Turn off ASIS mode: incompatible with front-end expansion
 
          ASIS_Mode := False;
 
+         --  Disable specific expansions for Restrictions pragmas to avoid
+         --  tree inconsistencies between compilations with different pragmas
+         --  that will cause different SCIL files to be generated for the
+         --  same Ada spec.
+
+         Treat_Restrictions_As_Warnings := True;
+
          --  Suppress overflow, division by zero and access checks since they
          --  are handled implicitly by CodePeer.
 
index c57bb56..507a03c 100644 (file)
@@ -1994,61 +1994,7 @@ package body Sem_Ch6 is
         and then Comes_From_Source (N)
         and then Is_Protected_Type (Current_Scope)
       then
-         declare
-            Decl     : Node_Id;
-            Plist    : List_Id;
-            Formal   : Entity_Id;
-            New_Spec : Node_Id;
-
-         begin
-            Formal := First_Formal (Body_Id);
-
-            --  The protected operation always has at least one formal, namely
-            --  the object itself, but it is only placed in the parameter list
-            --  if expansion is enabled.
-
-            if Present (Formal)
-              or else Expander_Active
-            then
-               Plist := Copy_Parameter_List (Body_Id);
-            else
-               Plist := No_List;
-            end if;
-
-            if Nkind (Body_Spec) = N_Procedure_Specification then
-               New_Spec :=
-                 Make_Procedure_Specification (Loc,
-                    Defining_Unit_Name =>
-                      Make_Defining_Identifier (Sloc (Body_Id),
-                        Chars => Chars (Body_Id)),
-                    Parameter_Specifications => Plist);
-            else
-               New_Spec :=
-                 Make_Function_Specification (Loc,
-                    Defining_Unit_Name =>
-                      Make_Defining_Identifier (Sloc (Body_Id),
-                        Chars => Chars (Body_Id)),
-                    Parameter_Specifications => Plist,
-                    Result_Definition =>
-                      New_Occurrence_Of (Etype (Body_Id), Loc));
-            end if;
-
-            Decl :=
-              Make_Subprogram_Declaration (Loc,
-                Specification => New_Spec);
-            Insert_Before (N, Decl);
-            Spec_Id := Defining_Unit_Name (New_Spec);
-
-            --  Indicate that the entity comes from source, to ensure that
-            --  cross-reference information is properly generated. The body
-            --  itself is rewritten during expansion, and the body entity will
-            --  not appear in calls to the operation.
-
-            Set_Comes_From_Source (Spec_Id, True);
-            Analyze (Decl);
-            Set_Has_Completion (Spec_Id);
-            Set_Convention (Spec_Id, Convention_Protected);
-         end;
+         Spec_Id := Build_Private_Protected_Declaration (N);
       end if;
 
       --  If a separate spec is present, then deal with freezing issues
index f88c6bd..aa1ed1b 100644 (file)
@@ -1154,6 +1154,14 @@ package body Sem_Prag is
          String_Val : constant String_Id := Strval (Nam);
 
       begin
+         --  We allow duplicated export names in CIL, as they are always
+         --  enclosed in a namespace that differenciates them, and overloaded
+         --  entities are supported by the VM.
+
+         if VM_Target = CLI_Target then
+            return;
+         end if;
+
          --  We are only interested in the export case, and in the case of
          --  generics, it is the instance, not the template, that is the
          --  problem (the template will generate a warning in any case).