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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@142791 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e3cacc2..3cd8c1a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 629ec0a..577cd20 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fcb0a40..74b39a4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/merge_char_3.f90 b/gcc/testsuite/gfortran.dg/merge_char_3.f90
new file mode 100644 (file)
index 0000000..498e3ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/merge_char_3.f90
@@ -0,0 +1,19 @@
+! { 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