[patch, fortran] pr21061 - gfortran ignores -Werror
Bernhard Fischer
rep.nop@aon.at
Tue Mar 21 18:50:00 GMT 2006
Hi,
The attached patch fixes fortran/pr21061.
Please test and review.
I'm aware of the following problems with the testcases:
Some checks do fail, perhaps because the repeat the same output?
FAIL: gfortran.dg/warnings_are_errors_1.f -O (test for errors, line 13)
FAIL: gfortran.dg/warnings_are_errors_1.f -O (test for errors, line 14)
FAIL: gfortran.dg/warnings_are_errors_1.f -O (test for errors, line 16)
FAIL: gfortran.dg/warnings_are_errors_1.f -O (test for errors, line 17)
This one ignores -Werror since it uses the warning(0,...) function instead
of the gfc_() ones:
FAIL: gfortran.dg/warnings_are_errors_1.f90 -O (test for errors, line 11)
FAIL: gfortran.dg/warnings_are_errors_1.f90 -O (test for excess errors)
I'd be glad for hints on how to adjust the testcases to produce the
expected results proper.
Ok for trunk after the testcases are fixed?
2006-03-21 Bernhard Fischer <aldot@gcc.gnu.org>
PR fortran/21061
* error.c (gfc_warning): Rename to _gfc_warning.
(gfc_warning_now): Rename to _gfc_warning_now.
(gfc_error): Rename to _gfc_error.
(gfc_error_now): Rename to _gfc_error_now.
(gfc_warning): Call _gfc_warning or _gfc_error depending on
warnings_are_errors.
(gfc_warning_now): Likewise.
(gfc_notify_std): Likewise.
2006-03-21 Bernhard Fischer <aldot@gcc.gnu.org>
PR fortran/21061
* warnings_are_errors_1.f: New testcase.
* warnings_are_errors_1.f90: New testcase.
PS: re http://gcc.gnu.org/ml/fortran/2005-11/msg00730.html
I'm curious as to if there is consensus that we should use the generic
warning/error handling used throughout the rest of gcc. Personally i
like gfortran's attempt to point to the correct locus, as opposed to the
terse information e.g. the C frontend is giving with respect to the
column an error did occur.
-------------- next part --------------
Index: gcc-4.2/gcc/fortran/error.c
===================================================================
--- gcc-4.2/gcc/fortran/error.c (revision 112214)
+++ gcc-4.2/gcc/fortran/error.c (working copy)
@@ -23,7 +23,7 @@ Software Foundation, 51 Franklin Street,
/* Handle the inevitable errors. A major catch here is that things
flagged as errors in one match subroutine can conceivably be legal
elsewhere. This means that error messages are recorded and saved
- for possible use later. If a line does not match a legal
+ for possible later use. If a line does not match a legal
construction, then the saved error message is reported. */
#include "config.h"
@@ -461,107 +461,33 @@ error_printf (const char *nocmsgid, ...)
/* Issue a warning. */
-void
-gfc_warning (const char *nocmsgid, ...)
+static void
+_gfc_warning (const char *nocmsgid, va_list argp)
{
- va_list argp;
-
- if (inhibit_warnings)
- return;
warning_buffer.flag = 1;
warning_buffer.index = 0;
cur_error_buffer = &warning_buffer;
- va_start (argp, nocmsgid);
if (buffer_flag == 0)
warnings++;
error_print (_("Warning:"), _(nocmsgid), argp);
- va_end (argp);
-
- error_char ('\0');
-}
-
-
-/* Whether, for a feature included in a given standard set (GFC_STD_*),
- we should issue an error or a warning, or be quiet. */
-
-notification
-gfc_notification_std (int std)
-{
- bool warning;
-
- warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
- if ((gfc_option.allow_std & std) != 0 && !warning)
- return SILENT;
- return warning ? WARNING : ERROR;
}
-
-/* Possibly issue a warning/error about use of a nonstandard (or deleted)
- feature. An error/warning will be issued if the currently selected
- standard does not contain the requested bits. Return FAILURE if
- an error is generated. */
-
-try
-gfc_notify_std (int std, const char *nocmsgid, ...)
-{
- va_list argp;
- bool warning;
-
- warning = ((gfc_option.warn_std & std) != 0)
- && !inhibit_warnings;
- if ((gfc_option.allow_std & std) != 0
- && !warning)
- return SUCCESS;
-
- if (gfc_suppress_error)
- return warning ? SUCCESS : FAILURE;
-
- cur_error_buffer = warning ? &warning_buffer : &error_buffer;
- cur_error_buffer->flag = 1;
- cur_error_buffer->index = 0;
-
- if (buffer_flag == 0)
- {
- if (warning)
- warnings++;
- else
- errors++;
- }
- va_start (argp, nocmsgid);
- if (warning)
- error_print (_("Warning:"), _(nocmsgid), argp);
- else
- error_print (_("Error:"), _(nocmsgid), argp);
- va_end (argp);
-
- error_char ('\0');
- return warning ? SUCCESS : FAILURE;
-}
-
-
/* Immediate warning (i.e. do not buffer the warning). */
-void
-gfc_warning_now (const char *nocmsgid, ...)
+static void
+_gfc_warning_now (const char *nocmsgid, va_list argp)
{
- va_list argp;
int i;
- if (inhibit_warnings)
- return;
-
i = buffer_flag;
buffer_flag = 0;
warnings++;
- va_start (argp, nocmsgid);
error_print (_("Warning:"), _(nocmsgid), argp);
- va_end (argp);
- error_char ('\0');
buffer_flag = i;
}
@@ -590,9 +516,20 @@ gfc_warning_check (void)
}
}
-
/* Issue an error. */
+static void
+_gfc_error (const char *nocmsgid, va_list argp)
+{
+ error_buffer.flag = 1;
+ error_buffer.index = 0;
+ cur_error_buffer = &error_buffer;
+
+ if (buffer_flag == 0)
+ errors++;
+ error_print (_("Error:"), _(nocmsgid), argp);
+}
+
void
gfc_error (const char *nocmsgid, ...)
{
@@ -601,26 +538,18 @@ gfc_error (const char *nocmsgid, ...)
if (gfc_suppress_error)
return;
- error_buffer.flag = 1;
- error_buffer.index = 0;
- cur_error_buffer = &error_buffer;
-
va_start (argp, nocmsgid);
- if (buffer_flag == 0)
- errors++;
- error_print (_("Error:"), _(nocmsgid), argp);
+ _gfc_error(nocmsgid, argp);
va_end (argp);
error_char ('\0');
}
-
/* Immediate error. */
-void
-gfc_error_now (const char *nocmsgid, ...)
+static void
+_gfc_error_now (const char *nocmsgid, va_list argp)
{
- va_list argp;
int i;
error_buffer.flag = 1;
@@ -631,18 +560,27 @@ gfc_error_now (const char *nocmsgid, ...
buffer_flag = 0;
errors++;
- va_start (argp, nocmsgid);
error_print (_("Error:"), _(nocmsgid), argp);
+
+ buffer_flag = i;
+
+}
+
+void
+gfc_error_now (const char *nocmsgid, ...)
+{
+ va_list argp;
+
+ va_start (argp, nocmsgid);
+ _gfc_error_now(nocmsgid, argp);
va_end (argp);
error_char ('\0');
- buffer_flag = i;
if (flag_fatal_errors)
exit (1);
}
-
/* Fatal error, never returns. */
void
@@ -789,3 +727,98 @@ gfc_get_errors (int *w, int *e)
if (e != NULL)
*e = errors;
}
+
+/* Wrapper to turn warnings into errors if -Werror was given. */
+
+void
+gfc_warning (const char *nocmsgid, ...)
+{
+ va_list argp;
+
+ va_start (argp, nocmsgid);
+ if (warnings_are_errors)
+ {
+ _gfc_error(nocmsgid, argp);
+ }
+ else
+ {
+ if (!inhibit_warnings)
+ _gfc_warning(nocmsgid, argp);
+ }
+ va_end (argp);
+
+ error_char ('\0');
+}
+
+void
+gfc_warning_now (const char *nocmsgid, ...)
+{
+ va_list argp;
+
+ va_start (argp, nocmsgid);
+ if (warnings_are_errors)
+ {
+ _gfc_error_now(nocmsgid, argp);
+ }
+ else
+ {
+ if (!inhibit_warnings)
+ _gfc_warning_now(nocmsgid, argp);
+ }
+ va_end (argp);
+
+ error_char ('\0');
+}
+
+/* Whether, for a feature included in a given standard set (GFC_STD_*),
+ we should issue an error or a warning, or be quiet. */
+
+notification
+gfc_notification_std (int std)
+{
+ bool warning;
+
+ warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
+ if ((gfc_option.allow_std & std) != 0 && !warning)
+ return SILENT;
+
+ return warning ? WARNING : ERROR;
+}
+
+
+/* Possibly issue a warning/error about use of a nonstandard (or deleted)
+ feature. An error/warning will be issued if the currently selected
+ standard does not contain the requested bits. Return FAILURE if
+ an error is generated. */
+
+try
+gfc_notify_std (int std, const char *nocmsgid, ...)
+{
+ va_list argp;
+ bool warning;
+
+ warning = (gfc_option.warn_std & std) != 0;
+ if ((gfc_option.allow_std & std) != 0
+ && !warning)
+ return SUCCESS;
+
+ if (gfc_suppress_error)
+ return warning ? SUCCESS : FAILURE;
+
+ va_start (argp, nocmsgid);
+ if (warnings_are_errors)
+ {
+ _gfc_error(nocmsgid, argp);
+ }
+ else
+ {
+ if (!inhibit_warnings)
+ _gfc_warning(nocmsgid, argp);
+ }
+ va_end (argp);
+
+ error_char ('\0');
+
+ return warning ? SUCCESS : FAILURE;
+}
+
Index: gcc-4.2/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f
===================================================================
--- gcc-4.2/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f (revision 0)
+++ gcc-4.2/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f (revision 0)
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-std=gnu -Werror" }
+! PR fortran 21061
+! gfortran ignores -Werror
+! fixed-form tests
+ program warnings_are_errors_1
+ implicit none
+ integer(kind=1) :: i
+ real :: r1, r2(3)
+! gfc_warning_now:
+0 ! { dg-error "Zero is not a valid statement label" }
+! gfc_warning_now:
+1 ! { dg-error "Ignoring statement label in empty statement" }
+ 1 ! { dg-error "Ignoring statement label in empty statement" }
+!
+ 2 ! { dg-error "Ignoring statement label in empty statement" }
+ 3 ! { dg-error "Ignoring statement label in empty statement" }
+34 5 i=0
+! gfc_notify_std(GFC_STD_F95_DEL):
+ do r1 = 1.0, 2 ! { dg-error "Obsolete: REAL DO loop iterator" }
+ i = i+1
+ end do
+ call foo j bar
+ j = i-1 ! { dg-error "has no IMPLICIT type" }
+! gfc_warning:
+ r2(4) = 0 ! { dg-error "is out of bounds" }
+
+ goto 3 45
+ end
Index: gcc-4.2/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90
===================================================================
--- gcc-4.2/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90 (revision 0)
+++ gcc-4.2/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90 (revision 0)
@@ -0,0 +1,59 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -Werror" }
+! PR fortran 21061
+! gfortran ignores -Werror
+! free-form tests
+
+! gfc_notify_std:
+ function char_ (ch) ! { dg-error "is obsolescent in fortran 95" }
+ character(*) :: char_, ch
+! warning(0,...):
+ write (*,*) ch ! { dg-error "Function does not return a value" }
+ end function char_
+ implicit none
+
+TYPE :: seq_t
+ sequence
+ integer, dimension (:,:), pointer :: i_seq
+end type seq_t
+type (seq_t) :: my_seq
+
+type warn_t
+ integer i_warn
+! gfc_warning:
+end TYPE something_else ! { dg-error "label 'warn_t' for END TYPE statement" }
+end TYPE warn_t
+
+! gfc_error:
+real (kind=my_seq) :: r_seq1 ! { dg-error "has not been declared or is a variable, which does not reduce to a constant expr" }
+
+TYPE non_mod_type
+! gfc_error:
+ private ! { dg-error "must be inside a MODULE" }
+ integer :: i_non_mod
+end type non_mod_type
+
+! gfc_error:
+type (seq_t), dimension(0:my_seq), save :: r_seq2 ! { dg-error "must be of INTEGER type|must have constant shape" }
+ integer :: i
+4713 complex :: cplx
+!goto 4713 ! { no-error "not a valid branch target statement for the branch" }
+! gfc_warning:
+0815 goto 0815 ! { dg-error "causes an infinite loop" }
+! nothing ..
+4711 goto 4712
+4712 goto 4711
+
+! gfc_warning_now:
+0 ! { dg-error "Zero is not a valid statement label" }
+! gfc_warning_now:
+ 1 ! { dg-error "Ignoring statement label in empty statement" }
+! gfc_error_now:
+34 5 ! { dg-error "Unclassifiable statement" }
+! gfc_error_now:
+34A5 ! { dg-error "Non-numeric character in statement label" }
+
+ call proc(j) ! { dg-error "has no IMPLICIT type" }
+ goto 3 45 ! { dg-error "Syntax error in GOTO statement" }
+ end
+
More information about the Fortran
mailing list