From ad3e2ad2ffc774435804519077ca46d15410c928 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Wed, 23 Jan 2013 22:38:40 +0100 Subject: [PATCH] re PR fortran/56081 (Seg fault ICE on select with bad case) 2013-01-23 Janus Weil PR fortran/56081 * resolve.c (resolve_select): Add argument 'select_type', reject non-scalar expressions. (resolve_select_type,resolve_code): Pass new argument to 'resolve_select'. 2013-01-23 Janus Weil PR fortran/56081 * gfortran.dg/select_8.f90: New. From-SVN: r195412 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/resolve.c | 19 +++++++++++++++---- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/select_8.f90 | 12 ++++++++++++ 4 files changed, 40 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/select_8.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6825ab1..102f212 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2013-01-23 Janus Weil + + PR fortran/56081 + * resolve.c (resolve_select): Add argument 'select_type', reject + non-scalar expressions. + (resolve_select_type,resolve_code): Pass new argument to + 'resolve_select'. + 2013-01-23 Jakub Jelinek PR fortran/56052 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c6a6756..ddb6d67 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7935,7 +7935,7 @@ validate_case_label_expr (gfc_expr *e, gfc_expr *case_expr) expression. */ static void -resolve_select (gfc_code *code) +resolve_select (gfc_code *code, bool select_type) { gfc_code *body; gfc_expr *case_expr; @@ -7965,8 +7965,9 @@ resolve_select (gfc_code *code) } case_expr = code->expr1; - type = case_expr->ts.type; + + /* F08:C830. */ if (type != BT_LOGICAL && type != BT_INTEGER && type != BT_CHARACTER) { gfc_error ("Argument of SELECT statement at %L cannot be %s", @@ -7976,6 +7977,16 @@ resolve_select (gfc_code *code) return; } + /* F08:R842. */ + if (!select_type && case_expr->rank != 0) + { + gfc_error ("Argument of SELECT statement at %L must be a scalar " + "expression", &case_expr->where); + + /* Punt. */ + return; + } + /* Raise a warning if an INTEGER case value exceeds the range of the case-expr. Later, all expressions will be promoted to the largest kind of all case-labels. */ @@ -8668,7 +8679,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) gfc_resolve_blocks (code->block, gfc_current_ns); gfc_current_ns = old_ns; - resolve_select (code); + resolve_select (code, true); } @@ -10285,7 +10296,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_SELECT: /* Select is complicated. Also, a SELECT construct could be a transformed computed GOTO. */ - resolve_select (code); + resolve_select (code, false); break; case EXEC_SELECT_TYPE: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7bfa569..8bcbca5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-01-23 Janus Weil + + PR fortran/56081 + * gfortran.dg/select_8.f90: New. + 2013-01-23 David Holsgrove * gcc.target/microblaze/microblaze.exp: Remove target_config_cflags check diff --git a/gcc/testsuite/gfortran.dg/select_8.f90 b/gcc/testsuite/gfortran.dg/select_8.f90 new file mode 100644 index 0000000..910d393 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_8.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! +! PR 56081: [4.7/4.8 Regression] Segfault ICE on select with bad case +! +! Contributed by Richard L Lozes + + implicit none + integer :: a(4) + select case(a) ! { dg-error "must be a scalar expression" } + case (0) + end select +end -- 2.7.4