[Ada] Concurrent types in pragma Initializes

Message ID 20171215141014.GA95997@adacore.com
State New
Headers show
Series
  • [Ada] Concurrent types in pragma Initializes
Related show

Commit Message

Pierre-Marie de Rodat Dec. 15, 2017, 2:10 p.m.
Concurrent types and single concurrent types can now appear in the input list
of pragma Initializes as long as the type encloses the pragma.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

2017-12-15  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Input_Item): Allow concurrent types to appear
	within the input list of Initializes. Remove the uses of Input_OK.

gcc/testsuite/

2017-12-15  Hristian Kirtchev  <kirtchev@adacore.com>

	* gnat.dg/initializes.ads, gnat.dg/initializes.adb: New testcase.

Patch

Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 255693)
+++ sem_prag.adb	(working copy)
@@ -2867,7 +2867,6 @@ 
 
          procedure Analyze_Input_Item (Input : Node_Id) is
             Input_Id : Entity_Id;
-            Input_OK : Boolean := True;
 
          begin
             --  Null input list
@@ -2908,6 +2907,8 @@ 
                                                  E_In_Parameter,
                                                  E_In_Out_Parameter,
                                                  E_Out_Parameter,
+                                                 E_Protected_Type,
+                                                 E_Task_Type,
                                                  E_Variable)
                   then
                      --  The input cannot denote states or objects declared
@@ -2933,11 +2934,11 @@ 
                            null;
 
                         else
-                           Input_OK := False;
                            Error_Msg_Name_1 := Chars (Pack_Id);
                            SPARK_Msg_NE
                              ("input item & cannot denote a visible object or "
                               & "state of package %", Input, Input_Id);
+                           return;
                         end if;
                      end if;
 
@@ -2945,26 +2946,25 @@ 
                      --  (SPARK RM 7.1.5(5)).
 
                      if Contains (Inputs_Seen, Input_Id) then
-                        Input_OK := False;
                         SPARK_Msg_N ("duplicate input item", Input);
+                        return;
                      end if;
 
-                     --  Input is legal, add it to the list of processed inputs
+                     --  At this point it is known that the input is legal. Add
+                     --  it to the list of processed inputs.
 
-                     if Input_OK then
-                        Append_New_Elmt (Input_Id, Inputs_Seen);
+                     Append_New_Elmt (Input_Id, Inputs_Seen);
 
-                        if Ekind (Input_Id) = E_Abstract_State then
-                           Append_New_Elmt (Input_Id, States_Seen);
-                        end if;
+                     if Ekind (Input_Id) = E_Abstract_State then
+                        Append_New_Elmt (Input_Id, States_Seen);
+                     end if;
 
-                        if Ekind_In (Input_Id, E_Abstract_State,
-                                               E_Constant,
-                                               E_Variable)
-                          and then Present (Encapsulating_State (Input_Id))
-                        then
-                           Append_New_Elmt (Input_Id, Constits_Seen);
-                        end if;
+                     if Ekind_In (Input_Id, E_Abstract_State,
+                                            E_Constant,
+                                            E_Variable)
+                       and then Present (Encapsulating_State (Input_Id))
+                     then
+                        Append_New_Elmt (Input_Id, Constits_Seen);
                      end if;
 
                   --  The input references something that is not a state or an
Index: ../testsuite/gnat.dg/initializes.adb
===================================================================
--- ../testsuite/gnat.dg/initializes.adb	(revision 0)
+++ ../testsuite/gnat.dg/initializes.adb	(revision 0)
@@ -0,0 +1,33 @@ 
+--  { dg-do compile }
+
+package body Initializes is
+   protected body PO is
+      procedure Proc is
+         package Inner with Initializes => (Y => PO) is              --  OK
+            Y : Boolean := X;
+         end Inner;
+
+         procedure Nested with Global => PO is                       --  OK
+         begin
+            null;
+         end Nested;
+      begin
+         Nested;
+      end Proc;
+   end PO;
+
+   protected body PT is
+      procedure Proc is
+         package Inner with Initializes => (Y => PT) is              --  OK
+            Y : Boolean := X;
+         end Inner;
+
+         procedure Nested with Global => PT is                       --  OK
+         begin
+            null;
+         end Nested;
+      begin
+         Nested;
+      end Proc;
+   end PT;
+end Initializes;
Index: ../testsuite/gnat.dg/initializes.ads
===================================================================
--- ../testsuite/gnat.dg/initializes.ads	(revision 0)
+++ ../testsuite/gnat.dg/initializes.ads	(revision 0)
@@ -0,0 +1,13 @@ 
+package Initializes is
+   protected PO is
+      procedure Proc;
+   private
+      X : Boolean := True;
+   end PO;
+
+   protected type PT is
+      procedure Proc;
+   private
+      X : Boolean := True;
+   end PT;
+end Initializes;