diff options
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: |