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

re PR fortran/31822 (Missing run-time bound checks for character pointer => target)

Browse Source 
2008-12-18  Daniel Kraft  <d@domob.eu>

	PR fortran/31822
	* gfortran.h (gfc_check_same_strlen): Made public.
	* trans.h (gfc_trans_same_strlen_check): Made public.
	* check.c (gfc_check_same_strlen): Made public and adapted error
	message output to be useful not only for intrinsics.
	(gfc_check_merge): Adapt to gfc_check_same_strlen change.
	* expr.c (gfc_check_pointer_assign): Use gfc_check_same_strlen for
	string length compile-time check.
	* trans-expr.c (gfc_trans_pointer_assignment): Add runtime-check for
	equal string lengths using gfc_trans_same_strlen_check.
	* trans-intrinsic.c (gfc_trans_same_strlen_check): Renamed and made
	public from conv_same_strlen_check.
	(gfc_conv_intrinsic_merge): Adapted accordingly.

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

	PR fortran/31822
	* gfortran.dg/char_pointer_assign_2.f90: Updated expected error message
	to be more detailed.
	* gfortran.dg/char_pointer_assign_4.f90: New test.
	* gfortran.dg/char_pointer_assign_5.f90: New test.

From-SVN: r142808
This commit is contained in:
Daniel Kraft 2008-12-18 11:05:54 +01:00 committed by Daniel Kraft
parent ec81df7d4e
commit fb5bc08bb3
11 changed files with 125 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/fortran/ChangeLog
View File

@ -1,3 +1,19 @@
2008-12-18 Daniel Kraft <d@domob.eu>
PR fortran/31822
* gfortran.h (gfc_check_same_strlen): Made public.
* trans.h (gfc_trans_same_strlen_check): Made public.
* check.c (gfc_check_same_strlen): Made public and adapted error
message output to be useful not only for intrinsics.
(gfc_check_merge): Adapt to gfc_check_same_strlen change.
* expr.c (gfc_check_pointer_assign): Use gfc_check_same_strlen for
string length compile-time check.
* trans-expr.c (gfc_trans_pointer_assignment): Add runtime-check for
equal string lengths using gfc_trans_same_strlen_check.
* trans-intrinsic.c (gfc_trans_same_strlen_check): Renamed and made
public from conv_same_strlen_check.
(gfc_conv_intrinsic_merge): Adapted accordingly.
2008-12-17 Daniel Kraft <d@domob.eu>
PR fortran/38137

10
gcc/fortran/check.c
View File

@ -396,8 +396,8 @@ identical_dimen_shape (gfc_expr *a, int ai, gfc_expr *b, int bi)
/* Check whether two character expressions have the same length;
returns SUCCESS if they have or if the length cannot be determined. */
static gfc_try
check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name)
gfc_try
gfc_check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name)
{
long len_a, len_b;
len_a = len_b = -1;
@ -423,8 +423,8 @@ check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name)
if (len_a == len_b)
return SUCCESS;
gfc_error ("Unequal character lengths (%ld and %ld) in %s intrinsic "
"at %L", len_a, len_b, name, &a->where);
gfc_error ("Unequal character lengths (%ld/%ld) in %s at %L",
len_a, len_b, name, &a->where);
return FAILURE;
}
@ -2011,7 +2011,7 @@ gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
return FAILURE;
if (tsource->ts.type == BT_CHARACTER)
return check_same_strlen (tsource, fsource, "MERGE");
return gfc_check_same_strlen (tsource, fsource, "MERGE intrinsic");
return SUCCESS;
}

12
gcc/fortran/expr.c
View File

@ -3179,15 +3179,11 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
if (rvalue->expr_type == EXPR_NULL)
return SUCCESS;
if (lvalue->ts.type == BT_CHARACTER
&& lvalue->ts.cl && rvalue->ts.cl
&& lvalue->ts.cl->length && rvalue->ts.cl->length
&& abs (gfc_dep_compare_expr (lvalue->ts.cl->length,
rvalue->ts.cl->length)) == 1)
if (lvalue->ts.type == BT_CHARACTER)
{
gfc_error ("Different character lengths in pointer "
"assignment at %L", &lvalue->where);
return FAILURE;
gfc_try t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment");
if (t == FAILURE)
return FAILURE;
}
if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))

3
gcc/fortran/gfortran.h
View File

@ -2580,4 +2580,7 @@ void gfc_global_used (gfc_gsymbol *, locus *);
/* dependency.c */
int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
/* check.c */
gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
#endif /* GCC_GFORTRAN_H */

38
gcc/fortran/trans-expr.c
View File

@ -4016,7 +4016,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
tree tmp;
tree decl;
gfc_start_block (&block);
gfc_init_se (&lse, NULL);
@ -4039,15 +4038,32 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
gfc_add_block_to_block (&block, &lse.pre);
gfc_add_block_to_block (&block, &rse.pre);
/* Check character lengths if character expression. The test is only
really added if -fbounds-check is enabled. */
if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL)
{
gcc_assert (expr2->ts.type == BT_CHARACTER);
gcc_assert (lse.string_length && rse.string_length);
gfc_trans_same_strlen_check ("pointer assignment", &expr1->where,
lse.string_length, rse.string_length,
&block);
}
gfc_add_modify (&block, lse.expr,
fold_convert (TREE_TYPE (lse.expr), rse.expr));
gfc_add_block_to_block (&block, &rse.post);
gfc_add_block_to_block (&block, &lse.post);
}
else
{
tree strlen_lhs;
tree strlen_rhs = NULL_TREE;
/* Array pointer. */
gfc_conv_expr_descriptor (&lse, expr1, lss);
strlen_lhs = lse.string_length;
switch (expr2->expr_type)
{
case EXPR_NULL:
@ -4057,8 +4073,9 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
case EXPR_VARIABLE:
/* Assign directly to the pointer's descriptor. */
lse.direct_byref = 1;
lse.direct_byref = 1;
gfc_conv_expr_descriptor (&lse, expr2, rss);
strlen_rhs = lse.string_length;
/* If this is a subreference array pointer assignment, use the rhs
descriptor element size for the lhs span. */
@ -4071,7 +4088,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
tmp = gfc_get_element_type (TREE_TYPE (rse.expr));
tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
if (!INTEGER_CST_P (tmp))
gfc_add_block_to_block (&lse.post, &rse.pre);
gfc_add_block_to_block (&lse.post, &rse.pre);
gfc_add_modify (&lse.post, GFC_DECL_SPAN(decl), tmp);
}
@ -4086,10 +4103,23 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
lse.expr = tmp;
lse.direct_byref = 1;
gfc_conv_expr_descriptor (&lse, expr2, rss);
strlen_rhs = lse.string_length;
gfc_add_modify (&lse.pre, desc, tmp);
break;
}
}
gfc_add_block_to_block (&block, &lse.pre);
/* Check string lengths if applicable. The check is only really added
to the output code if -fbounds-check is enabled. */
if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL)
{
gcc_assert (expr2->ts.type == BT_CHARACTER);
gcc_assert (strlen_lhs && strlen_rhs);
gfc_trans_same_strlen_check ("pointer assignment", &expr1->where,
strlen_lhs, strlen_rhs, &block);
}
gfc_add_block_to_block (&block, &lse.post);
}
return gfc_finish_block (&block);

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

@ -751,9 +751,9 @@ gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
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)
void
gfc_trans_same_strlen_check (const char* intr_name, locus* where,
tree a, tree b, stmtblock_t* target)
{
tree cond;
tree name;
@ -769,8 +769,7 @@ conv_same_strlen_check (const char* intr_name, locus* where, tree a, tree b,
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",
"Unequal character lengths (%ld/%ld) in %s",
fold_convert (long_integer_type_node, a),
fold_convert (long_integer_type_node, b), name);
}
@ -3081,8 +3080,8 @@ gfc_conv_intrinsic_merge (gfc_se * se, gfc_expr * expr)
fsource = args[3];
mask = args[4];
conv_same_strlen_check ("MERGE", &expr->where, len, len2, &se->post);
gfc_trans_same_strlen_check ("MERGE intrinsic", &expr->where, len, len2,
&se->pre);
se->string_length = len;
}
type = TREE_TYPE (tsource);

4
gcc/fortran/trans.h
View File

@ -458,6 +458,10 @@ tree gfc_trans_runtime_error_vararg (bool, locus*, const char*, va_list);
void gfc_trans_runtime_check (bool, bool, tree, stmtblock_t *, locus *,
const char *, ...);
/* Generate a runtime check for same string length. */
void gfc_trans_same_strlen_check (const char*, locus*, tree, tree,
stmtblock_t*);
/* Generate a call to free() after checking that its arg is non-NULL. */
tree gfc_call_free (tree);

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
2008-12-18 Daniel Kraft <d@domob.eu>
PR fortran/31822
* gfortran.dg/char_pointer_assign_2.f90: Updated expected error message
to be more detailed.
* gfortran.dg/char_pointer_assign_4.f90: New test.
* gfortran.dg/char_pointer_assign_5.f90: New test.
2008-12-18 Jakub Jelinek <jakub@redhat.com>
PR middle-end/38533

4
gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90
View File

@ -6,6 +6,6 @@
character(5), pointer :: ch3(:)
ch2 => ch1 ! Check correct is OK
ch3 => ch1 ! { dg-error "Different character lengths" }
ch3 => ch1 ! { dg-error "Unequal character lengths \\(5/4\\)" }
end
end

20
gcc/testsuite/gfortran.dg/char_pointer_assign_4.f90 Normal file
View File

@ -0,0 +1,20 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Unequal character length" }
! PR fortran/31822
! Verify that runtime checks for matching character length
! in pointer assignment work.
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
program ptr
implicit none
character(len=10), target :: s1
character(len=5), pointer :: p1
integer, volatile :: i
i = 8
p1 => s1(1:i)
end program ptr
! { dg-output "Unequal character lengths \\(5/8\\)" }

23
gcc/testsuite/gfortran.dg/char_pointer_assign_5.f90 Normal file
View File

@ -0,0 +1,23 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Unequal character length" }
! PR fortran/31822
! Verify that runtime checks for matching character length
! in pointer assignment work.
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
program ptr
implicit none
character(len=10), target :: s1
call bar((/ s1, s1 /))
contains
subroutine bar(s)
character(len=*),target :: s(2)
character(len=17),pointer :: p(:)
p => s
end subroutine bar
end program ptr
! { dg-output "Unequal character lengths \\(17/10\\)" }