diff options
| author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-01-23 21:38:40 +0000 |
|---|---|---|
| committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-01-23 21:38:40 +0000 |
| commit | c58ba4b23d1d0894c5b57dedff2fd5b93f777e22 (patch) | |
| tree | a50419966735bbe14f5ee33cfe0286665de91fd0 | |
| parent | d5223a1f7f6959760acae732f3b17c3722eb4964 (diff) | |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@195412 138bc75d-0d04-0410-961f-82ee72b054a4
| -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 6825ab11123..102f21251e7 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 c6a6756c0f0..ddb6d67aaf2 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 7bfa5697d3c..8bcbca513a2 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 00000000000..910d3939a4a --- /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 |