re PR fortran/51578 (Import of same symbol via different modules and renaming)

2012-01-09  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51578
        * gfortran.h (gfc_use_list):
        * match.h (gfc_use_module): Rename to ...
        (gfc_use_modules): ... this.
        * module.c (use_locus, specified_nonint, specified_int): Remove
        global variable.
        (module_name): Change type to const char*, used with gfc_get_string.
        (module_list): New global variable.
        (free_rename): Free argument not global var.
        (gfc_match_use): Save match to module_list.
        (load_generic_interfaces, read_module): Don't free symtree.
        (write_dt_extensions, gfc_dump_module): Fix module-name I/O due to the
        type change of module_name.
        (write_symbol0, write_generic): Optimize due to the type change.
        (import_iso_c_binding_module, use_iso_fortran_env_module): Use
        locus of rename->where.
        (gfc_use_module): Take module_list as argument.
        (gfc_use_modules): New function.
        (gfc_module_init_2, gfc_module_done_2): Init module_list, rename_list.
        * parse.c (last_was_use_stmt): New global variable.
        (use_modules): New function.
        (decode_specification_statement, decode_statement): Move USE match up
        and call use_modules.
        (next_free, next_fixed): Call use_modules.
        (accept_statement): Don't call gfc_module_use.

2012-01-09  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51578
        * gfortran.dg/use_17.f90: New.

From-SVN: r183010

gcc/fortran/ChangeLog

+2012-01-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51578
+	* gfortran.h (gfc_use_list):
+	* match.h (gfc_use_module): Rename to ...
+	(gfc_use_modules): ... this.
+	* module.c (use_locus, specified_nonint, specified_int): Remove
+	global variable.
+	(module_name): Change type to const char*, used with gfc_get_string.
+	(module_list): New global variable.
+	(free_rename): Free argument not global var.
+	(gfc_match_use): Save match to module_list.
+	(load_generic_interfaces, read_module): Don't free symtree.
+	(write_dt_extensions, gfc_dump_module): Fix module-name I/O due to the
+	type change of module_name.
+	(write_symbol0, write_generic): Optimize due to the type change.
+	(import_iso_c_binding_module, use_iso_fortran_env_module): Use
+	locus of rename->where.
+	(gfc_use_module): Take module_list as argument.
+	(gfc_use_modules): New function.
+	(gfc_module_init_2, gfc_module_done_2): Init module_list, rename_list.
+	* parse.c (last_was_use_stmt): New global variable.
+	(use_modules): New function.
+	(decode_specification_statement, decode_statement): Move USE match up
+	and call use_modules.
+	(next_free, next_fixed): Call use_modules.
+	(accept_statement): Don't call gfc_module_use.
+
 2012-01-06  Tobias Burnus <burnus@net-b.de>
 
 	* trans-openmp.c (gfc_omp_clause_dtor, gfc_trans_omp_array_reduction):

gcc/fortran/gfortran.h

@@ -1299,7 +1299,9 @@ gfc_use_rename;
 typedef struct gfc_use_list
 {
   const char *module_name;
-  int only_flag;
+  bool intrinsic;
+  bool non_intrinsic;
+  bool only_flag;
   struct gfc_use_rename *rename;
   locus where;
   /* Next USE statement.  */

gcc/fortran/match.h

 /* All matcher functions.
-   Copyright (C) 2003, 2005, 2007, 2008, 2010
+   Copyright (C) 2003, 2005, 2007, 2008, 2010, 2012
    Free Software Foundation, Inc.
    Contributed by Steven Bosscher
 
@@ -249,7 +249,7 @@ match gfc_match_expr (gfc_expr **);
 
 /* module.c.  */
 match gfc_match_use (void);
-void gfc_use_module (void);
+void gfc_use_modules (void);
 
 #endif  /* GFC_MATCH_H  */
 

gcc/fortran/parse.c

 /* Main parser.
    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-   2009, 2010, 2011
+   2009, 2010, 2011, 2012
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -37,6 +37,7 @@ static locus label_locus;
 static jmp_buf eof_buf;
 
 gfc_state_data *gfc_state_stack;
+static bool last_was_use_stmt = false;
 
 /* TODO: Re-order functions to kill these forward decls.  */
 static void check_statement_label (gfc_statement);
@@ -74,6 +75,26 @@ match_word (const char *str, match (*subr) (void), locus *old_locus)
 }
 
 
