diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 35 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/merge_char_3.f90 | 19 |
4 files changed, 64 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e3cacc2..3cd8c1a 100644 --- 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 --- 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 --- 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 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 |