[PATCH] fortran/25106 -- Statement labels are nonzero.
Steve Kargl
sgk@troutmask.apl.washington.edu
Sun Nov 27 16:54:00 GMT 2005
The attach patch has been bootstrapped and regression
tested on i386-*-freebsd for mainline. I'm currently
bootstrap and regtesting on amd64-*-freebsd on both
4.1 and mainline. OK for 4.1 and mainline once amd64
completes.
Here's the problem.
kargl[206] cat jvm1.f90
0 CONTINUE
END
kargl[205] gfc41 -o z jvm1.f90
In file jvm1.f90:1
0 CONTINUE
1
Warning: Ignoring statement label of zero at (1)
In file jvm1.f90:2
END
1
Internal Error at (1):
free_expr0(): Bad expr type
This patch converts the warning into an error if the new
-fstatement-label-0 flag is not given. The F95 standard
on page 24 says "Constraint: At least one digit in a label
shall be nonzero." Note, this patch also fixes the
parastic Internal Error. Also note, there is no negative
form of this flag. You either get an error or a warning.
The only way to turn off the warning is with the -w option.
2005-11-27 Steven G. Kargl <kargls@comcast.net>
PR fortran/25106
* gfortran.h: New flag -fstatement-label-0
* match.c (gfc_match_st_label): Eliminate second argument,
improve warning/error handling;
(gfc_match_small_int,gfc_match,gfc_match_do,gfc_match_goto):
Update function calls.
* match.h (gfc_match_st_label): Update prototype.
* lang.opt: Add option; Alphabetize other out-of-order options.
* io.c (match_dt_format): Update function calls.
* parse.c (next_free): Update function calls; Eliminate warning.
* invoke.texi: Document option.
* options.c (gfc_init_options,gfc_post_options,gfc_handle_option):
Set option.
2005-11-27 Steven G. Kargl <kargls@comcast.net>
PR fortran/25106
gfortran.dg/statement_label_1.f90: New tests.
gfortran.dg/statement_label_2.f90: New tests.
--
Steve
-------------- next part --------------
Index: io.c
===================================================================
--- io.c (revision 107562)
+++ io.c (working copy)
@@ -1590,7 +1590,7 @@ match_dt_format (gfc_dt * dt)
return MATCH_YES;
}
- if (gfc_match_st_label (&label, 0) == MATCH_YES)
+ if (gfc_match_st_label (&label) == MATCH_YES)
{
if (dt->format_expr != NULL || dt->format_label != NULL)
{
Index: gfortran.h
===================================================================
--- gfortran.h (revision 107562)
+++ gfortran.h (working copy)
@@ -1489,6 +1489,7 @@ typedef struct
int flag_backslash;
int flag_cray_pointer;
int flag_d_lines;
+ int flag_statement_label_0;
int q_kind;
Index: match.c
===================================================================
--- match.c (revision 107562)
+++ match.c (working copy)
@@ -217,7 +217,7 @@ gfc_match_small_int (int *value)
do most of the work. */
match
-gfc_match_st_label (gfc_st_label ** label, int allow_zero)
+gfc_match_st_label (gfc_st_label ** label)
{
locus old_loc;
match m;
@@ -229,13 +229,22 @@ gfc_match_st_label (gfc_st_label ** labe
if (m != MATCH_YES)
return m;
- if (((i == 0) && allow_zero) || i <= 99999)
+ if (i == 0)
+ {
+ if (gfc_option.flag_statement_label_0)
+ gfc_error_now ("Statement label at %C must be nonzero");
+ else if (!inhibit_warnings)
+ gfc_warning_now ("Extension: statement label at %C is zero");
+ }
+
+ if (i <= 99999)
{
*label = gfc_get_st_label (i);
return MATCH_YES;
}
gfc_error ("Statement label at %C is out of range");
+
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -690,7 +699,7 @@ loop:
case 'l':
label = va_arg (argp, gfc_st_label **);
- n = gfc_match_st_label (label, 0);
+ n = gfc_match_st_label (label);
if (n != MATCH_YES)
{
m = n;
@@ -1242,7 +1251,7 @@ gfc_match_do (void)
if (gfc_match (" do") != MATCH_YES)
return MATCH_NO;
- m = gfc_match_st_label (&label, 0);
+ m = gfc_match_st_label (&label);
if (m == MATCH_ERROR)
goto cleanup;
@@ -1275,7 +1284,7 @@ gfc_match_do (void)
gfc_match_label (); /* This won't error */
gfc_match (" do "); /* This will work */
- gfc_match_st_label (&label, 0); /* Can't error out */
+ gfc_match_st_label (&label); /* Can't error out */
gfc_match_char (','); /* Optional comma */
m = gfc_match_iterator (&iter, 0);
@@ -1585,7 +1594,7 @@ gfc_match_goto (void)
do
{
- m = gfc_match_st_label (&label, 0);
+ m = gfc_match_st_label (&label);
if (m != MATCH_YES)
goto syntax;
@@ -1631,7 +1640,7 @@ gfc_match_goto (void)
do
{
- m = gfc_match_st_label (&label, 0);
+ m = gfc_match_st_label (&label);
if (m != MATCH_YES)
goto syntax;
Index: lang.opt
===================================================================
--- lang.opt (revision 107562)
+++ lang.opt (working copy)
@@ -77,6 +77,10 @@ fbackslash
Fortran
Specify that backslash in string introduces an escape character
+fcray-pointer
+Fortran
+Use the Cray Pointer extension
+
fdefault-double-8
Fortran
Set the default double precision kind to an 8 byte wide type
@@ -113,26 +117,14 @@ ffixed-form
Fortran
Assume that the source file is fixed form
+ffpe-trap=
+Fortran RejectNegative JoinedOrMissing
+-ffpe-trap=[..] Stop on following floating point exceptions
+
ffree-form
Fortran
Assume that the source file is free form
-funderscoring
-Fortran
-Append underscores to externally visible names
-
-fcray-pointer
-Fortran
-Use the Cray Pointer extension
-
-fsecond-underscore
-Fortran
-Append a second underscore if the name already contains an underscore
-
-fimplicit-none
-Fortran
-Specify that no implicit typing is allowed, unless overridden by explicit IMPLICIT statements
-
ffixed-line-length-none
Fortran RejectNegative
Allow arbitrary character line width in fixed mode
@@ -141,6 +133,10 @@ ffixed-line-length-
Fortran RejectNegative Joined UInteger
-ffixed-line-length-<n> Use n as character line width in fixed mode
+fimplicit-none
+Fortran
+Specify that no implicit typing is allowed, unless overridden by explicit IMPLICIT statements
+
fmax-identifier-length=
Fortran RejectNegative Joined UInteger
-fmax-identifier-length=<n> Maximum identifier length
@@ -165,14 +161,26 @@ frepack-arrays
Fortran
Copy array sections into a contiguous block on procedure entry
+fsecond-underscore
+Fortran
+Append a second underscore if the name already contains an underscore
+
+fshort-enums
+Fortran
+Use the narrowest integer type possible for enumeration types
+
+fstatement-label-0
+Fortran RejectNegative
+Permit a statement label of 0
+
+funderscoring
+Fortran
+Append underscores to externally visible names
+
qkind=
Fortran RejectNegative Joined UInteger
-qkind=<n> Set the kind for a real with the 'q' exponent to 'n'
-ffpe-trap=
-Fortran RejectNegative JoinedOrMissing
--ffpe-trap=[..] Stop on following floating point exceptions
-
std=f95
Fortran
Conform to the ISO Fortran 95 standard
@@ -188,9 +196,5 @@ Conform nothing in particular
std=legacy
Fortran
Accept extensions to support legacy code
-
-fshort-enums
-Fortran
-Use the narrowest integer type possible for enumeration types
; This comment is to ensure we retain the blank line above.
Index: match.h
===================================================================
--- match.h (revision 107562)
+++ match.h (working copy)
@@ -41,7 +41,7 @@ extern gfc_st_label *gfc_statement_label
match gfc_match_space (void);
match gfc_match_eos (void);
match gfc_match_small_literal_int (int *);
-match gfc_match_st_label (gfc_st_label **, int);
+match gfc_match_st_label (gfc_st_label **);
match gfc_match_label (void);
match gfc_match_small_int (int *);
int gfc_match_strings (mstring *);
Index: parse.c
===================================================================
--- parse.c (revision 107562)
+++ parse.c (working copy)
@@ -318,7 +319,7 @@ next_free (void)
if (ISDIGIT (c))
{
/* Found a statement label? */
- m = gfc_match_st_label (&gfc_statement_label, 0);
+ m = gfc_match_st_label (&gfc_statement_label);
d = gfc_peek_char ();
if (m != MATCH_YES || !gfc_is_whitespace (d))
@@ -334,13 +335,6 @@ next_free (void)
else
{
label_locus = gfc_current_locus;
-
- if (gfc_statement_label->value == 0)
- {
- gfc_warning_now ("Ignoring statement label of zero at %C");
- gfc_free_st_label (gfc_statement_label);
- gfc_statement_label = NULL;
- }
gfc_gobble_whitespace ();
Index: invoke.texi
===================================================================
--- invoke.texi (revision 107562)
+++ invoke.texi (working copy)
@@ -120,7 +120,7 @@ by type. Explanations are in the follow
-std=@var{std} -fd-lines-as-code -fd-lines-as-comments @gol
-ffixed-line-length-@var{n} -ffixed-line-length-none @gol
-fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 @gol
--fcray-pointer }
+-fcray-pointer -fstatement-label-0}
@item Warning Options
@xref{Warning Options,,Options to Request or Suppress Warnings}.
@@ -757,14 +757,17 @@ This option is provided for interoperabi
compiled with the @command{-fshort-enums} option. It will make
@command{gfortran} choose the smallest @code{INTEGER} kind a given
enumerator set will fit in, and give all its enumerators this kind.
+
+@cindex -fstatement-label-0
+@item -fstatement-label-0
+Permit a statement of 0.
+
@end table
@xref{Code Gen Options,,Options for Code Generation Conventions,
gcc,Using the GNU Compiler Collection (GCC)}, for information on more options
offered by the GBE
shared by @command{gfortran} @command{gcc} and other GNU compilers.
-
-
@c man end
@node Environment Variables
Index: options.c
===================================================================
--- options.c (revision 107562)
+++ options.c (working copy)
@@ -71,6 +71,7 @@ gfc_init_options (unsigned int argc ATTR
gfc_option.flag_no_backend = 0;
gfc_option.flag_pack_derived = 0;
gfc_option.flag_repack_arrays = 0;
+ gfc_option.flag_statement_label_0 = 1;
gfc_option.flag_automatic = 1;
gfc_option.flag_backslash = 1;
gfc_option.flag_cray_pointer = 0;
@@ -236,7 +237,11 @@ gfc_post_options (const char **pfilename
/* If -pedantic, warn about the use of GNU extensions. */
if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
- gfc_option.warn_std |= GFC_STD_GNU;
+ {
+ gfc_option.warn_std |= GFC_STD_GNU;
+ gfc_option.flag_statement_label_0 = 1;
+ }
+
/* -std=legacy -pedantic is effectively -std=gnu. */
if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0)
gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_LEGACY;
@@ -474,6 +479,10 @@ gfc_handle_option (size_t scode, const c
gfc_fatal_error ("Maximum supported idenitifier length is %d",
GFC_MAX_SYMBOL_LEN);
gfc_option.max_identifier_length = value;
+ break;
+
+ case OPT_fstatement_label_0:
+ gfc_option.flag_statement_label_0 = 0;
break;
case OPT_qkind_:
-------------- next part --------------
! { dg-do compile }
! PR 25106
program z
0 continue ! { dg-error "Statement label at" }
end program z
-------------- next part --------------
! { dg-do compile }
! { dg-options "-fstatement-label-0" }
! PR 25106
program z
0 continue ! { dg-warning "statement label at" }
end program z
More information about the Fortran
mailing list