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

1 files changed, 41 insertions, 1 deletions

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 7982920..228567b 100644
--- a/gcc/fortran/symbol.c
+++ b/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;
@@ -805,6 +823,26 @@ gfc_add_save (symbol_attribute * attr, const char *name, locus * 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)