|
|
I have reviewed this patch, it works, and I regtested it on FC3/Athlon.
I tried and partially succeded to write a testcase for it, based on FX's
example (see 5 below).
It's OK for mainline and 4.0, with a couple of remarks.
Thanks for the testcase and the reviewing. Attached is what I commited.
FX
2005-09-11 Francois-Xavier Coudert <coudert@xxxxxxxxxxxxxx>
Steven Bosscher <stevenb@xxxxxxx>
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-09-11 Francois-Xavier Coudert <coudert@xxxxxxxxxxxxxx>
Steven Bosscher <stevenb@xxxxxxx>
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-09-11 Francois-Xavier Coudert <coudert@xxxxxxxxxxxxxx>
Steven Bosscher <stevenb@xxxxxxx>
* gfortran.dg/runtime_warning_1.f90: New test.
Index: gcc/fortran/gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.79
diff -u -3 -p -r1.79 gfortran.h
--- gcc/fortran/gfortran.h 10 Aug 2005 20:16:26 -0000 1.79
+++ gcc/fortran/gfortran.h 11 Aug 2005 13:16:23 -0000
@@ -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;
Index: gcc/fortran/trans-decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.65
diff -u -3 -p -r1.65 trans-decl.c
--- gcc/fortran/trans-decl.c 5 Aug 2005 20:37:06 -0000 1.65
+++ gcc/fortran/trans-decl.c 11 Aug 2005 13:16:23 -0000
@@ -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_namespac
/* 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)
{
Index: gcc/fortran/trans.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans.c,v
retrieving revision 1.27
diff -u -3 -p -r1.27 trans.c
--- gcc/fortran/trans.c 7 Aug 2005 22:56:17 -0000 1.27
+++ gcc/fortran/trans.c 11 Aug 2005 13:16:23 -0000
@@ -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;
Index: gcc/fortran/trans.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans.h,v
retrieving revision 1.31
diff -u -3 -p -r1.31 trans.h
--- gcc/fortran/trans.h 6 Aug 2005 12:56:19 -0000 1.31
+++ gcc/fortran/trans.h 11 Aug 2005 13:16:23 -0000
@@ -453,6 +453,7 @@ extern GTY(()) tree gfor_fndecl_stop_num
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;
Index: gcc/testsuite/gfortran.dg/runtime_warning_1.f90
===================================================================
RCS file: gcc/testsuite/gfortran.dg/runtime_warning_1.f90
diff -N gcc/testsuite/gfortran.dg/runtime_warning_1.f90
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/runtime_warning_1.f90 11 Aug 2005 13:16:24
-0000
@@ -0,0 +1,17 @@
+! Test runtime warnings using non-standard $ editing - PR20006.
+!
+! Contributor Francois-Xavier Coudert <coudert@xxxxxxxxxxxxxx>
+!
+! { 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}
Index: libgfortran/Makefile.am
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.40
diff -u -3 -p -r1.40 Makefile.am
--- libgfortran/Makefile.am 9 Aug 2005 17:33:13 -0000 1.40
+++ libgfortran/Makefile.am 11 Aug 2005 13:16:24 -0000
@@ -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 \
Index: libgfortran/libgfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/libgfortran.h,v
retrieving revision 1.28
diff -u -3 -p -r1.28 libgfortran.h
--- libgfortran/libgfortran.h 3 Aug 2005 20:00:00 -0000 1.28
+++ libgfortran/libgfortran.h 11 Aug 2005 13:16:24 -0000
@@ -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. */
Index: libgfortran/io/format.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/format.c,v
retrieving revision 1.13
diff -u -3 -p -r1.13 format.c
--- libgfortran/io/format.c 29 May 2005 12:22:49 -0000 1.13
+++ libgfortran/io/format.c 11 Aug 2005 13:16:24 -0000
@@ -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:
Index: libgfortran/runtime/compile_options.c
===================================================================
RCS file: libgfortran/runtime/compile_options.c
diff -N libgfortran/runtime/compile_options.c
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ libgfortran/runtime/compile_options.c 11 Aug 2005 13:16:24 -0000
@@ -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;
+}
Index: libgfortran/runtime/error.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/runtime/error.c,v
retrieving revision 1.11
diff -u -3 -p -r1.11 error.c
--- libgfortran/runtime/error.c 9 Jul 2005 09:33:24 -0000 1.11
+++ libgfortran/runtime/error.c 11 Aug 2005 13:16:24 -0000
@@ -489,3 +489,29 @@ generate_error (int family, const char *
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;
+}
Index: libgfortran/runtime/main.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/runtime/main.c,v
retrieving revision 1.7
diff -u -3 -p -r1.7 main.c
--- libgfortran/runtime/main.c 15 May 2005 12:44:39 -0000 1.7
+++ libgfortran/runtime/main.c 11 Aug 2005 13:16:24 -0000
@@ -96,6 +96,7 @@ init (void)
init_variables ();
init_units ();
+ init_compile_options ();
#ifdef DEBUG
/* Check for special command lines. */
|
|