void g95_free_case_list(g95_case *p) {
g95_case *q;
for(;p ;p=q) {
q = p->next;
free_case(p);
}
}
static match match_case_selector(g95_case **cp) {
g95_case *c;
match m;
c = g95_get_case();
c->where = g95_current_locus;
if (g95_match_char(':') == MATCH_YES) {
m = g95_match_init_expr(&c->high);
if (m == MATCH_NO) goto need_expr;
if (m == MATCH_ERROR) goto cleanup;
if (c->high->ts.type == BT_LOGICAL)
goto logical_range;
goto done;
}
m = g95_match_init_expr(&c->low);
if (m == MATCH_ERROR) goto cleanup;
if (m == MATCH_NO) goto need_expr;
if (g95_match_char(':') != MATCH_YES)
c->high = c->low; /* Make a range out of a single target */
else {
m = g95_match_init_expr(&c->high);
if (m == MATCH_ERROR) goto cleanup;
if (m == MATCH_NO) goto done; /* It's OK if nothing is there! */
if (c->high->ts.type == BT_LOGICAL)
goto logical_range;
}
done:
*cp = c;
return MATCH_YES;
logical_range:
g95_error("Logical range in CASE statement at %C not allowed");
goto cleanup;
need_expr:
g95_error("Expected expression in CASE at %C");
cleanup:
free_case(c);
return MATCH_ERROR;
}
static void
free_stmt(PLpgSQL_stmt *stmt)
{
switch ((enum PLpgSQL_stmt_types) stmt->cmd_type)
{
case PLPGSQL_STMT_BLOCK:
free_block((PLpgSQL_stmt_block *) stmt);
break;
case PLPGSQL_STMT_ASSIGN:
free_assign((PLpgSQL_stmt_assign *) stmt);
break;
case PLPGSQL_STMT_IF:
free_if((PLpgSQL_stmt_if *) stmt);
break;
case PLPGSQL_STMT_CASE:
free_case((PLpgSQL_stmt_case *) stmt);
break;
case PLPGSQL_STMT_LOOP:
free_loop((PLpgSQL_stmt_loop *) stmt);
break;
case PLPGSQL_STMT_WHILE:
free_while((PLpgSQL_stmt_while *) stmt);
break;
case PLPGSQL_STMT_FORI:
free_fori((PLpgSQL_stmt_fori *) stmt);
break;
case PLPGSQL_STMT_FORS:
free_fors((PLpgSQL_stmt_fors *) stmt);
break;
case PLPGSQL_STMT_FORC:
free_forc((PLpgSQL_stmt_forc *) stmt);
break;
case PLPGSQL_STMT_FOREACH_A:
free_foreach_a((PLpgSQL_stmt_foreach_a *) stmt);
break;
case PLPGSQL_STMT_EXIT:
free_exit((PLpgSQL_stmt_exit *) stmt);
break;
case PLPGSQL_STMT_RETURN:
free_return((PLpgSQL_stmt_return *) stmt);
break;
case PLPGSQL_STMT_RETURN_NEXT:
free_return_next((PLpgSQL_stmt_return_next *) stmt);
break;
case PLPGSQL_STMT_RETURN_QUERY:
free_return_query((PLpgSQL_stmt_return_query *) stmt);
break;
case PLPGSQL_STMT_RAISE:
free_raise((PLpgSQL_stmt_raise *) stmt);
break;
case PLPGSQL_STMT_ASSERT:
free_assert((PLpgSQL_stmt_assert *) stmt);
break;
case PLPGSQL_STMT_EXECSQL:
free_execsql((PLpgSQL_stmt_execsql *) stmt);
break;
case PLPGSQL_STMT_DYNEXECUTE:
free_dynexecute((PLpgSQL_stmt_dynexecute *) stmt);
break;
case PLPGSQL_STMT_DYNFORS:
free_dynfors((PLpgSQL_stmt_dynfors *) stmt);
break;
case PLPGSQL_STMT_GETDIAG:
free_getdiag((PLpgSQL_stmt_getdiag *) stmt);
break;
case PLPGSQL_STMT_OPEN:
free_open((PLpgSQL_stmt_open *) stmt);
break;
case PLPGSQL_STMT_FETCH:
free_fetch((PLpgSQL_stmt_fetch *) stmt);
break;
case PLPGSQL_STMT_CLOSE:
free_close((PLpgSQL_stmt_close *) stmt);
break;
case PLPGSQL_STMT_PERFORM:
free_perform((PLpgSQL_stmt_perform *) stmt);
break;
default:
elog(ERROR, "unrecognized cmd_type: %d", stmt->cmd_type);
break;
}
}
match g95_match_case(void) {
g95_case *c, *head, *tail;
match m;
head = tail = NULL;
if (g95_current_state() != COMP_SELECT) {
g95_error("Unexpected CASE statement at %C");
return MATCH_ERROR;
}
if (g95_match("% default") == MATCH_YES) {
m = match_case_eos();
if (m == MATCH_NO) goto syntax;
if (m == MATCH_ERROR) goto cleanup;
new_st.type = EXEC_SELECT;
new_st.ext.case_list = g95_get_case();
new_st.ext.case_list->where = g95_current_locus;
return MATCH_YES;
}
if (g95_match_char('(') != MATCH_YES)
goto syntax;
for(;;) {
if (match_case_selector(&c) == MATCH_ERROR)
goto cleanup;
/* Cases that can never be matched are legal to have but mess
* up code generation, so we discard them here. */
if (c->low != NULL && c->high != NULL && c->low != c->high &&
c->low->ts.type != BT_REAL && c->high->ts.type != BT_REAL &&
compare_expr(c->low, c->high) > 0) {
g95_warning(117, "Range specification at %C can never be matched");
free_case(c);
} else {
if (head == NULL)
head = c;
else
tail->next = c;
tail = c;
}
if (g95_match_char(')') == MATCH_YES) break;
if (g95_match_char(',') != MATCH_YES) goto syntax;
}
m = match_case_eos();
if (m == MATCH_NO) goto syntax;
if (m == MATCH_ERROR) goto cleanup;
new_st.type = EXEC_SELECT;
new_st.ext.case_list = head;
return MATCH_YES;
syntax:
g95_error("Syntax error in CASE-specification at %C");
cleanup:
g95_free_case_list(head);
g95_undo_statement();
return MATCH_ERROR;
}