OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Daniel Kraft 2008-12-17 11:16:28 +01:00 committed by Daniel Kraft
parent af8a63d21d
commit 8c13133cc3
4 changed files with 64 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -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

35
gcc/fortran/trans-intrinsic.c
View File

@ -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);

5
gcc/testsuite/ChangeLog
View File

@ -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

19
gcc/testsuite/gfortran.dg/merge_char_3.f90 Normal file
View File

@ -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