[Ada] Fix unexpected read of volatile scalar for Out parameter

[Eric Botcazou <ebotcazou at adacore dot com>]

This fixes an old issue in the compiler, whereby it unexpectedly generates a 
read of a volatile variable with scalar type passed as Out parameter to a 
subprogram; the subtlety being that the side-effects of the parameter viewed 
as a name still need to be evaluated prior to the call.

Tested on x86_64-suse-linux, applied on the mainline.


2013-11-18  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/trans.c (Call_to_gnu): For an Out parameter passed by
	copy and that don't need to be  copied in, only evaluate its address.


2013-11-18  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/volatile11.adb: New test.
	* gnat.dg/volatile11_pkg.ad[sb]: New helper.


-- 
Eric Botcazou

Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 204913)
+++ gcc-interface/trans.c	(working copy)
@@ -4130,9 +4130,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
 	gnu_name
 	  = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_name))), gnu_name);
 
-      /* If we have not saved a GCC object for the formal, it means it is an
-	 Out parameter not passed by reference and that need not be copied in.
-	 Otherwise, first see if the parameter is passed by reference.  */
+      /* First see if the parameter is passed by reference.  */
       if (is_true_formal_parm && DECL_BY_REF_P (gnu_formal))
 	{
 	  if (Ekind (gnat_formal) != E_In_Parameter)
@@ -4178,6 +4176,9 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
 	  gnu_formal_type = TREE_TYPE (gnu_formal);
 	  gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual);
 	}
+
+      /* Then see if the parameter is an array passed to a foreign convention
+	 subprogram.  */
       else if (is_true_formal_parm && DECL_BY_COMPONENT_PTR_P (gnu_formal))
 	{
 	  gnu_formal_type = TREE_TYPE (gnu_formal);
@@ -4198,6 +4199,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
 	     but this is the most likely to work in all cases.  */
 	  gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual);
 	}
+
+      /* Then see if the parameter is passed by descriptor.  */
       else if (is_true_formal_parm && DECL_BY_DESCRIPTOR_P (gnu_formal))
 	{
 	  gnu_actual = convert (gnu_formal_type, gnu_actual);
@@ -4214,6 +4217,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
 					 (TREE_TYPE (TREE_TYPE (gnu_formal)),
 					  gnu_actual, gnat_actual));
 	}
+
+      /* Otherwise the parameter is passed by copy.  */
       else
 	{
 	  tree gnu_size;
@@ -4221,11 +4226,18 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
 	  if (Ekind (gnat_formal) != E_In_Parameter)
 	    gnu_name_list = tree_cons (NULL_TREE, gnu_name, gnu_name_list);
 
+	  /* If we didn't create a PARM_DECL for the formal, this means that
+	     it is an Out parameter not passed by reference and that need not
+	     be copied in.  In this case, the value of the actual need not be
+	     read.  However, we still need to make sure that its side-effects
+	     are evaluated before the call, so we evaluate its address.  */
 	  if (!is_true_formal_parm)
 	    {
-	      /* Make sure side-effects are evaluated before the call.  */
 	      if (TREE_SIDE_EFFECTS (gnu_name))
-		append_to_statement_list (gnu_name, &gnu_stmt_list);
+		{
+		  tree addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_name);
+		  append_to_statement_list (addr, &gnu_stmt_list);
+		}
 	      continue;
 	    }
 

-- { dg-do run }
-- { dg-options "-O -gnatp" }

with Volatile11_Pkg; use Volatile11_Pkg;

procedure Volatile11 is

      Value : Integer := 1;
      Bit1 : Boolean := false;
      pragma Volatile (Bit1);
      Bit2 : Boolean := false;
      pragma Volatile (Bit2);
      Bit3 : Boolean := false;
      pragma Volatile (Bit3);
      Bit4 : Boolean := false;
      pragma Volatile (Bit4);
      Bit5 : Boolean := false;
      pragma Volatile (Bit5);
      Bit6 : Boolean := false;
      pragma Volatile (Bit6);
      Bit7 : Boolean := false;
      pragma Volatile (Bit7);
      Bit8 : Boolean := false;
      pragma Volatile (Bit8);

begin
      Bit_Test(Input   => Value,
               Output1 => Bit1,
               Output2 => Bit2,
               Output3 => Bit3,
               Output4 => Bit4,
               Output5 => Bit5,
               Output6 => Bit6,
               Output7 => Bit7,
               Output8 => F.all);

      -- Check that F is invoked before Bit_Test
      if B /= True then
        raise Program_Error;
      end if;
end;

package body Volatile11_Pkg is

   procedure Bit_Test(Input : in Integer;
                      Output1 : out Boolean; Output2 : out Boolean;
                      Output3 : out Boolean; Output4 : out Boolean;
                      Output5 : out Boolean; Output6 : out Boolean;
                      Output7 : out Boolean; Output8 : out Boolean)  is
  begin
    Output8 := B;
    Output7 := Input = 7;
    Output6 := Input = 6;
    Output5 := Input = 5;
    Output4 := Input = 4;
    Output3 := Input = 3;
    Output2 := Input = 2;
    Output1 := Input = 1;
  end Bit_Test;

  function F return Ptr is
  begin
    B := True;
    return B'Access;
  end;

end Volatile11_Pkg;

package Volatile11_Pkg is

   procedure Bit_Test(Input : in Integer;
                      Output1 : out Boolean; Output2 : out Boolean;
                      Output3 : out Boolean; Output4 : out Boolean;
                      Output5 : out Boolean; Output6 : out Boolean;
                      Output7 : out Boolean; Output8 : out Boolean);

   type Ptr is access all Boolean;

   B : aliased Boolean := False;

   function F return Ptr;

end Volatile11_Pkg;