re PR libfortran/20006 ($ format extension doesn't work)
PR libfortran/20006 * gfortran.h: Add is_main_program member to symbol_attribute. * trans-decl: Add a gfor_fndecl_set_std tree. (gfc_build_builtin_function_decls): Create it. (gfc_generate_function_code): Add this call at the beginning of the main program. * trans.c (gfc_generate_code): Move main_program and attr. * trans.h: Add declaration for gfor_fndecl_set_std. * Makefile.am: Add file runtime/compile_options.c. * Makefile.in: Regenerate. * libgfortran.h: Create structure compile_options_t. Define the compile_options variable and GFC_STD_ macros. * runtime/compile_options.c: New file. * runtime/error.c (notify_std): New function. * runtime/main.c (init): Call init_compile_options during initialization. * io/format.c: Use the new notify_std function for the $ descriptor extension. * gfortran.dg/runtime_warning_1.f90: New test. Co-Authored-By: Steven Bosscher <stevenb@suse.de> From-SVN: r102990
This commit is contained in:
Francois-Xavier Coudert
François-Xavier Coudert
parent
74b002ba34
commit
8b67b708f1
@ -1,3 +1,15 @@
|
||||
2005-09-11 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||
Steven Bosscher <stevenb@suse.de>
|
||||
|
||||
PR libfortran/20006
|
||||
* gfortran.h: Add is_main_program member to symbol_attribute.
|
||||
* trans-decl: Add a gfor_fndecl_set_std tree.
|
||||
(gfc_build_builtin_function_decls): Create it.
|
||||
(gfc_generate_function_code): Add this call at the beginning of
|
||||
the main program.
|
||||
* trans.c (gfc_generate_code): Move main_program and attr.
|
||||
* trans.h: Add declaration for gfor_fndecl_set_std.
|
||||
|
||||
2005-08-10 Thomas Koenig <Thomas.Koenig@online.de>
|
||||
|
||||
PR libfortran/22143
|
||||
|
||||
@ -432,9 +432,11 @@ typedef struct
|
||||
don't have any code associated, and the backend will turn them into
|
||||
thunks to the master function. */
|
||||
unsigned entry:1;
|
||||
|
||||
/* Set if this is the master function for a procedure with multiple
|
||||
entry points. */
|
||||
unsigned entry_master:1;
|
||||
|
||||
/* Set if this is the master function for a function with multiple
|
||||
entry points where characteristics of the entry points differ. */
|
||||
unsigned mixed_entry_master:1;
|
||||
@ -446,6 +448,11 @@ typedef struct
|
||||
modification of type or type parameters is permitted. */
|
||||
unsigned referenced:1;
|
||||
|
||||
/* Set if the is the symbol for the main program. This is the least
|
||||
cumbersome way to communicate this function property without
|
||||
strcmp'ing with __MAIN everywhere. */
|
||||
unsigned is_main_program:1;
|
||||
|
||||
/* Mutually exclusive multibit attributes. */
|
||||
ENUM_BITFIELD (gfc_access) access:2;
|
||||
ENUM_BITFIELD (sym_intent) intent:2;
|
||||
|
||||
@ -83,6 +83,7 @@ tree gfor_fndecl_stop_numeric;
|
||||
tree gfor_fndecl_stop_string;
|
||||
tree gfor_fndecl_select_string;
|
||||
tree gfor_fndecl_runtime_error;
|
||||
tree gfor_fndecl_set_std;
|
||||
tree gfor_fndecl_in_pack;
|
||||
tree gfor_fndecl_in_unpack;
|
||||
tree gfor_fndecl_associated;
|
||||
@ -1941,6 +1942,13 @@ gfc_build_builtin_function_decls (void)
|
||||
/* The runtime_error function does not return. */
|
||||
TREE_THIS_VOLATILE (gfor_fndecl_runtime_error) = 1;
|
||||
|
||||
gfor_fndecl_set_std =
|
||||
gfc_build_library_function_decl (get_identifier (PREFIX("set_std")),
|
||||
void_type_node,
|
||||
2,
|
||||
gfc_int4_type_node,
|
||||
gfc_int4_type_node);
|
||||
|
||||
gfor_fndecl_in_pack = gfc_build_library_function_decl (
|
||||
get_identifier (PREFIX("internal_pack")),
|
||||
pvoid_type_node, 1, pvoid_type_node);
|
||||
@ -2349,6 +2357,24 @@ gfc_generate_function_code (gfc_namespace * ns)
|
||||
/* Now generate the code for the body of this function. */
|
||||
gfc_init_block (&body);
|
||||
|
||||
/* If this is the main program and we compile with -pedantic, add a call
|
||||
to set_std to set up the runtime library Fortran language standard
|
||||
parameters. */
|
||||
if (sym->attr.is_main_program && pedantic)
|
||||
{
|
||||
tree arglist, gfc_int4_type_node;
|
||||
|
||||
gfc_int4_type_node = gfc_get_int_type (4);
|
||||
arglist = gfc_chainon_list (NULL_TREE,
|
||||
build_int_cst (gfc_int4_type_node,
|
||||
gfc_option.warn_std));
|
||||
arglist = gfc_chainon_list (arglist,
|
||||
build_int_cst (gfc_int4_type_node,
|
||||
gfc_option.allow_std));
|
||||
tmp = gfc_build_function_call (gfor_fndecl_set_std, arglist);
|
||||
gfc_add_expr_to_block (&body, tmp);
|
||||
}
|
||||
|
||||
if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
|
||||
&& sym->attr.subroutine)
|
||||
{
|
||||
|
||||
@ -650,9 +650,6 @@ gfc_trans_code (gfc_code * code)
|
||||
void
|
||||
gfc_generate_code (gfc_namespace * ns)
|
||||
{
|
||||
gfc_symbol *main_program = NULL;
|
||||
symbol_attribute attr;
|
||||
|
||||
if (ns->is_block_data)
|
||||
{
|
||||
gfc_generate_block_data (ns);
|
||||
@ -662,6 +659,9 @@ gfc_generate_code (gfc_namespace * ns)
|
||||
/* Main program subroutine. */
|
||||
if (!ns->proc_name)
|
||||
{
|
||||
gfc_symbol *main_program;
|
||||
symbol_attribute attr;
|
||||
|
||||
/* Lots of things get upset if a subroutine doesn't have a symbol, so we
|
||||
make one now. Hopefully we've set all the required fields. */
|
||||
gfc_get_symbol ("MAIN__", ns, &main_program);
|
||||
@ -670,7 +670,9 @@ gfc_generate_code (gfc_namespace * ns)
|
||||
attr.proc = PROC_UNKNOWN;
|
||||
attr.subroutine = 1;
|
||||
attr.access = ACCESS_PUBLIC;
|
||||
attr.is_main_program = 1;
|
||||
main_program->attr = attr;
|
||||
|
||||
/* Set the location to the first line of code. */
|
||||
if (ns->code)
|
||||
main_program->declared_at = ns->code->loc;
|
||||
|
||||
@ -453,6 +453,7 @@ extern GTY(()) tree gfor_fndecl_stop_numeric;
|
||||
extern GTY(()) tree gfor_fndecl_stop_string;
|
||||
extern GTY(()) tree gfor_fndecl_select_string;
|
||||
extern GTY(()) tree gfor_fndecl_runtime_error;
|
||||
extern GTY(()) tree gfor_fndecl_set_std;
|
||||
extern GTY(()) tree gfor_fndecl_in_pack;
|
||||
extern GTY(()) tree gfor_fndecl_in_unpack;
|
||||
extern GTY(()) tree gfor_fndecl_associated;
|
||||
|
||||
17
gcc/testsuite/gfortran.dg/runtime_warning_1.f90
Normal file
17
gcc/testsuite/gfortran.dg/runtime_warning_1.f90
Normal file
@ -0,0 +1,17 @@
|
||||
! Test runtime warnings using non-standard $ editing - PR20006.
|
||||
!
|
||||
! Contributor Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||
!
|
||||
! { dg-options "-pedantic" }
|
||||
! { dg-do run }
|
||||
!
|
||||
character*5 c
|
||||
open (42,status='scratch')
|
||||
write (42,'(A,$)') 'abc' ! { dg-warning ".*descriptor" "" }
|
||||
write (42,'(A)') 'de'
|
||||
rewind (42)
|
||||
read (42,'(A)') c
|
||||
close (42)
|
||||
if (c /= 'abcde') call abort ()
|
||||
end
|
||||
! { dg-warning ".*descriptor" "" 10}
|
||||
@ -1,3 +1,18 @@
|
||||
2005-09-11 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||
Steven Bosscher <stevenb@suse.de>
|
||||
|
||||
PR libfortran/20006
|
||||
* Makefile.am: Add file runtime/compile_options.c.
|
||||
* Makefile.in: Regenerate.
|
||||
* libgfortran.h: Create structure compile_options_t. Define the
|
||||
compile_options variable and GFC_STD_ macros.
|
||||
* runtime/compile_options.c: New file.
|
||||
* runtime/error.c (notify_std): New function.
|
||||
* runtime/main.c (init): Call init_compile_options during
|
||||
initialization.
|
||||
* io/format.c: Use the new notify_std function for the $
|
||||
descriptor extension.
|
||||
|
||||
2005-08-09 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||
* Makefile.am: Add file intrinsics/tty.c to Makefile process.
|
||||
* Makefile.in: Regenerate.
|
||||
|
||||
@ -94,6 +94,7 @@ runtime/in_unpack_generic.c \
|
||||
runtime/normalize.c
|
||||
|
||||
gfor_src= \
|
||||
runtime/compile_options.c \
|
||||
runtime/environ.c \
|
||||
runtime/error.c \
|
||||
runtime/main.c \
|
||||
|
||||
@ -67,8 +67,8 @@ am__strip_dir = `echo $$p | sed -e 's|^.*/||'`;
|
||||
am__installdirs = "$(DESTDIR)$(toolexeclibdir)"
|
||||
toolexeclibLTLIBRARIES_INSTALL = $(INSTALL)
|
||||
LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
|
||||
am__objects_1 = environ.lo error.lo main.lo memory.lo pause.lo stop.lo \
|
||||
string.lo select.lo
|
||||
am__objects_1 = compile_options.lo environ.lo error.lo main.lo \
|
||||
memory.lo pause.lo stop.lo string.lo select.lo
|
||||
am__objects_2 = all_l4.lo all_l8.lo
|
||||
am__objects_3 = any_l4.lo any_l8.lo
|
||||
am__objects_4 = count_4_l4.lo count_8_l4.lo count_4_l8.lo \
|
||||
@ -388,6 +388,7 @@ runtime/in_unpack_generic.c \
|
||||
runtime/normalize.c
|
||||
|
||||
gfor_src = \
|
||||
runtime/compile_options.c \
|
||||
runtime/environ.c \
|
||||
runtime/error.c \
|
||||
runtime/main.c \
|
||||
@ -831,6 +832,9 @@ f2c_specifics.lo: intrinsics/f2c_specifics.F90
|
||||
.c.lo:
|
||||
$(LTCOMPILE) -c -o $@ $<
|
||||
|
||||
compile_options.lo: runtime/compile_options.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o compile_options.lo `test -f 'runtime/compile_options.c' || echo '$(srcdir)/'`runtime/compile_options.c
|
||||
|
||||
environ.lo: runtime/environ.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o environ.lo `test -f 'runtime/environ.c' || echo '$(srcdir)/'`runtime/environ.c
|
||||
|
||||
|
||||
@ -580,6 +580,7 @@ parse_format_list (void)
|
||||
case FMT_DOLLAR:
|
||||
get_fnode (&head, &tail, FMT_DOLLAR);
|
||||
tail->repeat = 1;
|
||||
notify_std (GFC_STD_GNU, "Extension: $ descriptor");
|
||||
goto between_desc;
|
||||
|
||||
case FMT_T:
|
||||
|
||||
@ -295,11 +295,25 @@ typedef struct
|
||||
}
|
||||
options_t;
|
||||
|
||||
|
||||
extern options_t options;
|
||||
internal_proto(options);
|
||||
|
||||
|
||||
/* Compile-time options that will influence the library. */
|
||||
|
||||
typedef struct
|
||||
{
|
||||
int warn_std;
|
||||
int allow_std;
|
||||
}
|
||||
compile_options_t;
|
||||
|
||||
extern compile_options_t compile_options;
|
||||
internal_proto(compile_options);
|
||||
|
||||
|
||||
|
||||
|
||||
/* Structure for statement options. */
|
||||
|
||||
typedef struct
|
||||
@ -334,6 +348,18 @@ typedef enum
|
||||
error_codes;
|
||||
|
||||
|
||||
/* Flags to specify which standard/extension contains a feature.
|
||||
Keep them in sync with their counterparts in gcc/fortran/gfortran.h. */
|
||||
#define GFC_STD_LEGACY (1<<6) /* Backward compatibility. */
|
||||
#define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */
|
||||
#define GFC_STD_F2003 (1<<4) /* New in F2003. */
|
||||
/* Note that no features were obsoleted nor deleted in F2003. */
|
||||
#define GFC_STD_F95 (1<<3) /* New in F95. */
|
||||
#define GFC_STD_F95_DEL (1<<2) /* Deleted in F95. */
|
||||
#define GFC_STD_F95_OBS (1<<1) /* Obsoleted in F95. */
|
||||
#define GFC_STD_F77 (1<<0) /* Up to and including F77. */
|
||||
|
||||
|
||||
/* 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. */
|
||||
|
||||
|
||||
61
libgfortran/runtime/compile_options.c
Normal file
61
libgfortran/runtime/compile_options.c
Normal file
@ -0,0 +1,61 @@
|
||||
/* Handling of compile-time options that influence the library.
|
||||
Copyright (C) 2005 Free Software Foundation, Inc.
|
||||
|
||||
This file is part of the GNU Fortran 95 runtime library (libgfortran).
|
||||
|
||||
Libgfortran is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2, or (at your option)
|
||||
any later version.
|
||||
|
||||
In addition to the permissions in the GNU General Public License, the
|
||||
Free Software Foundation gives you unlimited permission to link the
|
||||
compiled version of this file into combinations with other programs,
|
||||
and to distribute those combinations without any restriction coming
|
||||
from the use of this file. (The General Public License restrictions
|
||||
do apply in other respects; for example, they cover modification of
|
||||
the file, and distribution when not linked into a combine
|
||||
executable.)
|
||||
|
||||
Libgfortran is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with libgfortran; see the file COPYING. If not, write to
|
||||
the Free Software Foundation, 59 Temple Place - Suite 330,
|
||||
Boston, MA 02111-1307, USA. */
|
||||
|
||||
#include "config.h"
|
||||
|
||||
#include "libgfortran.h"
|
||||
|
||||
|
||||
/* Useful compile-time options will be stored in here. */
|
||||
compile_options_t compile_options;
|
||||
|
||||
|
||||
/* Prototypes */
|
||||
extern void set_std (GFC_INTEGER_4, GFC_INTEGER_4);
|
||||
export_proto(set_std);
|
||||
|
||||
|
||||
void
|
||||
set_std (GFC_INTEGER_4 warn_std, GFC_INTEGER_4 allow_std)
|
||||
{
|
||||
compile_options.warn_std = warn_std;
|
||||
compile_options.allow_std = allow_std;
|
||||
}
|
||||
|
||||
|
||||
/* Default values for the compile-time options. Keep in sync with
|
||||
gcc/fortran/options.c (gfc_init_options). */
|
||||
void
|
||||
init_compile_options (void)
|
||||
{
|
||||
compile_options.warn_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
|
||||
| GFC_STD_F2003 | GFC_STD_LEGACY;
|
||||
compile_options.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
|
||||
| GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY;
|
||||
}
|
||||
@ -489,3 +489,29 @@ generate_error (int family, const char *message)
|
||||
|
||||
runtime_error (message);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* 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. */
|
||||
|
||||
try
|
||||
notify_std (int std, const char * message)
|
||||
{
|
||||
int warning;
|
||||
|
||||
warning = compile_options.warn_std & std;
|
||||
if ((compile_options.allow_std & std) != 0 && !warning)
|
||||
return SUCCESS;
|
||||
|
||||
show_locus ();
|
||||
if (!warning)
|
||||
{
|
||||
st_printf ("Fortran runtime error: %s\n", message);
|
||||
sys_exit (2);
|
||||
}
|
||||
else
|
||||
st_printf ("Fortran runtime warning: %s\n", message);
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
@ -96,6 +96,7 @@ init (void)
|
||||
init_variables ();
|
||||
|
||||
init_units ();
|
||||
init_compile_options ();
|
||||
|
||||
#ifdef DEBUG
|
||||
/* Check for special command lines. */
|
||||
|
||||
Loading…
Reference in New Issue
Block a user