Re: [gfortran] Fix PR 16861

[Andreas Jaeger <aj at suse dot de>]

Paul Thomas <paulthomas2@wanadoo.fr> writes:

> [...]
> Regtested on Cygwin/i686 and FC3/Athlon 1700.

With a complete bootstrap?  CVS head fails to bootstrap now with:

stage1/xgcc -Bstage1/ -B/opt/gcc/4.1-devel/x86_64-suse-linux-gnu/bin/ -c   -g -O2 -DIN_GCC   -W -Wall -Wwrite-strings -Wstrict-prototypes -Wmissing-prototypes -pedantic -Wno-long-long -Wno-variadic-macros -Wold-style-definition -Wmissing-format-attribute -Werror -fno-common   -DHAVE_CONFIG_H -I. -Ifortran -I/cvs/gcc/gcc -I/cvs/gcc/gcc/fortran -I/cvs/gcc/gcc/../include -I/cvs/gcc/gcc/../libcpp/include     /cvs/gcc/gcc/fortran/module.c -o fortran/module.o
cc1: warnings being treated as errors
/cvs/gcc/gcc/fortran/module.c: In function ‘gfc_use_module’:
/cvs/gcc/gcc/fortran/module.c:3102: warning: ‘series’ may be used uninitialized in this function
make[2]: *** [fortran/module.o] Error 1


> 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 a segfault.
>   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)
>
>
>

Attachment: pgp00000.pgp
Description: PGP signature

Andreas
-- 
 Andreas Jaeger, aj@suse.de, http://www.suse.de/~aj
  SUSE Linux Products GmbH, Maxfeldstr. 5, 90409 Nürnberg, Germany
   GPG fingerprint = 93A3 365E CE47 B889 DF7F  FED1 389A 563C C272 A126

Attachment: pgp00001.pgp
Description: PGP signature