OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/29387 (ICE on character array function of variable length) 

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
This commit is contained in:
Paul Thomas 2006-10-31 06:03:24 +00:00
parent e5c18c3c29
commit dd5797cc36
8 changed files with 150 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gcc/fortran/ChangeLog
View File

@ -1,3 +1,20 @@
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

11
gcc/fortran/trans-expr.c
View File

@ -1296,10 +1296,17 @@ gfc_set_interface_mapping_bounds (stmtblock_t * block, tree type, tree desc)
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));

55
gcc/fortran/trans-intrinsic.c
View File

@ -2429,6 +2429,7 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
gfc_symbol *sym;
gfc_se argse;
gfc_expr *arg;
gfc_ss *ss;
gcc_assert (!se->ss);
@ -2448,32 +2449,37 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
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);
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;
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);
@ -3020,8 +3026,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
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);

14
gcc/fortran/trans-types.c
View File

@ -1482,11 +1482,15 @@ gfc_get_derived_type (gfc_symbol * derived)
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)
{

11
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,14 @@
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.

0
gcc/testsuite/gfortran.dg/actual_array_interface_1.f90 Normal file
View File

37
gcc/testsuite/gfortran.dg/intrinsic_actual_2.f90 Normal file
View File

@ -0,0 +1,37 @@
! { 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

37
gcc/testsuite/gfortran.dg/used_types_11.f90 Normal file
View File

@ -0,0 +1,37 @@
! { 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