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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@102990 138bc75d-0d04-0410-961f-82ee72b054a4

14 files changed, 206 insertions, 6 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bbbda8df05f..d8b46198ea7 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cb68ad49cb2..8ff8d5cdbfe 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 49811eb0f98..3488cde9096 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -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)
     {
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 0ee8459718a..a3c3ddc48fb 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -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;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 62f79538e8f..3c5734d816c 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -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;
diff --git a/gcc/testsuite/gfortran.dg/runtime_warning_1.f90 b/gcc/testsuite/gfortran.dg/runtime_warning_1.f90
new file mode 100644
index 00000000000..6af85c344ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/runtime_warning_1.f90
@@ -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}
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index f64b01d4994..bbf33555939 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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.
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index d5e21c60386..4f12f8f3774 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -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 \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index f69e3b4b1a6..ee68562dd81 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -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
 
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 229a937b05b..e075eee2556 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.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:
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 6db6ef927cf..de17c2f3723 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -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.  */
 
diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c
new file mode 100644
index 00000000000..5b124199663
--- /dev/null
+++ b/libgfortran/runtime/compile_options.c
@@ -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;
+}
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index ff91b96bd3f..b2f29acd851 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -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;
+}
diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c
index d2cedf70371..6801aadc5e1 100644
--- a/libgfortran/runtime/main.c
+++ b/libgfortran/runtime/main.c
@@ -96,6 +96,7 @@ init (void)
   init_variables ();
 
   init_units ();
+  init_compile_options ();
 
 #ifdef DEBUG
   /* Check for special command lines.  */