[gfortran] Fix PR 16861

Paul Thomas paulthomas2@wanadoo.fr
Thu Sep 15 16:45:00 GMT 2005


:ADDPATCH fortran:

Sorry for the repeat - I forgot the above and the patch queue would not
accept the URL I gave it.

This proposed patch is a fix for PR16861, in which module procedures with
assumed shape dummy arguments would cause ICEs, when the indices themselves
were use associated.

The patch works by recognising that symbols from different namespaces, 
within
a module, should have different true_name entries.  This permits the correct
resolution of references, when building the array_specs for the assumed 
shape
arrays.  The backend referencing comes right because there is only one 
symtree
entry for each variable name, regardless of how many true_name entries there
might be.

The cost for this simple patch is slight: Each symbol is represented
in the .mod file so that, in the testcase below, the symbol i appears three
times in foobar.mod; once for each namespace.  foobar.mod will be found 
after the
testcase.

Evidently, it is not necessary to store this information in the module 
files,
since g95 does not.  I rather like this explicit approach.  However, it 
could be
fixed later by a bit of hacking in the code called by write_symbol[x], 
such that
only the index in the module namespace is stored and that the references be
redirected to this.

In the course of diagnosing the problem and developing the testcase, I 
noticed
that the FIXME on lines 3487-3497 had fixed itself and that the chunk of 
added
code is now redundant.  I therefore took the opportunity to remove it.  If
anbody recalls what triggered the condition, I would be grateful.  
Regtesting
does not reveal the need for this.

Regtested on Cygwin/i686 and FC3/Athlon 1700.

OK for mainline and 4.03, when open?

Paul T

===================================================================

2005-09-15  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/16861
    * module.c (read_module): Give symbols from module procedures
    different true_name entries to those from the module proper.

2005-09-15  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/16861
    * gfortran.dg/nested_modules_2.f90: New test.



Index: gcc/gcc/fortran/module.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/module.c,v
retrieving revision 1.36
diff -c -p -r1.36 module.c
*** gcc/gcc/fortran/module.c    9 Sep 2005 00:23:06 -0000    1.36
--- gcc/gcc/fortran/module.c    15 Sep 2005 12:42:44 -0000
*************** read_module (void)
*** 3101,3107 ****
    const char *p;
    char name[GFC_MAX_SYMBOL_LEN + 1];
    gfc_intrinsic_op i;
!   int ambiguous, symbol, j, nuse;
    pointer_info *info;
    gfc_use_rename *u;
    gfc_symtree *st;
--- 3101,3107 ----
    const char *p;
    char name[GFC_MAX_SYMBOL_LEN + 1];
    gfc_intrinsic_op i;
!   int ambiguous, symbol, j, nuse, series;
    pointer_info *info;
    gfc_use_rename *u;
    gfc_symtree *st;
*************** read_module (void)
*** 3122,3127 ****
--- 3122,3128 ----
 
    /* Create the fixup nodes for all the symbols.  */
 
+   series = 0;
    while (peek_atom () != ATOM_RPAREN)
      {
        require_atom (ATOM_INTEGER);
*************** read_module (void)
*** 3144,3149 ****
--- 3145,3158 ----
           being loaded again.  */
 
        sym = find_true_name (info->u.rsym.true_name, info->u.rsym.module);
+
+       /* If a module contains subroutines with assumed shape dummy
+        arguments, the symbols for indices need to be different from
+        from those in the module proper(ns = 1).  */
+       if (sym !=NULL && info->u.rsym.ns !=1)
+     sym = find_true_name (info->u.rsym.true_name,
+                   gfc_get_string ("%s@%d",module_name, series++));
+
        if (sym == NULL)
      continue;
 
*************** write_symbol1 (pointer_info * p)
*** 3487,3497 ****
    if (p->type != P_SYMBOL || p->u.wsym.state != NEEDS_WRITE)
      return 0;
 
-   /* FIXME: This shouldn't be necessary, but it works around
-      deficiencies in the module loader or/and symbol handling.  */
-   if (p->u.wsym.sym->module == NULL && p->u.wsym.sym->attr.dummy)
-     p->u.wsym.sym->module = gfc_get_string (module_name);
-
    p->u.wsym.state = WRITTEN;
    write_symbol (p->integer, p->u.wsym.sym);
 
--- 3496,3501 ----
*************** write_module (void)
*** 3610,3615 ****
--- 3614,3620 ----
    mio_lparen ();
 
    write_symbol0 (gfc_current_ns->sym_root);
+
    while (write_symbol1 (pi_root));
 
    mio_rparen ();

=======================nested_modules_2.f90==================

! { dg do-run }
! This tests the patch for PR16861.
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
module foo
 INTEGER :: i
end module foo

module bar
contains
 subroutine sub1 (j)
   use foo
   integer, dimension(i) :: j
   j = 42
 end subroutine sub1
 subroutine sub2 (k)
   use foo
   integer, dimension(i) :: k
   k = 84
 end subroutine sub2
end module bar

module foobar
   use foo                      !This used to cause an ICE
   use bar
end module foobar

program testfoobar
   use foobar
   integer, dimension(3)  :: l = 0
   i = 2
   call sub1 (l)
   i = 1
   call sub2 (l)
   if (all (l.ne.(/84,42,0/))) call abort ()
end program testfoobar


=======================foobar.mod======================

Note:
1) The symtree i points to symbol 11, which is in namespace 1; ie. the
module namespace.
2) The lower index of j points to symbol 12, which is in namespace 6; ie.
that of j and sub1.
3) Similarly the index of k points to symbol 13, which is in namespace 9,
being that of k and sub2.

$ cat foobar.mod
GFORTRAN module created from pr16861.f90 on Thu Sep 15 15:21:05 2005
If you edit this, you'll get what you deserve.

(() () () () () () () () () () () () () () () () ()
() () ())

()

()

()

()

(2 'bar' 'bar' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) (UNKNOWN
0 ()) 0 0 () () 0 () ())
3 'foobar' 'foobar' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) (
UNKNOWN 0 ()) 0 0 () () 0 () ())
4 'foo' 'foo' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) (UNKNOWN 0
()) 0 0 () () 0 () ())
5 'sub1' 'bar' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL SUBROUTINE)
(UNKNOWN 0 ()) 6 0 (7) () 0 () ())
8 'sub2' 'bar' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL SUBROUTINE)
(UNKNOWN 0 ()) 9 0 (10) () 0 () ())
11 'i' 'foo' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) (INTEGER
4 ()) 0 0 () () 0 () ())
7 'j' '' 6 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN DIMENSION
DUMMY) (INTEGER 4 ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 ()) 0 '1')
(VARIABLE (INTEGER 4 ()) 0 12 ())) 0 () ())
10 'k' '' 9 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN DIMENSION
DUMMY) (INTEGER 4 ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 ()) 0 '1')
(VARIABLE (INTEGER 4 ()) 0 13 ())) 0 () ())
13 'i' 'foo' 9 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) (INTEGER
4 ()) 0 0 () () 0 () ())
12 'i' 'foo' 6 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) (INTEGER
4 ()) 0 0 () () 0 () ())
)

('i' 0 11 'foo' 0 4 'bar' 0 2 'foobar' 0 3 'sub2' 0 8 'sub1' 0 5)





More information about the Gcc-patches mailing list