re PR fortran/29642 (Fortran 2003: VALUE Attribute (call by value not call by reference for actual arguments))

2006-12-03  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29642
	* trans-expr.c (gfc_conv_variable): A character expression with
	the VALUE attribute needs an address expression; otherwise all
	other expressions with this attribute must not be dereferenced.
	(gfc_conv_function_call): Pass expressions with the VALUE
	attribute by value, using gfc_conv_expr.
	* symbol.c (check_conflict): Add strings for INTENT OUT, INOUT
	and VALUE.  Apply all the constraints associated with the VALUE
	attribute.
	(gfc_add_value): New function.
	(gfc_copy_attr): Call it for VALUE attribute.
	* decl.c (match_attr_spec): Include the VALUE attribute.
	(gfc_match_value): New function.
	* dump-parse-tree.c (gfc_show_attr): Include VALUE.
	* gfortran.h : Add value to the symbol_attribute structure and
	add a prototype for gfc_add_value
	* module.c (mio_internal_string): Include AB_VALUE in enum.
	(attr_bits): Provide the VALUE string for it.
	(mio_symbol_attribute): Read or apply the VLUE attribute.
	* trans-types.c (gfc_sym_type): Variables with the VLAUE
	attribute are not passed by reference!
	* resolve.c (was_declared): Add value to those that return 1.
	(resolve_symbol): Value attribute requires dummy attribute.
	* match.h : Add prototype for gfc_match_public.
	* parse.c (decode_statement): Try to match a VALUE statement.


2006-12-03  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29642
	* gfortran.dg/value_1.f90 : New test.
	* gfortran.dg/value_2.f90 : New test.
	* gfortran.dg/value_3.f90 : New test.
	* gfortran.dg/value_4.f90 : New test.
	* gfortran.dg/value_4.c : Called from value_4.f90.

From-SVN: r119461

gcc/fortran/ChangeLog

@@ -1,3 +1,31 @@
+2006-12-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29642
+	* trans-expr.c (gfc_conv_variable): A character expression with
+	the VALUE attribute needs an address expression; otherwise all
+	other expressions with this attribute must not be dereferenced.
+	(gfc_conv_function_call): Pass expressions with the VALUE
+	attribute by value, using gfc_conv_expr.
+	* symbol.c (check_conflict): Add strings for INTENT OUT, INOUT
+	and VALUE.  Apply all the constraints associated with the VALUE
+	attribute.
+	(gfc_add_value): New function.
+	(gfc_copy_attr): Call it for VALUE attribute.
+	* decl.c (match_attr_spec): Include the VALUE attribute.
+	(gfc_match_value): New function.
+	* dump-parse-tree.c (gfc_show_attr): Include VALUE.
+	* gfortran.h : Add value to the symbol_attribute structure and
+	add a prototype for gfc_add_value
+	* module.c (mio_internal_string): Include AB_VALUE in enum.
+	(attr_bits): Provide the VALUE string for it.
+	(mio_symbol_attribute): Read or apply the VLUE attribute.
+	* trans-types.c (gfc_sym_type): Variables with the VLAUE
+	attribute are not passed by reference!
+	* resolve.c (was_declared): Add value to those that return 1.
+	(resolve_symbol): Value attribute requires dummy attribute.
+	* match.h : Add prototype for gfc_match_public.
+	* parse.c (decode_statement): Try to match a VALUE statement.
+
 2006-12-01  Thomas Koenig  <Thomas.Koenig@online.de>
 
 	PR libfortran/29568

gcc/fortran/decl.c

@@ -2117,7 +2117,7 @@ match_attr_spec (void)
     DECL_ALLOCATABLE = GFC_DECL_BEGIN, DECL_DIMENSION, DECL_EXTERNAL,
     DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
     DECL_PARAMETER, DECL_POINTER, DECL_PRIVATE, DECL_PUBLIC, DECL_SAVE,
-    DECL_TARGET, DECL_VOLATILE, DECL_COLON, DECL_NONE,
+    DECL_TARGET, DECL_VALUE, DECL_VOLATILE, DECL_COLON, DECL_NONE,
     GFC_DECL_END /* Sentinel */
   }
   decl_types;
@@ -2140,6 +2140,7 @@ match_attr_spec (void)
     minit (", public", DECL_PUBLIC),
     minit (", save", DECL_SAVE),
     minit (", target", DECL_TARGET),
