re PR fortran/30888 (%VAL construct fails with argument procedures)

2007-02-28  Tobias Burnus  <burnus@net-b.de>
	    Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30888
	PR fortran/30887
	* resolve.c (resolve_actual_arglist): Allow by-value
	arguments and non-default-kind for %VAL().
	* trans-expr.c (conv_arglist_function): Allow
	non-default-kind for %VAL().

testsuite/
2007-02-28  Tobias Burnus  <burnus@net-b.de>
	    Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30888
	PR fortran/30887
	* c_by_val_1.f: Test %VAL() with non-default kind.
	* c_by_val.c: Ditto.
	* c_by_val_4.f: New test.


Co-Authored-By: Paul Thomas <pault@gcc.gnu.org>

From-SVN: r122409

3 files changed, 14 insertions, 40 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 32bf7e6..33fa9ad 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,14 @@
 2007-02-28  Tobias Burnus  <burnus@net-b.de>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30888
+	PR fortran/30887
+	* resolve.c (resolve_actual_arglist): Allow by-value
+	arguments and non-default-kind for %VAL().
+	* trans-expr.c (conv_arglist_function): Allow
+	non-default-kind for %VAL().
+
+2007-02-28  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/30968
 	* primary.c (next_string_char): Correct reading a character
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a66d1ae..987d73b 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1016,22 +1016,14 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype)
 		 since same file external procedures are not resolvable
 		 in gfortran, it is a good deal easier to leave them to
 		 intrinsic.c.  */
-	      if (ptype != PROC_UNKNOWN && ptype != PROC_EXTERNAL)
+	      if (ptype != PROC_UNKNOWN
+		  && ptype != PROC_DUMMY
+		  && ptype != PROC_EXTERNAL)
 		{
 		  gfc_error ("By-value argument at %L is not allowed "
 			     "in this context", &e->where);
 		  return FAILURE;
 		}
-
-	      if (((e->ts.type == BT_REAL || e->ts.type == BT_COMPLEX)
-		   && e->ts.kind > gfc_default_real_kind)
-		  || (e->ts.kind > gfc_default_integer_kind))
-		{
-		  gfc_error ("Kind of by-value argument at %L is larger "
-			     "than default kind", &e->where);
-		  return FAILURE;
-		}
-
 	    }
 
 	  /* Statement functions have already been excluded above.  */
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 839d768..b6c132b 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1934,40 +1934,12 @@ is_aliased_array (gfc_expr * e)
 static void
 conv_arglist_function (gfc_se *se, gfc_expr *expr, const char *name)
 {
-  tree type = NULL_TREE;
   /* Pass by value for g77 %VAL(arg), pass the address
      indirectly for %LOC, else by reference.  Thus %REF
      is a "do-nothing" and %LOC is the same as an F95
      pointer.  */
   if (strncmp (name, "%VAL", 4) == 0)
-    {
-      gfc_conv_expr (se, expr);
-      /* %VAL converts argument to default kind.  */
-      switch (expr->ts.type)
-	{
-	  case BT_REAL:
-	    type = gfc_get_real_type (gfc_default_real_kind);
-	    se->expr = fold_convert (type, se->expr);
-	    break;
-	  case BT_COMPLEX:
-	    type = gfc_get_complex_type (gfc_default_complex_kind);
-	    se->expr = fold_convert (type, se->expr);
-	    break;
-	  case BT_INTEGER:
-	    type = gfc_get_int_type (gfc_default_integer_kind);
-	    se->expr = fold_convert (type, se->expr);
-	    break;
-	  case BT_LOGICAL:
-	    type = gfc_get_logical_type (gfc_default_logical_kind);
-	    se->expr = fold_convert (type, se->expr);
-	    break;
-	  /* This should have been resolved away.  */
-	  case BT_UNKNOWN: case BT_CHARACTER: case BT_DERIVED:
-	  case BT_PROCEDURE: case BT_HOLLERITH:
-	    gfc_internal_error ("Bad type in conv_arglist_function");
-	}
-	  
-    }
+    gfc_conv_expr (se, expr);
   else if (strncmp (name, "%LOC", 4) == 0)
     {
       gfc_conv_expr_reference (se, expr);