+/* Load symbols from all USE statements encounted in this scoping unit.  */
+
+static void
+use_modules (void)
+{
+  gfc_error_buf old_error;
+
+  gfc_push_error (&old_error);
+  gfc_buffer_error (0);
+  gfc_use_modules ();
+  gfc_buffer_error (1);
+  gfc_pop_error (&old_error);
+  gfc_commit_symbols ();
+  gfc_warning_check ();
+  gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
+  gfc_current_ns->old_equiv = gfc_current_ns->equiv;
+  last_was_use_stmt = false;
+}
+
+
 /* Figure out what the next statement is, (mostly) regardless of
    proper ordering.  The do...while(0) is there to prevent if/else
    ambiguity.  */
@@ -108,8 +129,19 @@ decode_specification_statement (void)
 
   old_locus = gfc_current_locus;
 
+  if (match_word ("use", gfc_match_use, &old_locus) == MATCH_YES)
+    {
+      last_was_use_stmt = true;
+      return ST_USE;
+    }
+  else
+    {
+      undo_new_statement ();
+      if (last_was_use_stmt)
+	use_modules ();
+    }
+
   match ("import", gfc_match_import, ST_IMPORT);
-  match ("use", gfc_match_use, ST_USE);
 
   if (gfc_current_block ()->result->ts.type != BT_DERIVED)
     goto end_of_block;
@@ -252,6 +284,22 @@ decode_statement (void)
 
   old_locus = gfc_current_locus;
 
+  c = gfc_peek_ascii_char ();
+
+  if (c == 'u')
+    {
+      if (match_word ("use", gfc_match_use, &old_locus) == MATCH_YES)
+	{
+	  last_was_use_stmt = true;
+	  return ST_USE;
+	}
+      else
+	undo_new_statement ();
+    }
+
+  if (last_was_use_stmt)
+    use_modules ();
+
   /* Try matching a data declaration or function declaration. The
       input "REALFUNCTIONA(N)" can mean several things in different
       contexts, so it (and its relatives) get special treatment.  */
@@ -322,8 +370,6 @@ decode_statement (void)
      statement, we eliminate most possibilities by peeking at the
      first character.  */
 
-  c = gfc_peek_ascii_char ();
-
   switch (c)
     {
     case 'a':
@@ -454,7 +500,6 @@ decode_statement (void)
 
     case 'u':
       match ("unlock", gfc_match_unlock, ST_UNLOCK);
-      match ("use", gfc_match_use, ST_USE);
       break;
 
     case 'v':
@@ -713,6 +758,8 @@ next_free (void)
 
 	  gcc_assert (c == ' ' || c == '\t');
 	  gfc_gobble_whitespace ();
+	  if (last_was_use_stmt)
+	    use_modules ();
 	  return decode_omp_directive ();
 	}
 
@@ -801,7 +848,8 @@ next_fixed (void)
 		  gfc_error ("Bad continuation line at %C");
 		  return ST_NONE;
 		}
-
+	      if (last_was_use_stmt)
+		use_modules ();
 	      return decode_omp_directive ();
 	    }
 	  /* FALLTHROUGH */
@@ -1595,10 +1643,6 @@ accept_statement (gfc_statement st)
 {
   switch (st)
     {
-    case ST_USE:
-      gfc_use_module ();
-      break;
-
     case ST_IMPLICIT_NONE:
       gfc_set_implicit_none ();
       break;

gcc/testsuite/ChangeLog

+2012-01-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51578
+	* gfortran.dg/use_17.f90: New.
+
 2012-01-09  Gary Funck  <gary@intrepid.com>
 
 	PR preprocessor/33919

gcc/testsuite/gfortran.dg/use_17.f90

+! { dg-do compile }
+!
+! PR fortran/51578
+!
+! Contributed by Billy Backer
+!
+! Check that indict importing of the symbol "axx" works
+! even if renaming prevent the direct import.
+!
+module mod1
+integer :: axx=2
+end module mod1
+
+module mod2
+use mod1
+end module mod2
+
+subroutine sub1
+use mod1, oxx=>axx
+use mod2
+implicit none
+print*,axx ! Valid - was working before
+end subroutine sub1
+
+subroutine sub2
+use mod2
+use mod1, oxx=>axx
+implicit none
+print*,axx ! Valid - was failing before
+end subroutine sub2
+
+subroutine test1
+  use :: iso_c_binding
+  use, intrinsic :: iso_c_binding, only: c_double_orig => c_double
+  integer :: c_double
+  integer, parameter :: p1 = c_int, p2 = c_double_orig
+end subroutine test1
+
+! { dg-final { cleanup-modules "mod1 mod2" } }