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

6 files changed, 68 insertions, 3 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bbbda8d..d8b4619 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 cb68ad4..8ff8d5c 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 49811eb..3488cde 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 0ee8459..a3c3ddc 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 62f7953..3c5734d 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 0000000..6af85c3
--- /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}