diff options
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/ChangeLog | 16 | ||||
-rw-r--r-- | gcc/fortran/match.c | 54 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 21 | ||||
-rw-r--r-- | gcc/fortran/trans-stmt.c | 32 | ||||
-rw-r--r-- | gcc/fortran/trans.h | 1 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/label_1.f90 | 1 |
7 files changed, 93 insertions, 37 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0d8fa43..a1bc38e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2010-05-19 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/43851 + * trans-stmt.c (gfc_trans_stop): Add generation of call to + gfortran_error_stop_numeric. Fix up some whitespace. Use stop_string for + blank STOP, handling a null expression. (gfc_trans_pause): Use + pause_string for blank PAUSE. + * trans.h: Add external function declaration for error_stop_numeric. + * trans-decl.c (gfc_build_builtin_function_decls): Add the building of + the declaration for the library call. Adjust whitespaces. + * match.c (gfc_match_stopcode): Remove use of the actual stop code to + signal no stop code. Match the expression following the stop and pass + that to the translators. Remove the old use of digit matching. Add + checks that the stop_code expression is INTEGER or CHARACTER, constant, + and if CHARACTER, default character KIND. + 2010-05-19 Daniel Franke <franke.daniel@gmail.com> PR fortran/44055 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 3dfe088..0f970f6 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2006,42 +2006,23 @@ gfc_match_cycle (void) static match gfc_match_stopcode (gfc_statement st) { - int stop_code; gfc_expr *e; match m; - int cnt; - stop_code = -1; e = NULL; if (gfc_match_eos () != MATCH_YES) { - m = gfc_match_small_literal_int (&stop_code, &cnt); + m = gfc_match_expr (&e); if (m == MATCH_ERROR) goto cleanup; - - if (m == MATCH_YES && cnt > 5) - { - gfc_error ("Too many digits in STOP code at %C"); - goto cleanup; - } - if (m == MATCH_NO) - { - /* Try a character constant. */ - m = gfc_match_expr (&e); - if (m == MATCH_ERROR) - goto cleanup; - if (m == MATCH_NO) - goto syntax; - if (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_CONSTANT) - goto syntax; - } - - if (gfc_match_eos () != MATCH_YES) goto syntax; } + if (gfc_match_eos () != MATCH_YES) + goto syntax; + if (gfc_pure (NULL)) { gfc_error ("%s statement not allowed in PURE procedure at %C", @@ -2055,6 +2036,31 @@ gfc_match_stopcode (gfc_statement st) return MATCH_ERROR; } + if (e != NULL) + { + if (!(e->ts.type == BT_CHARACTER || e->ts.type == BT_INTEGER)) + { + gfc_error ("STOP code at %L must be either INTEGER or CHARACTER type", + &e->where); + return MATCH_ERROR; + } + + if (e->ts.type == BT_CHARACTER + && e->ts.kind != gfc_default_character_kind) + { + gfc_error ("STOP code at %L must be default character KIND=%d", + &e->where, (int) gfc_default_character_kind); + return MATCH_ERROR; + } + + if (e->expr_type != EXPR_CONSTANT) + { + gfc_error ("STOP code at %L must be a constant expression", + &e->where); + return MATCH_ERROR; + } + } + switch (st) { case ST_STOP: @@ -2071,7 +2077,7 @@ gfc_match_stopcode (gfc_statement st) } new_st.expr1 = e; - new_st.ext.stop_code = stop_code; + new_st.ext.stop_code = -1; return MATCH_YES; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index c523a5c..fa82679 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -86,6 +86,7 @@ tree gfor_fndecl_pause_numeric; tree gfor_fndecl_pause_string; tree gfor_fndecl_stop_numeric; tree gfor_fndecl_stop_string; +tree gfor_fndecl_error_stop_numeric; tree gfor_fndecl_error_stop_string; tree gfor_fndecl_runtime_error; tree gfor_fndecl_runtime_error_at; @@ -2774,23 +2775,33 @@ gfc_build_builtin_function_decls (void) gfor_fndecl_stop_numeric = gfc_build_library_function_decl (get_identifier (PREFIX("stop_numeric")), void_type_node, 1, gfc_int4_type_node); - /* Stop doesn't return. */ + /* STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric) = 1; + gfor_fndecl_stop_string = gfc_build_library_function_decl (get_identifier (PREFIX("stop_string")), void_type_node, 2, pchar_type_node, - gfc_int4_type_node); - /* Stop doesn't return. */ + gfc_int4_type_node); + /* STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1; + + gfor_fndecl_error_stop_numeric = + gfc_build_library_function_decl (get_identifier (PREFIX("error_stop_numeric")), + void_type_node, 1, gfc_int4_type_node); + /* ERROR STOP doesn't return. */ + TREE_THIS_VOLATILE (gfor_fndecl_error_stop_numeric) = 1; + + gfor_fndecl_error_stop_string = gfc_build_library_function_decl (get_identifier (PREFIX("error_stop_string")), void_type_node, 2, pchar_type_node, - gfc_int4_type_node); + gfc_int4_type_node); /* ERROR STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_error_stop_string) = 1; + gfor_fndecl_pause_numeric = gfc_build_library_function_decl (get_identifier (PREFIX("pause_numeric")), void_type_node, 1, gfc_int4_type_node); @@ -2798,7 +2809,7 @@ gfc_build_builtin_function_decls (void) gfor_fndecl_pause_string = gfc_build_library_function_decl (get_identifier (PREFIX("pause_string")), void_type_node, 2, pchar_type_node, - gfc_int4_type_node); + gfc_int4_type_node); gfor_fndecl_runtime_error = gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error")), diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index f618f02..7929464 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -552,9 +552,17 @@ gfc_trans_pause (gfc_code * code) if (code->expr1 == NULL) { - tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code); + tmp = build_int_cst (gfc_int4_type_node, 0); tmp = build_call_expr_loc (input_location, - gfor_fndecl_pause_numeric, 1, tmp); + gfor_fndecl_pause_string, 2, + build_int_cst (pchar_type_node, 0), tmp); + } + else if (code->expr1->ts.type == BT_INTEGER) + { + gfc_conv_expr (&se, code->expr1); + tmp = build_call_expr_loc (input_location, + gfor_fndecl_pause_numeric, 1, + fold_convert (gfc_int4_type_node, se.expr)); } else { @@ -588,17 +596,27 @@ gfc_trans_stop (gfc_code *code, bool error_stop) if (code->expr1 == NULL) { - tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code); + tmp = build_int_cst (gfc_int4_type_node, 0); + tmp = build_call_expr_loc (input_location, + error_stop ? gfor_fndecl_error_stop_string + : gfor_fndecl_stop_string, + 2, build_int_cst (pchar_type_node, 0), tmp); + } + else if (code->expr1->ts.type == BT_INTEGER) + { + gfc_conv_expr (&se, code->expr1); tmp = build_call_expr_loc (input_location, - gfor_fndecl_stop_numeric, 1, tmp); + error_stop ? gfor_fndecl_error_stop_numeric + : gfor_fndecl_stop_numeric, 1, + fold_convert (gfc_int4_type_node, se.expr)); } else { gfc_conv_expr_reference (&se, code->expr1); tmp = build_call_expr_loc (input_location, - error_stop ? gfor_fndecl_error_stop_string - : gfor_fndecl_stop_string, - 2, se.expr, se.string_length); + error_stop ? gfor_fndecl_error_stop_string + : gfor_fndecl_stop_string, + 2, se.expr, se.string_length); } gfc_add_expr_to_block (&se.pre, tmp); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 8e2b688..9ee8148 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -538,6 +538,7 @@ extern GTY(()) tree gfor_fndecl_pause_numeric; extern GTY(()) tree gfor_fndecl_pause_string; extern GTY(()) tree gfor_fndecl_stop_numeric; extern GTY(()) tree gfor_fndecl_stop_string; +extern GTY(()) tree gfor_fndecl_error_stop_numeric; extern GTY(()) tree gfor_fndecl_error_stop_string; extern GTY(()) tree gfor_fndecl_runtime_error; extern GTY(()) tree gfor_fndecl_runtime_error_at; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b798cd6..a3658db 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-05-19 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/43851 + * gfortran.dg/label_1.f90: Update test. + 2010-05-19 Jan Hubicka <jh@suse.cz> * gcc.dg/lto/ipareference2_0.c: New file. diff --git a/gcc/testsuite/gfortran.dg/label_1.f90 b/gcc/testsuite/gfortran.dg/label_1.f90 index 94f3b5e..b5959da 100644 --- a/gcc/testsuite/gfortran.dg/label_1.f90 +++ b/gcc/testsuite/gfortran.dg/label_1.f90 @@ -4,7 +4,6 @@ program a 0056780 continue ! { dg-error "Too many digits" } 0 continue ! { dg-error "Zero is not a valid statement label" } - stop 001234 ! { dg-error "Too many digits" } end program a |