:ADDPATCH fortran:
In principle, this PR was fixed, hence the restriction in the title.
In practice, the title is a lie because the real problem emerged after
the patch was committed :-)
Crucially, although there was a bug that was fixed by the previous
patch, making all the symbols PRIVATE in the module CONSTRAINT,
except the subroutine ENERGY_CONSTRAINT, exposed another bug.
When CONSTRAINT was used, success depended on the order in which it
and ATOMS were referenced. If ATOMS followed CONSTRAINT, the symbol
for NFREE was picked up and the symtree from ATOMS pointed to it.
This provided a symtree for the mio_symbol_ref that caused the ICE.
With the modules used in the opposite order, the pointer_info for the
NFREE referenced from the specification expression never gets a
symtree and so the ICE ensues.
Setting info->u.rsym.referenced inhibits the unique symtree mechanism
and prevents read_cleanup from providing the symtree needed to
reference the symbol NFREE. Removing this line, is sufficient by
itself to fix the bug and to regtest without problems.
The fix that I propose makes the setting of info->u.rsym.referenced
conditional on the presence of a suitable symtree, pointing to the
previously loaded symbol. This symtree is pointed to by the new
pointer_info. If the module being read includes a symtree, this
fix-up reference is correctly over-written. On the other hand, if no
symtree is found, read_cleanup generates one.
Now, the pointer_info has a symtree in all circumstances so the symbol
references to NFREE always have a symtree to point to.
The only advantage of this more complicated fix is to reduce the
number of unique symtrees being produced. It will be at the expense
of slightly more compilation time. If it is felt that the one line
fix (ie. removing the setting of rsym.referenced) is sufficient, I
will be perfectly happy to commit that.
The testcase is incorporated in the previous one by adding the
privatized versions of the modules.
I have added the legalization of actual_intrinsic_2.f90 to the patch.
Bootstrapped and regtested on Cygwin_NT/amd64 - OK for trunk and,
after a delay of a week and in combination with the previous patch, 4.2?
I will check the patch with tonto and others before commiting.
Paul
------------------------------------------------------------------------
2007-02-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30554
* module.c (find_symtree_for_symbol): New function to return
a symtree that is not a "unique symtree" given a symbol.
(read_module): Do not automatically set pointer_info to
referenced because this inhibits the generation of a unique
symtree. Recycle the existing symtree if possible by calling
find_symtree_for_symbol.
2007-02-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30554
* gfortran.dg/used_dummy_types_6.f90: Add the "privatized"
versions of the modules.
PR fortran/30617
* gfortran.dg/intrinsic_actual_2.f90: Make this legal fortran
by getting rid of recursive I/O and providing functions with
results.
------------------------------------------------------------------------
Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c (revision 121540)
--- gcc/fortran/module.c (working copy)
*************** read_cleanup (pointer_info *p)
*** 3304,3309 ****
--- 3304,3334 ----
}
+ /* Given a root symtree node and a symbol, try to find a symtree that
+ references the symbol that is not a unique name. */
+
+ static gfc_symtree *
+ find_symtree_for_symbol (gfc_symtree * st, gfc_symbol * sym)
+ {
+ gfc_symtree *s = NULL;
+
+ if (st == NULL)
+ return s;
+
+ s = find_symtree_for_symbol (st->right, sym);
+ if (s != NULL)
+ return s;
+ s = find_symtree_for_symbol (st->left, sym);
+ if (s != NULL)
+ return s;
+
+ if (st->n.sym == sym && !check_unique_name (st->name))
+ return st;
+
+ return s;
+ }
+
+
/* Read a module file. */
static void
*************** read_module (void)
*** 3363,3370 ****
continue;
info->u.rsym.state = USED;
- info->u.rsym.referenced = 1;
info->u.rsym.sym = sym;
}
mio_rparen ();
--- 3388,3404 ----
continue;
info->u.rsym.state = USED;
info->u.rsym.sym = sym;
+
+ /* If possible recycle the symtree that references the symbol.
+ If a symtree is not found and the module does not import one,
+ a unique-name symtree is found by read_cleanup. */
+ st = find_symtree_for_symbol (gfc_current_ns->sym_root, sym);
+ if (st != NULL)
+ {
+ info->u.rsym.symtree = st;
+ info->u.rsym.referenced = 1;
+ }
}
mio_rparen ();
Index: gcc/testsuite/gfortran.dg/used_dummy_types_6.f90
===================================================================
*** gcc/testsuite/gfortran.dg/used_dummy_types_6.f90 (revision 121540)
--- gcc/testsuite/gfortran.dg/used_dummy_types_6.f90 (working copy)
***************
*** 4,9 ****
--- 4,15 ----
! from constraint would not find the existing symtree coming directly
! from atom.
!
+ ! The last two modules came up subsequently to the original fix. The
+ ! PRIVATE statement caused a revival of the original problem. This
+ ! was tracked down to an interaction between the symbols being set
+ ! referenced during module read and the application of the access
+ ! attribute.
+ !
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
MODULE ATOMS
*************** MODULE POTENTIAL_ENERGY
*** 22,25 ****
USE ATOMS
USE CONSTRAINT, ONLY : ENERGY_CONSTRAINT
END MODULE POTENTIAL_ENERGY
! ! { dg-final { cleanup-modules "atoms constraint potential_energy" } }
--- 28,47 ----
USE ATOMS
USE CONSTRAINT, ONLY : ENERGY_CONSTRAINT
END MODULE POTENTIAL_ENERGY
!
! MODULE P_CONSTRAINT
! USE ATOMS, ONLY: NFREE
! PRIVATE
! PUBLIC :: ENERGY_CONSTRAINT
! CONTAINS
! SUBROUTINE ENERGY_CONSTRAINT ( HESSIAN )
! REAL , DIMENSION(1:(3*NFREE*(3*NFREE+1))/2):: HESSIAN
! END SUBROUTINE ENERGY_CONSTRAINT
! END MODULE P_CONSTRAINT
!
! MODULE P_POTENTIAL_ENERGY
! USE ATOMS
! USE CONSTRAINT, ONLY : ENERGY_CONSTRAINT
! END MODULE P_POTENTIAL_ENERGY
!
! ! { dg-final { cleanup-modules "atoms constraint potential_energy p_constraint p_potential_energy" } }
Index: gcc/testsuite/gfortran.dg/intrinsic_actual_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/intrinsic_actual_2.f90 (revision 121540)
--- gcc/testsuite/gfortran.dg/intrinsic_actual_2.f90 (working copy)
***************
*** 4,37 ****
!
! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
!
TYPE T1
INTEGER, POINTER :: I=>NULL()
! END TYPE T1
character(20) res
j = 10
! PRINT *, LEN(SUB(8))
! PRINT *, LEN(SUB(j))
! ! print *, len(SUB(j + 2)//"a") ! This still fails (no charlen).
! print *, len(bar(2))
! IF(.NOT.ASSOCIATED(F1(10))) CALL ABORT()
CONTAINS
FUNCTION SUB(I)
CHARACTER(LEN=I) :: SUB(1)
! PRINT *, LEN(SUB(1))
END FUNCTION
FUNCTION BAR(I)
CHARACTER(LEN=I*10) :: BAR(1)
! PRINT *, LEN(BAR)
END FUNCTION
FUNCTION F1(I) RESULT(R)
TYPE(T1), DIMENSION(:), POINTER :: R
INTEGER :: I
! ALLOCATE(R(I))
! END FUNCTION F1
END
--- 4,44 ----
!
! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
!
+ integer :: ans
TYPE T1
INTEGER, POINTER :: I=>NULL()
! END TYPE T1
! type(T1), pointer :: tar(:)
!
character(20) res
j = 10
! PRINT *, LEN(SUB(8)), ans
! PRINT *, LEN(SUB(j)), ans
! ! print *, len(SUB(j + 2)//"a"), ans ! This still fails (no charlen).
! print *, len(bar(2)), ans
! IF(.NOT.ASSOCIATED(F1(10))) CALL ABORT()
! deallocate (tar)
CONTAINS
FUNCTION SUB(I)
CHARACTER(LEN=I) :: SUB(1)
! ans = LEN(SUB(1))
! SUB = ""
END FUNCTION
FUNCTION BAR(I)
CHARACTER(LEN=I*10) :: BAR(1)
! ans = LEN(BAR)
! BAR = ""
END FUNCTION
FUNCTION F1(I) RESULT(R)
TYPE(T1), DIMENSION(:), POINTER :: R
INTEGER :: I
! ALLOCATE(tar(I))
! R => tar
! END FUNCTION F1
END