re PR fortran/38137 (MERGE: -fbounds-check runtime check for same string length)

2008-12-17  Daniel Kraft  <d@domob.eu>

	PR fortran/38137
	* trans-intrinsic.c (conv_same_strlen_check): New method.
	(gfc_conv_intrinsic_merge): Call it here to actually do the check.

2008-12-17  Daniel Kraft  <d@domob.eu>

	PR fortran/38137
	* gfortran.dg/merge_char_3.f90: New test.

From-SVN: r142791

gcc/fortran/ChangeLog

+2008-12-17  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/38137
+	* trans-intrinsic.c (conv_same_strlen_check): New method.
+	(gfc_conv_intrinsic_merge): Call it here to actually do the check.
+
 2008-12-15  Mikael Morin  <mikael.morin@tele2.fr>
 
 	PR fortran/38487

gcc/fortran/trans-intrinsic.c

@@ -746,6 +746,36 @@ gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
   se->expr = build_call_array (rettype, fndecl, num_args, args);
 }
 
+
+/* If bounds-checking is enabled, create code to verify at runtime that the
+   string lengths for both expressions are the same (needed for e.g. MERGE).
+   If bounds-checking is not enabled, does nothing.  */
+
+static void
+conv_same_strlen_check (const char* intr_name, locus* where, tree a, tree b,
+			stmtblock_t* target)
+{
+  tree cond;
+  tree name;
+
+  /* If bounds-checking is disabled, do nothing.  */
+  if (!flag_bounds_check)
+    return;
+
+  /* Compare the two string lengths.  */
+  cond = fold_build2 (NE_EXPR, boolean_type_node, a, b);
+
+  /* Output the runtime-check.  */
+  name = gfc_build_cstring_const (intr_name);
+  name = gfc_build_addr_expr (pchar_type_node, name);
+  gfc_trans_runtime_check (true, false, cond, target, where,
+			   "Unequal character lengths (%ld/%ld) for arguments"
+			   " to %s",
+			   fold_convert (long_integer_type_node, a),
+			   fold_convert (long_integer_type_node, b), name);
+}
+
+
 /* The EXPONENT(s) intrinsic function is translated into
        int ret;
        frexp (s, &ret);
@@ -3026,7 +3056,7 @@ gfc_conv_intrinsic_merge (gfc_se * se, gfc_expr * expr)
   tree fsource;
   tree mask;
   tree type;
-  tree len;
+  tree len, len2;
   tree *args;
   unsigned int num_args;
 
@@ -3047,9 +3077,12 @@ gfc_conv_intrinsic_merge (gfc_se * se, gfc_expr * expr)
 	 also have to set the string length for the result.  */
       len = args[0];
       tsource = args[1];
+      len2 = args[2];
       fsource = args[3];
       mask = args[4];
 
+      conv_same_strlen_check ("MERGE", &expr->where, len, len2, &se->post);
+
       se->string_length = len;
     }
   type = TREE_TYPE (tsource);

gcc/testsuite/ChangeLog

+2008-12-17  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/38137
+	* gfortran.dg/merge_char_3.f90: New test.
+
 2008-12-15  Mikael Morin  <mikael.morin@tele2.fr>
 
 	PR fortran/38487

gcc/testsuite/gfortran.dg/merge_char_3.f90

+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Unequal character lengths" }
+
+! PR fortran/38137
+! Test that -fbounds-check detects unequal character lengths to MERGE
+! at runtime.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+subroutine foo(a)
+implicit none
+character(len=*) :: a
+character(len=3) :: b
+print *, merge(a,b,.true.)  ! Unequal character lengths
+end subroutine foo
+
+call foo("ab")
+end