+    minit (", value", DECL_VALUE),
     minit (", volatile", DECL_VOLATILE),
     minit ("::", DECL_COLON),
     minit (NULL, DECL_NONE)
@@ -2261,6 +2262,9 @@ match_attr_spec (void)
 	  case DECL_TARGET:
 	    attr = "TARGET";
 	    break;
+	  case DECL_VALUE:
+	    attr = "VALUE";
+	    break;
 	  case DECL_VOLATILE:
 	    attr = "VOLATILE";
 	    break;
@@ -2378,6 +2382,15 @@ match_attr_spec (void)
 	  t = gfc_add_target (&current_attr, &seen_at[d]);
 	  break;
 
+	case DECL_VALUE:
+	  if (gfc_notify_std (GFC_STD_F2003,
+                              "Fortran 2003: VALUE attribute at %C")
+	      == FAILURE)
+	    t = FAILURE;
+	  else
+	    t = gfc_add_value (&current_attr, NULL, &seen_at[d]);
+	  break;
+
 	case DECL_VOLATILE:
 	  if (gfc_notify_std (GFC_STD_F2003,
                               "Fortran 2003: VOLATILE attribute at %C")
@@ -4050,6 +4063,57 @@ syntax:
 }
 
 
+match
+gfc_match_value (void)
+{
+  gfc_symbol *sym;
+  match m;
+
+  if (gfc_notify_std (GFC_STD_F2003, 
+		      "Fortran 2003: VALUE statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
+    {
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    goto syntax;
+
+  for(;;)
+    {
+      m = gfc_match_symbol (&sym, 0);
+      switch (m)
+	{
+	case MATCH_YES:
+	  if (gfc_add_value (&sym->attr, sym->name,
+  			        &gfc_current_locus) == FAILURE)
+	    return MATCH_ERROR;
+	  goto next_item;
+
+	case MATCH_NO:
+	  break;
+
+	case MATCH_ERROR:
+	  return MATCH_ERROR;
+	}
+
+    next_item:
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in VALUE statement at %C");
+  return MATCH_ERROR;
+}
+
 match
 gfc_match_volatile (void)
 {

gcc/fortran/dump-parse-tree.c

@@ -552,6 +552,8 @@ gfc_show_attr (symbol_attribute * attr)
     gfc_status (" POINTER");
   if (attr->save)
     gfc_status (" SAVE");
+  if (attr->value)
+    gfc_status (" VALUE");
   if (attr->volatile_)
     gfc_status (" VOLATILE");
   if (attr->threadprivate)

gcc/fortran/gfortran.h

@@ -479,7 +479,7 @@ typedef struct
 {
   /* Variable attributes.  */
   unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
-    optional:1, pointer:1, save:1, target:1, volatile_:1,
+    optional:1, pointer:1, save:1, target:1, value:1, volatile_:1,
     dummy:1, result:1, assign:1, threadprivate:1;
 
   unsigned data:1,		/* Symbol is named in a DATA statement.  */
@@ -1871,6 +1871,7 @@ try gfc_add_pure (symbol_attribute *, locus *);
 try gfc_add_recursive (symbol_attribute *, locus *);
 try gfc_add_function (symbol_attribute *, const char *, locus *);
 try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
+try gfc_add_value (symbol_attribute *, const char *, locus *);
 try gfc_add_volatile (symbol_attribute *, const char *, locus *);
 
 try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);

gcc/fortran/match.h

@@ -147,6 +147,7 @@ match gfc_match_public (gfc_statement *);
 match gfc_match_save (void);
 match gfc_match_modproc (void);
 match gfc_match_target (void);
+match gfc_match_value (void);
 match gfc_match_volatile (void);
 
 /* primary.c */

gcc/fortran/module.c

@@ -1487,11 +1487,11 @@ mio_internal_string (char *string)
 
 typedef enum
 { AB_ALLOCATABLE, AB_DIMENSION, AB_EXTERNAL, AB_INTRINSIC, AB_OPTIONAL,
-  AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT,
-  AB_DATA, AB_IN_NAMELIST, AB_IN_COMMON, 
-  AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE, AB_ELEMENTAL, AB_PURE,
-  AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT, AB_CRAY_POINTER,
-  AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP, AB_VOLATILE
+  AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA,
+  AB_IN_NAMELIST, AB_IN_COMMON, AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE,
+  AB_ELEMENTAL, AB_PURE, AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT,
+  AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP,
+  AB_VALUE, AB_VOLATILE
 }
 ab_attribute;
 
@@ -1504,6 +1504,7 @@ static const mstring attr_bits[] =
     minit ("OPTIONAL", AB_OPTIONAL),
     minit ("POINTER", AB_POINTER),
     minit ("SAVE", AB_SAVE),
+    minit ("VALUE", AB_VALUE),
     minit ("VOLATILE", AB_VOLATILE),
     minit ("TARGET", AB_TARGET),
     minit ("THREADPRIVATE", AB_THREADPRIVATE),
@@ -1575,6 +1576,8 @@ mio_symbol_attribute (symbol_attribute * attr)
 	MIO_NAME(ab_attribute) (AB_POINTER, attr_bits);
       if (attr->save)
 	MIO_NAME(ab_attribute) (AB_SAVE, attr_bits);
+      if (attr->value)
+	MIO_NAME(ab_attribute) (AB_VALUE, attr_bits);
       if (attr->volatile_)
 	MIO_NAME(ab_attribute) (AB_VOLATILE, attr_bits);
       if (attr->target)
@@ -1655,6 +1658,9 @@ mio_symbol_attribute (symbol_attribute * attr)
 	    case AB_SAVE:
 	      attr->save = 1;
 	      break;
+	    case AB_VALUE:
+	      attr->value = 1;
+	      break;
 	    case AB_VOLATILE:
 	      attr->volatile_ = 1;
 	      break;

gcc/fortran/parse.c

@@ -284,6 +284,7 @@ decode_statement (void)
       break;
 
     case 'v':
+      match ("value", gfc_match_value, ST_ATTR_DECL);
       match ("volatile", gfc_match_volatile, ST_ATTR_DECL);
       break;
 

gcc/fortran/resolve.c

@@ -675,7 +675,7 @@ was_declared (gfc_symbol * sym)
     return 1;
 
   if (a.allocatable || a.dimension || a.dummy || a.external || a.intrinsic
-      || a.optional || a.pointer || a.save || a.target || a.volatile_
+      || a.optional || a.pointer || a.save || a.target || a.volatile_ || a.value
       || a.access != ACCESS_UNKNOWN || a.intent != INTENT_UNKNOWN)
     return 1;
 
@@ -5961,6 +5961,14 @@ resolve_symbol (gfc_symbol * sym)
       return;
     }
 
+  if (sym->attr.value && !sym->attr.dummy)
+    {
+      gfc_error ("'%s' at %L cannot have the VALUE attribute because "
+		 "it is not a dummy", sym->name, &sym->declared_at);
+      return;
+    }
+
+
   /* If a derived type symbol has reached this point, without its
      type being declared, we have an error.  Notice that most
      conditions that produce undefined derived types have already

gcc/fortran/symbol.c

@@ -266,6 +266,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
   static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
     *target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
     *intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC",
+    *intent_out = "INTENT(OUT)", *intent_inout = "INTENT(INOUT)",
     *allocatable = "ALLOCATABLE", *elemental = "ELEMENTAL",
     *private = "PRIVATE", *recursive = "RECURSIVE",
     *in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST",
@@ -273,7 +274,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
     *function = "FUNCTION", *subroutine = "SUBROUTINE",
     *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
     *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
-    *cray_pointee = "CRAY POINTEE", *data = "DATA", *volatile_ = "VOLATILE";
+    *cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE",
+    *volatile_ = "VOLATILE";
   static const char *threadprivate = "THREADPRIVATE";
 
   const char *a1, *a2;
@@ -402,6 +404,21 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
   conf (data, allocatable);
   conf (data, use_assoc);
 
+  conf (value, pointer)
+  conf (value, allocatable)
+  conf (value, subroutine)
+  conf (value, function)
+  conf (value, volatile_)
+  conf (value, dimension)
+  conf (value, external)
+
+  if (attr->value && (attr->intent == INTENT_OUT || attr->intent == INTENT_INOUT))
+    {
+      a1 = value;
+      a2 = attr->intent == INTENT_OUT ? intent_out : intent_inout;
+      goto conflict;
+    }
+
   conf (volatile_, intrinsic)
   conf (volatile_, external)
 
@@ -524,6 +541,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
       conf2 (dummy);
       conf2 (in_common);
       conf2 (save);
+      conf2 (value);
       conf2 (volatile_);
       conf2 (threadprivate);
       break;
@@ -804,6 +822,26 @@ gfc_add_save (symbol_attribute * attr, const char *name, locus * where)
   return check_conflict (attr, name, where);
 }
 
+try
+gfc_add_value (symbol_attribute * attr, const char *name, locus * where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  if (attr->value)
+    {
+	if (gfc_notify_std (GFC_STD_LEGACY, 
+			    "Duplicate VALUE attribute specified at %L",
+			    where) 
+	    == FAILURE)
+	  return FAILURE;
+    }
+
+  attr->value = 1;
+  return check_conflict (attr, name, where);
+}
+
 try
 gfc_add_volatile (symbol_attribute * attr, const char *name, locus * where)
 {
@@ -1257,6 +1295,8 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
     goto fail;
   if (src->save && gfc_add_save (dest, NULL, where) == FAILURE)
     goto fail;
+  if (src->value && gfc_add_value (dest, NULL, where) == FAILURE)
+    goto fail;
   if (src->volatile_ && gfc_add_volatile (dest, NULL, where) == FAILURE)
     goto fail;
   if (src->threadprivate && gfc_add_threadprivate (dest, NULL, where) == FAILURE)

gcc/fortran/trans-expr.c

@@ -447,15 +447,21 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	 separately.  */
       if (sym->ts.type == BT_CHARACTER)
 	{
-          /* Dereference character pointer dummy arguments
+	  /* Dereference character pointer dummy arguments
 	     or results.  */
 	  if ((sym->attr.pointer || sym->attr.allocatable)
 	      && (sym->attr.dummy
 		  || sym->attr.function
 		  || sym->attr.result))
 	    se->expr = build_fold_indirect_ref (se->expr);
+
+	  /* A character with VALUE attribute needs an address
+	     expression.  */
+	  if (sym->attr.value)
+	    se->expr = build_fold_addr_expr (se->expr);
+
 	}
-      else
+      else if (!sym->attr.value)
 	{
           /* Dereference non-character scalar dummy arguments.  */
 	  if (sym->attr.dummy && !sym->attr.dimension)
@@ -2005,19 +2011,26 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	  argss = gfc_walk_expr (e);
 
 	  if (argss == gfc_ss_terminator)
-            {
-	      gfc_conv_expr_reference (&parmse, e);
+	    {
 	      parm_kind = SCALAR;
-              if (fsym && fsym->attr.pointer
-		  && e->expr_type != EXPR_NULL)
-                {
-                  /* Scalar pointer dummy args require an extra level of
-		  indirection. The null pointer already contains
-		  this level of indirection.  */
-		  parm_kind = SCALAR_POINTER;
-                  parmse.expr = build_fold_addr_expr (parmse.expr);
-                }
-            }
+	      if (fsym && fsym->attr.value)
+		{
+		  gfc_conv_expr (&parmse, e);
+		}
+	      else
+		{
+		  gfc_conv_expr_reference (&parmse, e);
+		  if (fsym && fsym->attr.pointer
+			&& e->expr_type != EXPR_NULL)
+		    {
+		      /* Scalar pointer dummy args require an extra level of
+			 indirection. The null pointer already contains
+			 this level of indirection.  */
+		      parm_kind = SCALAR_POINTER;
+		      parmse.expr = build_fold_addr_expr (parmse.expr);
+		    }
+		}
+	    }
 	  else
 	    {
               /* If the procedure requires an explicit interface, the actual

gcc/fortran/trans-types.c

@@ -1343,7 +1343,7 @@ gfc_sym_type (gfc_symbol * sym)
       sym->ts.kind = gfc_default_real_kind;
     }
 
-  if (sym->attr.dummy && !sym->attr.function)
+  if (sym->attr.dummy && !sym->attr.function && !sym->attr.value)
     byref = 1;
   else
     byref = 0;

gcc/testsuite/ChangeLog

@@ -1,3 +1,12 @@
+2006-12-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29642
+	* gfortran.dg/value_1.f90 : New test.
+	* gfortran.dg/value_2.f90 : New test.
+	* gfortran.dg/value_3.f90 : New test.
+	* gfortran.dg/value_4.f90 : New test.
+	* gfortran.dg/value_4.c : Called from value_4.f90.
+
 2006-12-02  Andrew Pinski  <andrew_pinski@playstation.sony.com>
 
 	PR C++/30033

gcc/testsuite/gfortran.dg/value_1.f90

@@ -0,0 +1,84 @@
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+! Tests the functionality of the patch for PR29642, which requested the
+! implementation of the F2003 VALUE attribute for gfortran.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org> 
+!
+module global
+  type :: mytype
+    real(4) :: x
+    character(4) :: c
+  end type mytype
+contains
+  subroutine typhoo (dt)
+    type(mytype), value :: dt
+    if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
+    dt = mytype (21.0, "wxyz")
+    if (dtne (dt, mytype (21.0, "wxyz"))) call abort ()
+  end subroutine typhoo
+
+  logical function dtne (a, b)
+    type(mytype) :: a, b
+    dtne = .FALSE.
+    if ((a%x /= b%x) .or. (a%c /= b%c)) dtne = .TRUE.
+  end function dtne
+end module global
+
+program test_value
+  use global
+  integer(8) :: i = 42
+  real(8) :: r = 42.0
+  character(2) ::   c = "ab"
+  complex(8) :: z = (-99.0, 199.0)
+  type(mytype) :: dt = mytype (42.0, "lmno")
+
+  call foo (c)
+  if (c /= "ab") call abort ()
+
+  call bar (i)
+  if (i /= 42) call abort ()
+
+  call foobar (r)
+  if (r /= 42.0) call abort ()
+
+  call complex_foo (z)
+  if (z /= (-99.0, 199.0)) call abort ()
+
+  call typhoo (dt)
+  if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
+
+  r = 20.0
+  call foobar (r*2.0 + 2.0)
+
+contains
+  subroutine foo (c)
+    character(2), value :: c
+    if (c /= "ab") call abort ()
+    c = "cd"
+    if (c /= "cd") call abort ()
+  end subroutine foo
+
+  subroutine bar (i)
+    integer(8), value :: i
+    if (i /= 42) call abort ()
+    i = 99
+    if (i /= 99) call abort ()
+  end subroutine bar
+
+  subroutine foobar (r)
+    real(8), value :: r
+    if (r /= 42.0) call abort ()
+    r = 99.0
+    if (r /= 99.0) call abort ()
+  end subroutine foobar
+
+  subroutine complex_foo (z)
+    COMPLEX(8), value :: z
+    if (z /= (-99.0, 199.0)) call abort ()
+    z = (77.0, -42.0)
+    if (z /= (77.0, -42.0)) call abort ()
+  end subroutine complex_foo
+
+end program test_value
+! { dg-final { cleanup-modules "global" } }

gcc/testsuite/gfortran.dg/value_2.f90

@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! Tests the standard check in the patch for PR29642, which requested the
+! implementation of the F2003 VALUE attribute for gfortran.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org> 
+!
+program test_value
+  integer(8) :: i = 42
+
+  call bar (i)
+  if (i /= 42) call abort ()
+contains
+  subroutine bar (i)
+    integer(8) :: i
+    value :: i      ! { dg-error "Fortran 2003: VALUE" }
+    if (i /= 42) call abort ()
+    i = 99
+    if (i /= 99) call abort ()
+  end subroutine bar
+end program test_value

gcc/testsuite/gfortran.dg/value_3.f90

@@ -0,0 +1,53 @@
+! { dg-do compile }
+! Tests the constraints in the patch for PR29642, which requested the
+! implementation of the F2003 VALUE attribute for gfortran.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org> 
+!
+program test_value
+  integer(8) :: i = 42, j   ! { dg-error "not a dummy" }
+  integer(8), value :: k    ! { dg-error "not a dummy" }
+  value :: j
+
+contains
+  subroutine bar_1 (i)
+    integer(8) :: i
+    dimension i(8)
+    value :: i  ! { dg-error "conflicts with DIMENSION" }
+    i = 0
+  end subroutine bar_1
+
+  subroutine bar_2 (i)
+    integer(8) :: i
+    pointer :: i
+    value :: i  ! { dg-error "conflicts with POINTER" }
+    i = 0
+  end subroutine bar_2
+
+  integer function bar_3 (i)
+    integer(8) :: i
+    dimension i(8)
+    value :: bar_3  ! { dg-error "conflicts with FUNCTION" }
+    i = 0
+    bar_3 = 0
+  end function bar_3
+
+  subroutine bar_4 (i, j)
+    integer(8), intent(inout) :: i
+    integer(8), intent(out) :: j
+    value :: i  ! { dg-error "conflicts with INTENT" }
+    value :: j  ! { dg-error "conflicts with INTENT" }
+    i = 0
+    j = 0
+  end subroutine bar_4
+
+  integer function bar_5 ()
+    integer(8) :: i
+    external :: i
+    integer, parameter :: j = 99
+    value :: i  ! { dg-error "conflicts with EXTERNAL" }
+    value :: j  ! { dg-error "PARAMETER attribute conflicts with" }
+    bar_5 = 0
+  end function bar_5
+
+end program test_value

gcc/testsuite/gfortran.dg/value_4.c

@@ -0,0 +1,48 @@
+/*  Passing from fortran to C by value, using VALUE.  This is identical
+    to c_by_val_1.c, which performs the same function for %VAL.
+
+    Contributed by Paul Thomas <pault@gcc.gnu.org>  */
+
+typedef struct { float r, i; } complex;
+extern float *f_to_f__ (float, float*);
+extern int *i_to_i__ (int, int*);
+extern void c_to_c__ (complex*, complex, complex*);
+extern void abort (void);
+
+/* In f_to_f and i_to_i we return the second argument, so that we do
+   not have to worry about keeping track of memory allocation between
+   fortran and C.  All three functions check that the argument passed
+   by value is the same as that passed by reference.  Then the passed
+   by value argument is modified so that the caller can check that
+   its version has not changed.*/
+
+float *
+f_to_f__(float a1, float *a2)
+{
+  if ( a1 != *a2 ) abort();
+  *a2 = a1 * 2.0;
+  a1 = 0.0;
+  return a2;
+}
+
+int *
+i_to_i__(int i1, int *i2)
+{
+  if ( i1 != *i2 ) abort();
+  *i2 = i1 * 3;
+  i1 = 0;
+  return i2;
+}
+
+void
+c_to_c__(complex *retval, complex c1, complex *c2)
+{
+  if ( c1.r != c2->r ) abort();
+  if ( c1.i != c2->i ) abort();
+  c1.r = 0.0;
+  c1.i = 0.0;
+  retval->r = c2->r * 4.0;
+  retval->i = c2->i * 4.0;
+  return;
+}
+

gcc/testsuite/gfortran.dg/value_4.f90

@@ -0,0 +1,84 @@
+! { dg-do run }
+! { dg-additional-sources value_4.c }
+! { dg-options "-ff2c -w -O0" }
+!
+! Tests the functionality of the patch for PR29642, which requested the
+! implementation of the F2003 VALUE attribute for gfortran, by calling
+! external C functions by value and by reference.  This is effectively
+! identical to c_by_val_1.f, which does the same for %VAL.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org> 
+!
+module global
+  interface delta
+    module procedure deltai, deltar, deltac
+  end interface delta
+  real(4) :: epsi = epsilon (1.0_4)
+contains
+  function deltai (a, b) result (c)
+    integer(4) :: a, b
+    logical :: c
+    c = (a /= b)
+  end function deltai
+
+  function deltar (a, b) result (c)
+    real(4) :: a, b
+    logical :: c
+    c = (abs (a-b) > epsi)
+  end function deltar
+
+  function deltac (a, b) result (c)
+    complex(4) :: a, b
+    logical :: c
+    c = ((abs (real (a-b)) > epsi).or.(abs (aimag (a-b)) > epsi))
+  end function deltac
+end module global  
+
+program value_4
+  use global
+  interface
+    function f_to_f (x, y)
+      real(4), pointer :: f_to_f
+      real(4) :: x, y
+      value :: x
+    end function f_to_f
+  end interface
+
+  interface
+    function i_to_i (x, y)
+      integer(4), pointer :: i_to_i
+      integer(4) :: x, y
+      value :: x
+    end function i_to_i
+  end interface
+
+  interface
+    complex(4) function c_to_c (x, y)
+      complex(4) :: x, y
+      value :: x
+    end function c_to_c
+  end interface
+
+  real(4)       a, b, c
+  integer(4)    i, j, k
+  complex(4)    u, v, w
+
+  a = 42.0
+  b = 0.0
+  c = a
+  b = f_to_f (a, c)
+  if (delta ((2.0 * a), b)) call abort ()
+
+  i = 99
+  j = 0
+  k = i
+  j = i_to_i (i, k)
+  if (delta ((3 * i), j)) call abort ()
+
+  u = (-1.0, 2.0)
+  v = (1.0, -2.0)
+  w = u
+  v = c_to_c (u, w)
+  if (delta ((4.0 * u), v)) call abort ()
+end program value_4
+! { dg-final { cleanup-modules "global" } }