decl.c (gnat_to_gnu_entity, [...]): Allow In Out/Out parameters for functions.

	* gcc-interface/decl.c (gnat_to_gnu_entity, case E_Function): Allow
	In Out/Out parameters for functions.
	* gcc-interface/trans.c (gnu_return_var_stack): New variable.
	(create_init_temporary): New static function.
	(Subprogram_Body_to_gnu): Handle In Out/Out parameters for functions.
	(call_to_gnu): Likewise.  Use create_init_temporary in order to create
	temporaries for unaligned parameters and return value.  If there is an
	unaligned In Out or Out parameter passed by reference, push a binding
	level if not already done.  If a binding level has been pushed and the
	call is returning a value, create the call statement.
	(gnat_to_gnu) <N_Return_Statement>: Handle In Out/Out parameters for
	functions.

From-SVN: r165914

gcc/ada/ChangeLog

+2010-10-25  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+            Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (gnat_to_gnu_entity, case E_Function): Allow
+	In Out/Out parameters for functions.
+	* gcc-interface/trans.c (gnu_return_var_stack): New variable.
+	(create_init_temporary): New static function.
+	(Subprogram_Body_to_gnu): Handle In Out/Out parameters for functions.
+	(call_to_gnu): Likewise.  Use create_init_temporary in order to create
+	temporaries for unaligned parameters and return value.  If there is an
+	unaligned In Out or Out parameter passed by reference, push a binding
+	level if not already done.  If a binding level has been pushed and the
+	call is returning a value, create the call statement.
+	(gnat_to_gnu) <N_Return_Statement>: Handle In Out/Out parameters for
+	functions.
+
 2010-10-22  Ben Brosgol  <brosgol@adacore.com>
 
 	* gnat_rm.texi: Add chapter on Ada 2012 support.

gcc/ada/gcc-interface/decl.c

@@ -3941,7 +3941,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	bool return_by_direct_ref_p = false;
 	bool return_by_invisi_ref_p = false;
 	bool return_unconstrained_p = false;
-	bool has_copy_in_out = false;
 	bool has_stub = false;
 	int parmnum;
 
@@ -4194,15 +4193,31 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	    if (copy_in_copy_out)
 	      {
-		if (!has_copy_in_out)
+		if (!gnu_cico_list)
 		  {
-		    gcc_assert (TREE_CODE (gnu_return_type) == VOID_TYPE);
-		    gnu_return_type = make_node (RECORD_TYPE);
+		    tree gnu_new_ret_type = make_node (RECORD_TYPE);
+
+		    /* If this is a function, we also need a field for the
+		       return value to be placed.  */
+		    if (TREE_CODE (gnu_return_type) != VOID_TYPE)
+		      {
+			gnu_field
+			  = create_field_decl (get_identifier ("RETVAL"),
+					       gnu_return_type,
+					       gnu_new_ret_type, NULL_TREE,
+					       NULL_TREE, 0, 0);
+			Sloc_to_locus (Sloc (gnat_entity),
+				       &DECL_SOURCE_LOCATION (gnu_field));
+			gnu_field_list = gnu_field;
+			gnu_cico_list
+			  = tree_cons (gnu_field, void_type_node, NULL_TREE);
+		      }
+
+		    gnu_return_type = gnu_new_ret_type;
 		    TYPE_NAME (gnu_return_type) = get_identifier ("RETURN");
 		    /* Set a default alignment to speed up accesses.  */
 		    TYPE_ALIGN (gnu_return_type)
 		      = get_mode_alignment (ptr_mode);
-		    has_copy_in_out = true;
 		  }
 
 		gnu_field

gcc/testsuite/ChangeLog

+2010-10-25  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/in_out_parameter2.adb: New test.
+	* gnat.dg/in_out_parameter3.adb: Likewise.
+
 2010-10-25  Jie Zhang  <jie@codesourcery.com>
 
 	g++.dg/opt/combine.c: New test.

gcc/testsuite/gnat.dg/in_out_parameter2.adb

+-- { dg-do run }
+-- { dg-options "-gnat12" }
+
+procedure In_Out_Parameter2 is
+
+  function F (I : In Out Integer) return Boolean is
+    A : Integer := I;
+  begin
+    I := I + 1;
+    return (A > 0);
+  end;
+
+  I : Integer := 0;
+  B : Boolean;
+
+begin
+  B := F (I);
+  if B then
+    raise Program_Error;
+  end if;
+  if I /= 1 then
+    raise Program_Error;
+  end if;
+end;

gcc/testsuite/gnat.dg/in_out_parameter3.adb

+-- { dg-do run }
+-- { dg-options "-gnat12" }
+
+procedure In_Out_Parameter3 is
+
+  type Arr is array (1..16) of Integer;
+
+  type Rec1 is record
+    A : Arr;
+    B : Boolean;
+  end record;
+
+  type Rec2 is record
+    R : Rec1;
+  end record;
+  pragma Pack (Rec2);
+
+  function F (I : In Out Rec1) return Boolean is
+    A : Integer := I.A (1);
+  begin
+    I.A (1) := I.A (1) + 1;
+    return (A > 0);
+  end;
+
+  I : Rec2 := (R => (A => (others => 0), B => True));
+  B : Boolean;
+
+begin
+  B := F (I.R);
+  if B then
+    raise Program_Error;
+  end if;
+  if I.R.A (1) /= 1 then
+    raise Program_Error;
+  end if;
+  if F (I.R) = False then
+     raise Program_Error;
+  end if;
+  if I.R.A (1) /= 2 then
+    raise Program_Error;
+  end if;
+end;