[PATCH] ada: Initialize OUT access type parameters of an entry call

[Samuel Tardieu <sam at rfc1149 dot net>]

Regtested on i686-pc-linux-gnu.

    gcc/ada/
	PR ada/21489
	* exp_ch9.adb (Build_Simple_Entry_Call): Initialize OUT access type
	parameters of an entry call.

    gcc/testsuite/
	PR ada/21489
	* gnat.dg/rm_6_4_1_13.adb: New test.
---
 gcc/ada/exp_ch9.adb                   |    7 ++-
 gcc/testsuite/gnat.dg/rm_6_4_1_13.adb |   90 +++++++++++++++++++++++++++++++++
 2 files changed, 95 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gnat.dg/rm_6_4_1_13.adb

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 87fbc12..ed3f242 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -3023,9 +3023,12 @@ package body Exp_Ch9 is
 
                   --  We have to make an assignment statement separate for the
                   --  case of limited type. We cannot assign it unless the
-                  --  Assignment_OK flag is set first.
+                  --  Assignment_OK flag is set first. OUT access type
+                  --  parameters are also initialized per RM 6.4.1 (13).
 
-                  if Ekind (Formal) /= E_Out_Parameter then
+                  if Ekind (Formal) /= E_Out_Parameter
+                    or else Is_Access_Type (Etype (Formal))
+                  then
                      N_Var :=
                        New_Reference_To (Defining_Identifier (N_Node), Loc);
                      Set_Assignment_OK (N_Var);
diff --git a/gcc/testsuite/gnat.dg/rm_6_4_1_13.adb b/gcc/testsuite/gnat.dg/rm_6_4_1_13.adb
new file mode 100644
index 0000000..2c315b8
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/rm_6_4_1_13.adb
@@ -0,0 +1,90 @@
+-- { dg-do run }
+-- { dg-options "-gnatwA" }
+-- RM 6.4.1(13)
+-- RM 9.5.1(3)
+-- RM 9.5.3(8)
+with Ada.Text_IO; use Ada.Text_IO;
+procedure RM_6_4_1_13 is
+   type intp is access all integer;
+   i: aliased integer := 3;
+   x1: intp;
+
+   procedure p1(x: out intp) is
+   begin
+      null;
+   end;
+
+   protected type T1 is
+      entry e1 (x: out intp);
+      procedure p2(x: out intp);
+   end T1;
+
+    protected body T1 is
+
+      entry e1 (x: out intp) when true is
+      begin
+         null;
+      end e1;
+
+      procedure p2(x: out intp) is
+      begin
+         null;
+      end;
+
+   end T1;
+
+   task type T2 is
+      entry e1 (x: out intp);
+   end T2;
+
+   task body T2 is
+   begin
+      loop
+         select
+            accept e1 (x: out intp) do
+               begin
+                  null;
+               end;
+            end e1;
+         or
+            terminate;
+         end select;
+      end loop;
+   end T2;
+
+   pt: T1;
+
+   tt: T2;
+
+   procedure doit(x2: intp) is
+
+      procedure Check (S : String) is
+      begin
+         Put ("  - " & S & ": ");
+         if X1 = X2 then
+            Put_Line ("PASSED");
+         else
+            Put_Line ("FAILED");
+            raise Program_Error;
+         end if;
+         x1 := x2;
+      end Check;
+
+   begin
+      x1 := x2;
+      p1(x1);
+      Check ("procedure call");
+      pt.p2(x1);
+      Check ("protected procedure call");
+      tt.e1(x1);
+      Check ("task entry call");
+      pt.e1(x1);
+      Check ("protected entry call");
+   end;
+
+begin
+   Put_Line ("Called with null");
+   doit(null);
+   Put_Line ("Called with non-null");
+   doit(i'access);
+end RM_6_4_1_13;
-- 
1.5.3.6