OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR libfortran/21303 (L edit descriptor without a width) 

PR libfortran/21303

	* gfortran.h (notification): New enumeration.
	(gfc_notification_std): Prototype for the new function.
	* error.c (gfc_notification_std): New function.
	* io.c (check_format): Handle the case of a L format descriptor
	without a width.

	* runtime/error.c (notification_std): New function.
	* libgfortran.h (notification): New enumeration.
	* io/io.h (notification_std): Prototype for the new function. 
	* io/format.c (parse_format_list): Handle the case of a L format
	descriptor without a width.

	* gcc/testsuite/gfortran.dg/fmt_l.f90: New test.

From-SVN: r111281
This commit is contained in:
François-Xavier Coudert 2006-02-19 21:31:02 +00:00
parent f5dc42bbcc
commit 8f0d39a86b
8 changed files with 158 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/fortran/error.c
View File

@ -1,6 +1,6 @@
/* Handle errors.
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
Inc.
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
Foundation, Inc.
Contributed by Andy Vaught & Niels Kristian Bech Jensen
This file is part of GCC.
@ -483,6 +483,22 @@ gfc_warning (const char *nocmsgid, ...)
}
/* 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

9
gcc/fortran/gfortran.h
View File

@ -129,6 +129,14 @@ typedef enum
{ SUCCESS = 1, FAILURE }
try;
/* This is returned by gfc_notification_std to know if, given the flags
that were given (-std=, -pedantic) we should issue an error, a warning
or nothing. */
typedef enum
{ SILENT, WARNING, ERROR }
notification;
/* Matchers return one of these three values. The difference between
MATCH_NO and MATCH_ERROR is that MATCH_ERROR means that a match was
successful, but that something non-syntactic is wrong and an error
@ -1737,6 +1745,7 @@ void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC
void gfc_clear_error (void);
int gfc_error_check (void);
notification gfc_notification_std (int);
try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
/* A general purpose syntax error. */

22
gcc/fortran/io.c
View File

@ -569,8 +569,26 @@ data_desc:
if (t == FMT_POSINT)
break;
error = posint_required;
goto syntax;
switch (gfc_notification_std (GFC_STD_GNU))
{
case WARNING:
gfc_warning
("Extension: Missing positive width after L descriptor at %C");
saved_token = t;
break;
case ERROR:
error = posint_required;
goto syntax;
case SILENT:
saved_token = t;
break;
default:
gcc_unreachable ();
}
break;
case FMT_A:
t = format_lex ();

69
gcc/testsuite/gfortran.dg/fmt_l.f90 Normal file
View File

@ -0,0 +1,69 @@
! { dg-do run }
! { dg-options "-std=gnu -pedantic -ffree-line-length-none" }
! Test the GNU extension of a L format descriptor without width
! PR libfortran/21303
program test_l
logical(kind=1) :: l1
logical(kind=2) :: l2
logical(kind=4) :: l4
logical(kind=8) :: l8
character(len=20) :: str
l1 = .true.
write (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
read (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
if (l1 .neqv. .true.) call abort
l2 = .true.
write (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
read (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
if (l2 .neqv. .true.) call abort
l4 = .true.
write (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
read (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
if (l4 .neqv. .true.) call abort
l8 = .true.
write (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
read (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
if (l8 .neqv. .true.) call abort
l1 = .false.
write (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
read (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
if (l1 .neqv. .false.) call abort
l2 = .false.
write (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
read (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
if (l2 .neqv. .false.) call abort
l4 = .false.
write (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
read (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
if (l4 .neqv. .false.) call abort
l8 = .false.
write (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
read (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
if (l8 .neqv. .false.) call abort
end program test_l
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }
! { dg-output "Fortran runtime warning: Positive width required in format\n" }

15
libgfortran/io/format.c
View File

@ -1,4 +1,4 @@
/* Copyright (C) 2002, 2003, 2004, 2005
/* Copyright (C) 2002, 2003, 2004, 2005, 2006
Free Software Foundation, Inc.
Contributed by Andy Vaught
@ -662,8 +662,17 @@ parse_format_list (st_parameter_dt *dtp)
t = format_lex (fmt);
if (t != FMT_POSINT)
{
fmt->error = posint_required;
goto finished;
if (notification_std(GFC_STD_GNU) == ERROR)
{
fmt->error = posint_required;
goto finished;
}
else
{
fmt->saved_token = t;
fmt->value = 1; /* Default width */
notify_std(GFC_STD_GNU, posint_required);
}
}
get_fnode (fmt, &head, &tail, FMT_L);

5
libgfortran/io/io.h
View File

@ -1,4 +1,4 @@
/* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
/* Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran).
@ -843,6 +843,9 @@ internal_proto(list_formatted_write);
extern try notify_std (int, const char *);
internal_proto(notify_std);
extern notification notification_std(int);
internal_proto(notification_std);
/* size_from_kind.c */
extern size_t size_from_real_kind (int);
internal_proto(size_from_real_kind);

7
libgfortran/libgfortran.h
View File

@ -404,6 +404,13 @@ error_codes;
#define GFC_FPE_UNDERFLOW (1<<4)
#define GFC_FPE_PRECISION (1<<5)
/* This is returned by notification_std to know if, given the flags
that were given (-std=, -pedantic) we should issue an error, a warning
or nothing. */
typedef enum
{ SILENT, WARNING, ERROR }
notification;
/* The filename and line number don't go inside the globals structure.
They are set by the rest of the program and must be linked to. */

19
libgfortran/runtime/error.c
View File

@ -498,6 +498,25 @@ generate_error (st_parameter_common *cmp, int family, const char *message)
}
/* Whether, for a feature included in a given standard set (GFC_STD_*),
we should issue an error or a warning, or be quiet. */
notification
notification_std (int std)
{
int warning;
if (!compile_options.pedantic)
return SILENT;
warning = compile_options.warn_std & std;
if ((compile_options.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