diff mbox

[Ada] Pass in Out param with Default_Value aspect

Message ID 1709031.uPdFItLhN3@polaris
State New
Headers show

Commit Message

Eric Botcazou Jan. 25, 2014, 10:34 a.m. UTC 
In most cases, out parameters are not passed in, but there have always
been exceptions, notably access types. Ada 2012 adds a new exception
for parameters of a type with a Default_Value. This patch ensures that
such parameters are copied in.

The following program, compiled with -gnata

     1. procedure DefValOut
     2. is
     3.   type R is range 0 .. 10 with Default_Value => 0;
     4.   procedure Wibble (X : out R)
     5.     with Post => X = 0
     6.   is
     7.   begin
     8.      null;
     9.   end Wibble;
    10.   X : R;
    11. begin
    12.   X := 10;
    13.   Wibble (X);
    14. end DefValOut;

used to generate no output, now it generates:

raised SYSTEM.ASSERTIONS.ASSERT_FAILURE :
failed postcondition from defvalout.adb:5

since the value of 10 gets passed in as the initial value of X
and the postcondition fails.


2014-01-25  Robert Dewar  <dewar@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_param): Make sure an Out parameter
	with Default_Value aspect is passed in by copy.
diff mbox

Patch

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 207070)
+++ gcc-interface/decl.c	(working copy)
@@ -5842,7 +5842,8 @@  gnat_to_gnu_param (Entity_Id gnat_param,
      Out parameters with discriminants or implicit initial values to be
      handled like In Out parameters.  These type are normally built as
      aggregates, hence passed by reference, except for some packed arrays
-     which end up encoded in special integer types.
+     which end up encoded in special integer types.  Note that scalars can
+     be given implicit initial values using the Default_Value aspect.
 
      The exception we need to make is then for packed arrays of records
      with discriminants or implicit initial values.  We have no light/easy
@@ -5856,7 +5857,8 @@  gnat_to_gnu_param (Entity_Id gnat_param,
 	  || (mech != By_Descriptor
               && mech != By_Short_Descriptor
 	      && !POINTER_TYPE_P (gnu_param_type)
-	      && !AGGREGATE_TYPE_P (gnu_param_type)))
+	      && !AGGREGATE_TYPE_P (gnu_param_type)
+	      && !Has_Default_Aspect (Etype (gnat_param))))
       && !(Is_Array_Type (Etype (gnat_param))
 	   && Is_Packed (Etype (gnat_param))
 	   && Is_Composite_Type (Component_Type (Etype (gnat_param)))))