2006-10-31 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29387
* trans-intrinsic.c (gfc_conv_intrinsic_len): Rearrange to have
a specific case for EXPR_VARIABLE and, in default, build an ss
to call gfc_conv_expr_descriptor for array expressions..
PR fortran/29490
* trans-expr.c (gfc_set_interface_mapping_bounds): In the case
that GFC_TYPE_ARRAY_LBOUND is not available, use descriptor
values for it and GFC_TYPE_ARRAY_UBOUND.
PR fortran/29641
* trans-types.c (gfc_get_derived_type): If the derived type
namespace has neither a parent nor a proc_name, set NULL for
the search namespace.
2006-10-31 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29387
* gfortran.dg/intrinsic_actual_2.f90: New test.
PR fortran/29490
* gfortran.dg/actual_array_interface_1.f90: New test.
PR fortran/29641
* gfortran.dg/used_types_11.f90: New test.
From-SVN: r118220
+2006-10-31 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/29387
+ * trans-intrinsic.c (gfc_conv_intrinsic_len): Rearrange to have
+ a specific case for EXPR_VARIABLE and, in default, build an ss
+ to call gfc_conv_expr_descriptor for array expressions..
+
+ PR fortran/29490
+ * trans-expr.c (gfc_set_interface_mapping_bounds): In the case
+ that GFC_TYPE_ARRAY_LBOUND is not available, use descriptor
+ values for it and GFC_TYPE_ARRAY_UBOUND.
+
+ PR fortran/29641
+ * trans-types.c (gfc_get_derived_type): If the derived type
+ namespace has neither a parent nor a proc_name, set NULL for
+ the search namespace.
+
2006-10-30 Tobias Burnus <burnus@net-b.de>
PR fortran/29452
offset = gfc_index_zero_node;
for (n = 0; n < GFC_TYPE_ARRAY_RANK (type); n++)
{
+ dim = gfc_rank_cst[n];
GFC_TYPE_ARRAY_STRIDE (type, n) = gfc_conv_array_stride (desc, n);
- if (GFC_TYPE_ARRAY_UBOUND (type, n) == NULL_TREE)
+ if (GFC_TYPE_ARRAY_LBOUND (type, n) == NULL_TREE)
+ {
+ GFC_TYPE_ARRAY_LBOUND (type, n)
+ = gfc_conv_descriptor_lbound (desc, dim);
+ GFC_TYPE_ARRAY_UBOUND (type, n)
+ = gfc_conv_descriptor_ubound (desc, dim);
+ }
+ else if (GFC_TYPE_ARRAY_UBOUND (type, n) == NULL_TREE)
{
- dim = gfc_rank_cst[n];
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound (desc, dim),
gfc_conv_descriptor_lbound (desc, dim));
gfc_symbol *sym;
gfc_se argse;
gfc_expr *arg;
+ gfc_ss *ss;
gcc_assert (!se->ss);
get_array_ctor_strlen (arg->value.constructor, &len);
break;
- default:
- if (arg->expr_type == EXPR_VARIABLE
- && (arg->ref == NULL || (arg->ref->next == NULL
- && arg->ref->type == REF_ARRAY)))
- {
- /* This doesn't catch all cases.
- See http://gcc.gnu.org/ml/fortran/2004-06/msg00165.html
- and the surrounding thread. */
- sym = arg->symtree->n.sym;
- decl = gfc_get_symbol_decl (sym);
- if (decl == current_function_decl && sym->attr.function
+ case EXPR_VARIABLE:
+ if (arg->ref == NULL
+ || (arg->ref->next == NULL && arg->ref->type == REF_ARRAY))
+ {
+ /* This doesn't catch all cases.
+ See http://gcc.gnu.org/ml/fortran/2004-06/msg00165.html
+ and the surrounding thread. */
+ sym = arg->symtree->n.sym;
+ decl = gfc_get_symbol_decl (sym);
+ if (decl == current_function_decl && sym->attr.function
&& (sym->result == sym))
- decl = gfc_get_fake_result_decl (sym, 0);
-
- len = sym->ts.cl->backend_decl;
- gcc_assert (len);
- }
- else
- {
- /* Anybody stupid enough to do this deserves inefficient code. */
- gfc_init_se (&argse, se);
- gfc_conv_expr (&argse, arg);
- gfc_add_block_to_block (&se->pre, &argse.pre);
- gfc_add_block_to_block (&se->post, &argse.post);
- len = argse.string_length;
+ decl = gfc_get_fake_result_decl (sym, 0);
+
+ len = sym->ts.cl->backend_decl;
+ gcc_assert (len);
+ break;
}
+
+ /* Otherwise fall through. */
+
+ default:
+ /* Anybody stupid enough to do this deserves inefficient code. */
+ ss = gfc_walk_expr (arg);
+ gfc_init_se (&argse, se);
+ if (ss == gfc_ss_terminator)
+ gfc_conv_expr (&argse, arg);
+ else
+ gfc_conv_expr_descriptor (&argse, arg, ss);
+ gfc_add_block_to_block (&se->pre, &argse.pre);
+ gfc_add_block_to_block (&se->post, &argse.post);
+ len = argse.string_length;
break;
}
se->expr = convert (type, len);
else
{
/* A pointer to an array. */
- arg1se.descriptor_only = 1;
- gfc_conv_expr_lhs (&arg1se, arg1->expr);
+ gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
tmp2 = gfc_conv_descriptor_data_get (arg1se.expr);
}
gfc_add_block_to_block (&se->pre, &arg1se.pre);
building anew so that potential dummy and actual arguments use the
same TREE_TYPE. If an equal type is found without a backend_decl,
build the parent version and use it in the current namespace. */
-
- /* Derived types in an interface body obtain their parent reference
- through the proc_name symbol. */
- ns = derived->ns->parent ? derived->ns->parent
- : derived->ns->proc_name->ns;
+ if (derived->ns->parent)
+ ns = derived->ns->parent;
+ else if (derived->ns->proc_name)
+ /* Derived types in an interface body obtain their parent reference
+ through the proc_name symbol. */
+ ns = derived->ns->proc_name->ns;
+ else
+ /* Sometimes there isn't a parent reference! */
+ ns = NULL;
for (; ns; ns = ns->parent)
{
+2006-10-31 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/29387
+ * gfortran.dg/intrinsic_actual_2.f90: New test.
+
+ PR fortran/29490
+ * gfortran.dg/actual_array_interface_1.f90: New test.
+
+ PR fortran/29641
+ * gfortran.dg/used_types_11.f90: New test.
+
2006-10-30 Dirk Mueller <dmueller@suse.de>
* g++.old-deja/g++.pt/eichin01a.C (main): Fix prototype.
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR29387, in which array valued arguments of
+! LEN and ASSOCIATED would cause an ICE.
+!
+! 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
--- /dev/null
+! { dg-do compile }
+! Tests the patch for PR 29641, in which an ICE would occur with
+! the ordering of USE statements below.
+!
+! Contributed by Jakub Jelinek <jakub@gcc.gnu.org>
+!
+module A
+ type :: T
+ integer :: u
+ end type T
+end module A
+
+module B
+contains
+ function foo()
+ use A
+ type(T), pointer :: foo
+ nullify (foo)
+ end function foo
+end module B
+
+subroutine bar()
+ use B ! The order here is important
+ use A ! If use A comes before use B, it works
+ type(T), pointer :: x
+ x => foo()
+end subroutine bar
+
+ use B
+ use A
+ type(T), pointer :: x
+ type(T), target :: y
+ x => y
+ print *, associated (x)
+ x => foo ()
+ print *, associated (x)
+end
projects / gcc.git / commitdiff