This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[PATCH] Fix ICE on ADVANCE= with CHARACTER variable rather than constant
- From: Jakub Jelinek <jakub at redhat dot com>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Tue, 14 Mar 2006 05:12:05 -0500
- Subject: [PATCH] Fix ICE on ADVANCE= with CHARACTER variable rather than constant
- Reply-to: Jakub Jelinek <jakub at redhat dot com>
Hi!
Since December we ICE on attached valid testcase (advance_2.f90) as
well as invalid one (advance_3.f90). Although check_io_constraints
guards use of not_no and not_yes with expr->expr_type == EXPR_CONSTANT,
already the computation of not_no and not_yes will crash if it is
not a constant. Also, we need to check for BT_CHARACTER, otherwise
we crash on invalid source even before we reach the place where we
error on invalid type of ADVANCE= argument.
Ok for trunk and 4.1.1 (this is 4.0.x regression)?
2006-03-14 Jakub Jelinek <jakub@redhat.com>
* io.c (check_io_constraints): Don't look at
dt->advance->value.charater.string, unless it is a CHARACTER
constant.
* gfortran.dg/advance_2.f90: New test.
* gfortran.dg/advance_3.f90: New test.
--- gcc/fortran/io.c.jj 2006-02-24 11:50:32.000000000 +0100
+++ gcc/fortran/io.c 2006-03-14 09:08:31.000000000 +0100
@@ -2317,30 +2317,34 @@ if (condition) \
if (dt->advance)
{
- const char * advance;
int not_yes, not_no;
expr = dt->advance;
- advance = expr->value.character.string;
io_constraint (dt->format_label == &format_asterisk,
"List directed format(*) is not allowed with a "
"ADVANCE=specifier at %L.", &expr->where);
- not_no = strncasecmp (advance, "no", 2) != 0;
- not_yes = strncasecmp (advance, "yes", 2) != 0;
+ if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_CHARACTER)
+ {
+ const char * advance = expr->value.character.string;
+ not_no = strncasecmp (advance, "no", 2) != 0;
+ not_yes = strncasecmp (advance, "yes", 2) != 0;
+ }
+ else
+ {
+ not_no = 0;
+ not_yes = 0;
+ }
- io_constraint (expr->expr_type == EXPR_CONSTANT
- && not_no && not_yes,
+ io_constraint (not_no && not_yes,
"ADVANCE=specifier at %L must have value = "
"YES or NO.", &expr->where);
- io_constraint (dt->size && expr->expr_type == EXPR_CONSTANT
- && not_no && k == M_READ,
+ io_constraint (dt->size && not_no && k == M_READ,
"SIZE tag at %L requires an ADVANCE = 'NO'",
&dt->size->where);
- io_constraint (dt->eor && expr->expr_type == EXPR_CONSTANT
- && not_no && k == M_READ,
+ io_constraint (dt->eor && not_no && k == M_READ,
"EOR tag at %L requires an ADVANCE = 'NO'",
&dt->eor_where);
}
--- gcc/testsuite/gfortran.dg/advance_2.f90.jj 2006-03-14 08:35:02.000000000 +0100
+++ gcc/testsuite/gfortran.dg/advance_2.f90 2006-03-14 08:35:31.000000000 +0100
@@ -0,0 +1,6 @@
+! { dg-do compile }
+subroutine foo
+ character(len=5) :: a
+ a = "yes"
+ write(*, '(a)', advance=a) "hello world"
+end subroutine foo
--- gcc/testsuite/gfortran.dg/advance_3.f90.jj 2006-03-14 08:35:42.000000000 +0100
+++ gcc/testsuite/gfortran.dg/advance_3.f90 2006-03-14 09:06:50.000000000 +0100
@@ -0,0 +1,8 @@
+subroutine foo
+ real :: a
+ a = 1
+ write(*, '(a)', advance=a) "hello world" ! { dg-error "must be of type CHARACTER" }
+end subroutine foo
+subroutine bar
+ write(*, '(a)', advance=5.) "hello world" ! { dg-error "must be of type CHARACTER" }
+end subroutine bar
Jakub