aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog16
-rw-r--r--gcc/fortran/match.c54
-rw-r--r--gcc/fortran/trans-decl.c21
-rw-r--r--gcc/fortran/trans-stmt.c32
-rw-r--r--gcc/fortran/trans.h1
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/label_1.f901
-rw-r--r--libgfortran/ChangeLog13
-rw-r--r--libgfortran/gfortran.map5
-rw-r--r--libgfortran/libgfortran.h5
-rw-r--r--libgfortran/runtime/pause.c15
-rw-r--r--libgfortran/runtime/stop.c39
12 files changed, 146 insertions, 61 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
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index c6153d8..0f00141 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,16 @@
+2010-05-19 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/43851
+ * runtime/stop.c (error_stop_numeric): New function and updated comment.
+ Add declaration for stop_numeric and remove declaration for stop_string.
+ (stop_string): Use for blank STOP.
+ (stop_numeric): Remove use of special -1 stop code.
+ * runtime/pause.c (do_pause): Use stop_string for blank stop.
+ (pause_numeric): Remove use of special -1 pause code.
+ * gfortran.map: Add new symbol to run-time library.
+ * libgfortran.h: Move declaration for stop_string to here to make
+ function visible for do_pause. Remove declaration for stop_numeric.
+
2010-05-08 Janne Blomqvist <jb@gcc.gnu.org>
* io/unix.h (mem_alloc_r): Fix typo to reduce visibility.
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index bcca957..3e854eb 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1103,6 +1103,11 @@ GFORTRAN_1.3 {
_gfortran_error_stop_string;
} GFORTRAN_1.2;
+GFORTRAN_1.4 {
+ global:
+ _gfortran_error_stop_numeric;
+} GFORTRAN_1.3;
+
F2C_1.0 {
global:
_gfortran_f2c_specific__abs_c4;
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index f51ef00..99f7342 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -827,8 +827,9 @@ internal_proto(filename_from_unit);
/* stop.c */
-extern void stop_numeric (GFC_INTEGER_4) __attribute__ ((noreturn));
-iexport_proto(stop_numeric);
+extern void stop_string (const char *, GFC_INTEGER_4)
+ __attribute__ ((noreturn));
+export_proto(stop_string);
/* reshape_packed.c */
diff --git a/libgfortran/runtime/pause.c b/libgfortran/runtime/pause.c
index 7db536b..28edf6c 100644
--- a/libgfortran/runtime/pause.c
+++ b/libgfortran/runtime/pause.c
@@ -26,7 +26,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
#include <string.h>
-
static void
do_pause (void)
{
@@ -36,26 +35,24 @@ do_pause (void)
fgets(buff, 4, stdin);
if (strncmp(buff, "go\n", 3) != 0)
- stop_numeric (-1);
+ stop_string ('\0', 0);
st_printf ("RESUMED\n");
}
-/* A numeric or blank STOP statement. */
+/* A numeric PAUSE statement. */
-extern void pause_numeric (GFC_INTEGER_4 code);
+extern void pause_numeric (GFC_INTEGER_4);
export_proto(pause_numeric);
void
pause_numeric (GFC_INTEGER_4 code)
{
- if (code == -1)
- st_printf ("PAUSE\n");
- else
- st_printf ("PAUSE %d\n", (int)code);
-
+ st_printf ("PAUSE %d\n", (int) code);
do_pause ();
}
+/* A character string or blank PAUSE statement. */
+
extern void pause_string (char *string, GFC_INTEGER_4 len);
export_proto(pause_string);
diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 14a88c4..87c0411 100644
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -26,22 +26,20 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
#include <string.h>
-/* A numeric or blank STOP statement. */
+/* A numeric STOP statement. */
+
+extern void stop_numeric (GFC_INTEGER_4)
+ __attribute__ ((noreturn));
+export_proto(stop_numeric);
+
void
stop_numeric (GFC_INTEGER_4 code)
{
- if (code == -1)
- code = 0;
- else
- st_printf ("STOP %d\n", (int)code);
-
+ st_printf ("STOP %d\n", (int)code);
sys_exit (code);
}
-iexport(stop_numeric);
-
-extern void stop_string (const char *string, GFC_INTEGER_4 len);
-export_proto(stop_string);
+/* A character string or blank STOP statement. */
void
stop_string (const char *string, GFC_INTEGER_4 len)
@@ -54,14 +52,16 @@ stop_string (const char *string, GFC_INTEGER_4 len)
sys_exit (0);
}
-extern void error_stop_string (const char *, GFC_INTEGER_4);
-export_proto(error_stop_string);
-
/* Per Fortran 2008, section 8.4: "Execution of a STOP statement initiates
normal termination of execution. Execution of an ERROR STOP statement
initiates error termination of execution." Thus, error_stop_string returns
a nonzero exit status code. */
+
+extern void error_stop_string (const char *, GFC_INTEGER_4)
+ __attribute__ ((noreturn));
+export_proto(error_stop_string);
+
void
error_stop_string (const char *string, GFC_INTEGER_4 len)
{
@@ -72,3 +72,16 @@ error_stop_string (const char *string, GFC_INTEGER_4 len)
sys_exit (1);
}
+
+/* A numeric or blank ERROR STOP statement. */
+
+extern void error_stop_numeric (GFC_INTEGER_4)
+ __attribute__ ((noreturn));
+export_proto(error_stop_numeric);
+
+void
+error_stop_numeric (GFC_INTEGER_4 code)
+{
+ st_printf ("ERROR STOP %d\n", (int) code);
+ sys_exit (code);
+}
generated by cgit v1.1 at 2025-08-10 20:13:42 +0000