From: domob Date: Wed, 17 Dec 2008 10:16:28 +0000 (+0000) Subject: 2008-12-17 Daniel Kraft X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=f24d382c97a8ef347ac6de422176d8940576f332 2008-12-17 Daniel Kraft 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 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 e3cacc2b175..3cd8c1aae47 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2008-12-17 Daniel Kraft + + 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 PR fortran/38487 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 629ec0afb03..577cd20d17f 100644 --- 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 fcb0a40431f..74b39a4eaf6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-12-17 Daniel Kraft + + PR fortran/38137 + * gfortran.dg/merge_char_3.f90: New test. + 2008-12-15 Mikael Morin 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 index 00000000000..498e3ec73c5 --- /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 + +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