static try check_case_expr(g95_expr *g, g95_expr *selector) { if (g == NULL) return SUCCESS; if (g->type != EXPR_CONSTANT) { g95_error("Expression in CASE statement at %L must be a constant", &g->where); return FAILURE; } if (g->ts.type != selector->ts.type) { g95_error("Expression in CASE statement at %L must be of type %s", &g->where, g95_basic_typename(selector->ts.type)); return FAILURE; } if (g->ts.kind != selector->ts.kind) { g95_error("Expression in CASE statement at %L must be kind %d", &g->where, selector->ts.kind); return FAILURE; } if (g->rank != 0) { g95_error("Expression in CASE statement at %L must be scalar", &g->where); return FAILURE; } return SUCCESS; }
static try check_case_expr(g95_expr *e, g95_expr *selector) { int k, flag; if (e == NULL) return SUCCESS; if (e->type != EXPR_CONSTANT) { g95_error("Expression in CASE statement at %L must be a constant", &e->where); return FAILURE; } if (e->ts.type != selector->ts.type) { g95_error("Expression in CASE statement at %L must be of type %s", &e->where, g95_basic_typename(selector->ts.type)); return FAILURE; } if (selector->ts.type != BT_INTEGER && selector->ts.type != BT_LOGICAL && selector->ts.type != BT_CHARACTER) { g95_error("Selector in SELECT CASE statement cannot be type %s", g95_typename(&selector->ts)); return FAILURE; } if (e->ts.kind != selector->ts.kind && e->ts.type == BT_CHARACTER) { g95_error("Expression in CASE statement at %L must be kind %d", &e->where, selector->ts.kind); return FAILURE; } if (e->rank != 0) { g95_error("Expression in CASE statement at %L must be scalar", &e->where); return FAILURE; } if (e->ts.type == BT_INTEGER) { k = e->ts.kind; e->ts.kind = selector->ts.kind; flag = g95_range_check(e); e->ts.kind = k; if (flag) { g95_error("Integer overflow in CASE statement at %L", &e->where); return FAILURE; } } return SUCCESS; }
void g95_show_typespec(g95_typespec *typ) { g95_status("(%s ", g95_basic_typename(typ->type)); switch(typ->type) { case BT_DERIVED: g95_status("%s", typ->derived->name); break; case BT_CHARACTER: g95_show_expr(typ->cl->length); break; default: g95_status("%d", typ->kind); break; } g95_status(")"); }