diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2013-01-23 22:38:40 +0100 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2013-01-23 22:38:40 +0100 |
| commit | ad3e2ad2ffc774435804519077ca46d15410c928 (patch) | |
| tree | a50419966735bbe14f5ee33cfe0286665de91fd0 /gcc | |
| parent | 22938102bb10999dc6ed4e3b5313d5fa162141eb (diff) | |
| download | gcc-ad3e2ad2ffc774435804519077ca46d15410c928.zip gcc-ad3e2ad2ffc774435804519077ca46d15410c928.tar.gz gcc-ad3e2ad2ffc774435804519077ca46d15410c928.tar.bz2 | |
re PR fortran/56081 (Seg fault ICE on select with bad case)
2013-01-23 Janus Weil <janus@gcc.gnu.org>
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 <janus@gcc.gnu.org>
PR fortran/56081
* gfortran.dg/select_8.f90: New.
From-SVN: r195412
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 19 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/select_8.f90 | 12 |
4 files changed, 40 insertions, 4 deletions
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 <janus@gcc.gnu.org> + + 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 <jakub@redhat.com> 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 <janus@gcc.gnu.org> + + PR fortran/56081 + * gfortran.dg/select_8.f90: New. + 2013-01-23 David Holsgrove <david.holsgrove@xilinx.com> * 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 <richard@lozestech.com> + + implicit none + integer :: a(4) + select case(a) ! { dg-error "must be a scalar expression" } + case (0) + end select +end |