re PR fortran/22571 (Reject derived types for dummy arguments declared in the subroutine unless they are SEQUENCE)

2009-03-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/22571
	PR fortran/26227
	PR fortran/24886
	* symbol.c : Add gfc_global_ns_list.
	* decl.c (add_global_entry): Set the namespace ('ns') field.
	* gfortran.h : Add the resolved field to gfc_namespace. Add the
	namespace ('ns') field to gfc_gsymbol.  Add flag_whole_file to
	gfc_option_t.  Add the prototype for gfc_free_dt_list.
	* lang.opt : Add the whole-file option.
	* invoke.texi : Document the whole-file option.
	* resolve.c (resolve_global_procedure): If the fwhole-file
	option is set, reorder gsymbols to ensure that translation is
	in the right order.  Resolve the gsymbol's namespace if that
	has not occurred and then check interfaces.
	(resolve_function): Move call to resolve_global_procedure.
	(resolve_call): The same.
	(resolve_codes): Store the current labels_obstack.
	(gfc_resolve) : Return if the namespace is already resolved.
	trans-decl.c (gfc_get_extern_function_decl): If the whole_file
	option is selected, use the backend_decl of a gsymbol, if it is
	available.
	parse.c (add_global_procedure, add_global_program): If the flag
	whole-file is set, add the namespace to the gsymbol.
	(gfc_parse_file): On -fwhole-file, put procedure namespaces on
	the global namespace list.  Rearrange to do resolution of all
	the procedures in a file, followed by their translation.
	* options.c (gfc_init_options): Add -fwhole-file.
	(gfc_handle_option): The same.

2009-03-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/22571
	* gfortran.dg/whole_file_1.f90: New test.
	PR fortran/26227
	* gfortran.dg/whole_file_2.f90: New test.
	* gfortran.dg/whole_file_3.f90: New test.
	PR fortran/24886
	* gfortran.dg/whole_file_4.f90: New test.

From-SVN: r145314

1 files changed, 66 insertions, 1 deletions

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 0800fc1..1925198 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -3715,6 +3715,7 @@ add_global_procedure (int sub)
       s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
       s->where = gfc_current_locus;
       s->defined = 1;
+      s->ns = gfc_current_ns;
     }
 }
 
@@ -3737,6 +3738,7 @@ add_global_program (void)
       s->type = GSYM_PROGRAM;
       s->where = gfc_current_locus;
       s->defined = 1;
+      s->ns = gfc_current_ns;
     }
 }
 
@@ -3750,6 +3752,7 @@ gfc_parse_file (void)
   gfc_state_data top, s;
   gfc_statement st;
   locus prog_locus;
+  gfc_namespace *next;
 
   gfc_start_source_files ();
 
@@ -3768,6 +3771,10 @@ gfc_parse_file (void)
   if (setjmp (eof_buf))
     return FAILURE;	/* Come here on unexpected EOF */
 
+  /* Prepare the global namespace that will contain the
+     program units.  */
+  gfc_global_ns_list = next = NULL;
+
   seen_program = 0;
 
   /* Exit early for empty files.  */
@@ -3794,6 +3801,8 @@ loop:
       accept_statement (st);
       add_global_program ();
       parse_progunit (ST_NONE);
+      if (gfc_option.flag_whole_file)
+	goto prog_units;
       break;
 
     case ST_SUBROUTINE:
@@ -3801,6 +3810,8 @@ loop:
       push_state (&s, COMP_SUBROUTINE, gfc_new_block);
       accept_statement (st);
       parse_progunit (ST_NONE);
+      if (gfc_option.flag_whole_file)
+	goto prog_units;
       break;
 
     case ST_FUNCTION:
@@ -3808,6 +3819,8 @@ loop:
       push_state (&s, COMP_FUNCTION, gfc_new_block);
       accept_statement (st);
       parse_progunit (ST_NONE);
+      if (gfc_option.flag_whole_file)
+	goto prog_units;
       break;
 
     case ST_BLOCK_DATA:
@@ -3834,9 +3847,12 @@ loop:
       push_state (&s, COMP_PROGRAM, gfc_new_block);
       main_program_symbol (gfc_current_ns, "MAIN__");
       parse_progunit (st);
+      if (gfc_option.flag_whole_file)
+	goto prog_units;
       break;
     }
 
+  /* Handle the non-program units.  */
   gfc_current_ns->code = s.head;
 
   gfc_resolve (gfc_current_ns);
@@ -3862,7 +3878,56 @@ loop:
   gfc_done_2 ();
   goto loop;
 
-done:
+prog_units:
+  /* The main program and non-contained procedures are put
+     in the global namespace list, so that they can be processed
+     later and all their interfaces resolved.  */
+  gfc_current_ns->code = s.head;
+  if (next)
+    next->sibling = gfc_current_ns;
+  else
+    gfc_global_ns_list = gfc_current_ns;
+
+  next = gfc_current_ns;
+
+  pop_state ();
+  goto loop;
+
+  done:
+
+  if (!gfc_option.flag_whole_file)
+    goto termination;
+
+  /* Do the resolution.  */ 
+  gfc_current_ns = gfc_global_ns_list;
+  for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
+    {
+      gfc_current_locus = gfc_current_ns->proc_name->declared_at;
+      gfc_resolve (gfc_current_ns);
+    }
+
+  /* Do the parse tree dump.  */ 
+  gfc_current_ns = gfc_option.dump_parse_tree ? gfc_global_ns_list : NULL;
+  for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
+    {
+      gfc_dump_parse_tree (gfc_current_ns, stdout);
+      fputs ("-----------------------------------------\n\n", stdout);
+    }
+
+  gfc_current_ns = gfc_global_ns_list;
+  gfc_get_errors (NULL, &errors);
+
+  /* Do the translation.  This could be in a different order to
+     resolution if there are forward references in the file.  */
+  for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
+    {
+      gfc_current_locus = gfc_current_ns->proc_name->declared_at;
+      gfc_generate_code (gfc_current_ns);
+    }
+
+termination:
+  gfc_free_dt_list ();
+
   gfc_end_source_files ();
   return SUCCESS;