re PR fortran/36403 (Some fortran tests using eoshift fail on SH)

2008-07-29  Daniel Kraft  <d@domob.eu>

	PR fortran/36403
	* trans-intrinsic.c (conv_generic_with_optional_char_arg):  New method
	to append a string-length even if the string argument is missing, e.g.
	for EOSHIFT.
	(gfc_conv_intrinsic_function):  Call the new method for EOSHIFT, PACK
	and RESHAPE.

2008-07-29  Daniel Kraft  <d@domob.eu>

	PR fortran/36403
	* gfortran.dg/char_eoshift_5.f90:  New test.
	* gfortran.dg/intrinsic_optional_char_arg_1.f90:  New test.

From-SVN: r138234

gcc/fortran/ChangeLog

+2008-07-29  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/36403
+	* trans-intrinsic.c (conv_generic_with_optional_char_arg):  New method
+	to append a string-length even if the string argument is missing, e.g.
+	for EOSHIFT.
+	(gfc_conv_intrinsic_function):  Call the new method for EOSHIFT, PACK
+	and RESHAPE.
+
 2008-07-28  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
 
 	* gfortran.h (try): Remove macro.  Replace try with gfc_try

gcc/fortran/trans-intrinsic.c

@@ -2652,6 +2652,64 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
   se->expr = fold_build3 (COND_EXPR, type, tmp, args[0], rrot);
 }
 
+
+/* Process an intrinsic with unspecified argument-types that has an optional
+   argument (which could be of type character), e.g. EOSHIFT.  For those, we
+   need to append the string length of the optional argument if it is not
+   present and the type is really character.
+   primary specifies the position (starting at 1) of the non-optional argument
+   specifying the type and optional gives the position of the optional
+   argument in the arglist.  */
+
+static void
+conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
+				     unsigned primary, unsigned optional)
+{
+  gfc_actual_arglist* prim_arg;
+  gfc_actual_arglist* opt_arg;
+  unsigned cur_pos;
+  gfc_actual_arglist* arg;
+  gfc_symbol* sym;
+  tree append_args;
+
+  /* Find the two arguments given as position.  */
+  cur_pos = 0;
+  prim_arg = NULL;
+  opt_arg = NULL;
+  for (arg = expr->value.function.actual; arg; arg = arg->next)
+    {
+      ++cur_pos;
+
+      if (cur_pos == primary)
+	prim_arg = arg;
+      if (cur_pos == optional)
+	opt_arg = arg;
+
+      if (cur_pos >= primary && cur_pos >= optional)
+	break;
+    }
+  gcc_assert (prim_arg);
+  gcc_assert (prim_arg->expr);
+  gcc_assert (opt_arg);
+
+  /* If we do have type CHARACTER and the optional argument is really absent,
+     append a dummy 0 as string length.  */
+  append_args = NULL_TREE;
+  if (prim_arg->expr->ts.type == BT_CHARACTER && !opt_arg->expr)
+    {
+      tree dummy;
+
+      dummy = build_int_cst (gfc_charlen_type_node, 0);
+      append_args = gfc_chainon_list (append_args, dummy);
+    }
+
+  /* Build the call itself.  */
+  sym = gfc_get_symbol_for_expr (expr);
+  gfc_conv_function_call (se, sym, expr->value.function.actual, append_args);
+  gfc_free (sym);
+}
+
+
 /* The length of a character string.  */
 static void
 gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
@@ -4128,7 +4186,22 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
 	{
 	  if (lib == 1)
 	    se->ignore_optional = 1;
-	  gfc_conv_intrinsic_funcall (se, expr);
+
+	  switch (expr->value.function.isym->id)
+	    {
+	    case GFC_ISYM_EOSHIFT:
+	    case GFC_ISYM_PACK:
+	    case GFC_ISYM_RESHAPE:
+	      /* For all of those the first argument specifies the type and the
+		 third is optional.  */
+	      conv_generic_with_optional_char_arg (se, expr, 1, 3);
+	      break;
+
+	    default:
+	      gfc_conv_intrinsic_funcall (se, expr);
+	      break;
+	    }
+
 	  return;
 	}
     }
@@ -4606,6 +4679,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_funcall (se, expr);
       break;
 
+    case GFC_ISYM_EOSHIFT:
+    case GFC_ISYM_PACK:
+    case GFC_ISYM_RESHAPE:
+      /* For those, expr->rank should always be >0 and thus the if above the
+	 switch should have matched.  */
+      gcc_unreachable ();
+      break;
+
     default:
       gfc_conv_intrinsic_lib_function (se, expr);
       break;

gcc/testsuite/ChangeLog

+2008-07-29  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/36403
+	* gfortran.dg/char_eoshift_5.f90:  New test.
+	* gfortran.dg/intrinsic_optional_char_arg_1.f90:  New test.
+
 2008-07-28  Richard Guenther  <rguenther@suse.de>
 
 	Merge from gimple-tuples-branch.

gcc/testsuite/gfortran.dg/char_eoshift_5.f90

+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+
+! PR fortran/36403
+! Check that the string length of BOUNDARY is added to the library-eoshift
+! call even if BOUNDARY is missing (as it is optional).
+! This is the original test from the PR.
+
+! Contributed by Kazumoto Kojima.
+
+  CHARACTER(LEN=3), DIMENSION(10) :: Z
+  call test_eoshift
+contains
+  subroutine test_eoshift 
+    CHARACTER(LEN=1), DIMENSION(10) :: chk
+    chk(1:8) = "5"
+    chk(9:10) = " "
+    Z(:)="456"
+    if (any (EOSHIFT(Z(:)(2:2),2) .ne. chk)) call abort 
+  END subroutine
+END
+
+! Check that _gfortran_eoshift* is called with 8 arguments:
+! { dg-final { scan-tree-dump "_gfortran_eoshift\[0-9_\]+char \\(\[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*\\)" "original" } }

gcc/testsuite/gfortran.dg/intrinsic_optional_char_arg_1.f90

+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+
+! PR fortran/36403
+! Check that string lengths of optional arguments are added to the library-call
+! even if those arguments are missing.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  CHARACTER(len=1) :: vect(4)
+  CHARACTER(len=1) :: matrix(2, 2)
+
+  matrix(1, 1) = ""
+  matrix(2, 1) = "a"
+  matrix(1, 2) = "b"
+  matrix(2, 2) = ""
+  vect = (/ "w", "x", "y", "z" /)
+
+  ! Call the affected intrinsics
+  vect = EOSHIFT (vect, 2)
+  vect = PACK (matrix, matrix /= "")
+  matrix = RESHAPE (vect, (/ 2, 2 /))
+
+END PROGRAM main
+
+! All library function should be called with *two* trailing arguments "1" for
+! the string lengths of both the main array and the optional argument:
+! { dg-final { scan-tree-dump "_eoshift\[0-9_\]+char \\(\[&a-zA-Z0-9._, \]+, 1, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_reshape\[0-9_\]+char \\(\[&a-zA-Z0-9._, \]+, 1, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_pack\[0-9_\]+char \\(\[&a-zA-Z0-9._, \]+, 1, 0\\)" "original" } }