+2007-02-11 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.
+
+ PR fortran/30319
+ * decl.c (add_init_expr_to_sym): Make new charlen for an array
+ constructor initializer.
+
2007-02-10 Richard Henderson <rth@redhat.com>, Jakub Jelinek <jakub@redhat.com>
* f95-lang.c (gfc_init_builtin_functions): Add __emutls_get_address
gfc_set_constant_character_len (len, init, false);
else if (init->expr_type == EXPR_ARRAY)
{
- gfc_free_expr (init->ts.cl->length);
+ /* Build a new charlen to prevent simplification from
+ deleting the length before it is resolved. */
+ init->ts.cl = gfc_get_charlen ();
+ init->ts.cl->next = gfc_current_ns->cl_list;
+ gfc_current_ns->cl_list = sym->ts.cl;
init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length);
+
for (p = init->value.constructor; p; p = p->next)
gfc_set_constant_character_len (len, p->expr, false);
}
}
+/* 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
continue;
info->u.rsym.state = USED;
- info->u.rsym.referenced = 1;
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 ();
+2007-02-11 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.
+
+ PR fortran/30319
+ * gfortran.dg/char_array_constructor_2.f90
+
2007-02-11 Mark Mitchell <mark@codesourcery.com>
PR c++/26988
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR30319, in which the use of the parameter 'aa' in
+! the array constructor that initialises bb would cause an internal
+! error in resolution.
+!
+! Contributed by Vivek Rao <vivekrao4@yahoo.com>
+!
+module foomod
+ character (len=1), parameter :: aa = "z", bb(1) = (/aa/)
+end module foomod
+ use foomod
+ print *, aa, bb
+end
+! { dg-final { cleanup-modules "foomod" } }
!
! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
!
+ integer :: ans
TYPE T1
INTEGER, POINTER :: I=>NULL()
- END TYPE T1
+ END TYPE T1
+ type(T1), pointer :: tar(:)
+
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))
+ 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()
+ IF(.NOT.ASSOCIATED(F1(10))) CALL ABORT()
+ deallocate (tar)
CONTAINS
FUNCTION SUB(I)
CHARACTER(LEN=I) :: SUB(1)
- PRINT *, LEN(SUB(1))
+ ans = LEN(SUB(1))
+ SUB = ""
END FUNCTION
FUNCTION BAR(I)
CHARACTER(LEN=I*10) :: BAR(1)
- PRINT *, LEN(BAR)
+ ans = LEN(BAR)
+ BAR = ""
END FUNCTION
FUNCTION F1(I) RESULT(R)
TYPE(T1), DIMENSION(:), POINTER :: R
INTEGER :: I
- ALLOCATE(R(I))
- END FUNCTION F1
+ ALLOCATE(tar(I))
+ R => tar
+ END FUNCTION F1
END
! 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
USE ATOMS
USE CONSTRAINT, ONLY : ENERGY_CONSTRAINT
END MODULE POTENTIAL_ENERGY
-! { dg-final { cleanup-modules "atoms constraint 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" } }