Commit e9078ebb by Tobias Burnus Committed by Tobias Burnus

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
parent d18a0a84
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> 2012-01-06 Tobias Burnus <burnus@net-b.de>
* trans-openmp.c (gfc_omp_clause_dtor, gfc_trans_omp_array_reduction): * trans-openmp.c (gfc_omp_clause_dtor, gfc_trans_omp_array_reduction):
......
...@@ -1299,7 +1299,9 @@ gfc_use_rename; ...@@ -1299,7 +1299,9 @@ gfc_use_rename;
typedef struct gfc_use_list typedef struct gfc_use_list
{ {
const char *module_name; const char *module_name;
int only_flag; bool intrinsic;
bool non_intrinsic;
bool only_flag;
struct gfc_use_rename *rename; struct gfc_use_rename *rename;
locus where; locus where;
/* Next USE statement. */ /* Next USE statement. */
......
/* All matcher functions. /* All matcher functions.
Copyright (C) 2003, 2005, 2007, 2008, 2010 Copyright (C) 2003, 2005, 2007, 2008, 2010, 2012
Free Software Foundation, Inc. Free Software Foundation, Inc.
Contributed by Steven Bosscher Contributed by Steven Bosscher
...@@ -249,7 +249,7 @@ match gfc_match_expr (gfc_expr **); ...@@ -249,7 +249,7 @@ match gfc_match_expr (gfc_expr **);
/* module.c. */ /* module.c. */
match gfc_match_use (void); match gfc_match_use (void);
void gfc_use_module (void); void gfc_use_modules (void);
#endif /* GFC_MATCH_H */ #endif /* GFC_MATCH_H */
/* Main parser. /* Main parser.
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
2009, 2010, 2011 2009, 2010, 2011, 2012
Free Software Foundation, Inc. Free Software Foundation, Inc.
Contributed by Andy Vaught Contributed by Andy Vaught
...@@ -37,6 +37,7 @@ static locus label_locus; ...@@ -37,6 +37,7 @@ static locus label_locus;
static jmp_buf eof_buf; static jmp_buf eof_buf;
gfc_state_data *gfc_state_stack; gfc_state_data *gfc_state_stack;
static bool last_was_use_stmt = false;
/* TODO: Re-order functions to kill these forward decls. */ /* TODO: Re-order functions to kill these forward decls. */
static void check_statement_label (gfc_statement); static void check_statement_label (gfc_statement);
...@@ -74,6 +75,26 @@ match_word (const char *str, match (*subr) (void), locus *old_locus) ...@@ -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 /* Figure out what the next statement is, (mostly) regardless of
proper ordering. The do...while(0) is there to prevent if/else proper ordering. The do...while(0) is there to prevent if/else
ambiguity. */ ambiguity. */
...@@ -108,8 +129,19 @@ decode_specification_statement (void) ...@@ -108,8 +129,19 @@ decode_specification_statement (void)
old_locus = gfc_current_locus; 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 ("import", gfc_match_import, ST_IMPORT);
match ("use", gfc_match_use, ST_USE);
if (gfc_current_block ()->result->ts.type != BT_DERIVED) if (gfc_current_block ()->result->ts.type != BT_DERIVED)
goto end_of_block; goto end_of_block;
...@@ -252,6 +284,22 @@ decode_statement (void) ...@@ -252,6 +284,22 @@ decode_statement (void)
old_locus = gfc_current_locus; 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 /* Try matching a data declaration or function declaration. The
input "REALFUNCTIONA(N)" can mean several things in different input "REALFUNCTIONA(N)" can mean several things in different
contexts, so it (and its relatives) get special treatment. */ contexts, so it (and its relatives) get special treatment. */
...@@ -322,8 +370,6 @@ decode_statement (void) ...@@ -322,8 +370,6 @@ decode_statement (void)
statement, we eliminate most possibilities by peeking at the statement, we eliminate most possibilities by peeking at the
first character. */ first character. */
c = gfc_peek_ascii_char ();
switch (c) switch (c)
{ {
case 'a': case 'a':
...@@ -454,7 +500,6 @@ decode_statement (void) ...@@ -454,7 +500,6 @@ decode_statement (void)
case 'u': case 'u':
match ("unlock", gfc_match_unlock, ST_UNLOCK); match ("unlock", gfc_match_unlock, ST_UNLOCK);
match ("use", gfc_match_use, ST_USE);
break; break;
case 'v': case 'v':
...@@ -713,6 +758,8 @@ next_free (void) ...@@ -713,6 +758,8 @@ next_free (void)
gcc_assert (c == ' ' || c == '\t'); gcc_assert (c == ' ' || c == '\t');
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
if (last_was_use_stmt)
use_modules ();
return decode_omp_directive (); return decode_omp_directive ();
} }
...@@ -801,7 +848,8 @@ next_fixed (void) ...@@ -801,7 +848,8 @@ next_fixed (void)
gfc_error ("Bad continuation line at %C"); gfc_error ("Bad continuation line at %C");
return ST_NONE; return ST_NONE;
} }
if (last_was_use_stmt)
use_modules ();
return decode_omp_directive (); return decode_omp_directive ();
} }
/* FALLTHROUGH */ /* FALLTHROUGH */
...@@ -1595,10 +1643,6 @@ accept_statement (gfc_statement st) ...@@ -1595,10 +1643,6 @@ accept_statement (gfc_statement st)
{ {
switch (st) switch (st)
{ {
case ST_USE:
gfc_use_module ();
break;
case ST_IMPLICIT_NONE: case ST_IMPLICIT_NONE:
gfc_set_implicit_none (); gfc_set_implicit_none ();
break; break;
......
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> 2012-01-09 Gary Funck <gary@intrepid.com>
PR preprocessor/33919 PR preprocessor/33919
......
! { 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" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment