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/fortran/resolve.c | |
| 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/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 19 |
1 files changed, 15 insertions, 4 deletions
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: |