This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch/gfortran] PR18109, 18283 & 19107
I think that I must be some kind of glutton for punishment! I take it
from the latest exchanges that the injunction to commit at will for this
kind of patch is withdrawn?
Anway, it's more of the same and will have to follow any corrections
that we make to the previous patch. PRs 18109 and 19107 have already
been seen on the list.
There are a number of similar problems that are not the subject of PRs.
I will try to develop solutions to these and the other remaining
character PRs whilst I am away.
2005-05-30 Paul Thomas <pault@gcc.gnu.org>
PR fortran/18109
PR fortran/18283
PR fortran/19107
* fortran/trans-array.c (gfc_conv_expr_descriptor): Obtain the
string length from the expression typespec character length value
and set temp_ss->stringlength and backend_decl. Obtain the
tree expression from gfc_conv_expr rather than gfc_conv_expr_val.
Dereference the expression to obtain the character.
* fortran/trans-expr.c (gfc_conv_component_ref): Remove the
dereference of scalar character pointer structure components.
* fortran/trans-expr.c (gfc_trans_subarray_assign): Obtain the
string length for the structure component from the component
expression.
2005-05-30 Paul Thomas <pault@gcc.gnu.org>
* gfortran.dg/char_initialiser_actual.f90:
Test character initialisers as actual arguments.
* gfortran.dg/char_pointer_comp_assign.f90:
Test character pointer structure component assignments.
* gfortran.dg/char_array_structure_constructor.f90:
Test character components in structure constructors.
Bubblestrapped and regtested on i686/RH9. OK to commit to 4.1, at least?
Paul T
Index: trans-array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-array.c,v
retrieving revision 1.46
diff -c -3 -p -r1.46 trans-array.c
*** trans-array.c 29 May 2005 16:02:09 -0000 1.46
--- trans-array.c 30 May 2005 20:03:02 -0000
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 3616,3627 ****
loop.temp_ss = gfc_get_ss ();
loop.temp_ss->type = GFC_SS_TEMP;
loop.temp_ss->next = gfc_ss_terminator;
! loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
/* ... which can hold our string, if present. */
if (expr->ts.type == BT_CHARACTER)
! se->string_length = loop.temp_ss->string_length
! = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
else
loop.temp_ss->string_length = NULL;
loop.temp_ss->data.temp.dimen = loop.dimen;
--- 3616,3638 ----
loop.temp_ss = gfc_get_ss ();
loop.temp_ss->type = GFC_SS_TEMP;
loop.temp_ss->next = gfc_ss_terminator;
! if (expr->ts.type == BT_CHARACTER)
! {
! gcc_assert (expr->ts.cl && expr->ts.cl->length
! && expr->ts.cl->length->expr_type == EXPR_CONSTANT);
! loop.temp_ss->string_length = gfc_conv_mpz_to_tree
! (expr->ts.cl->length->value.integer,
! expr->ts.cl->length->ts.kind);
! expr->ts.cl->backend_decl = loop.temp_ss->string_length;
! }
! loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
/* ... which can hold our string, if present. */
if (expr->ts.type == BT_CHARACTER)
! {
! loop.temp_ss->string_length = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
! se->string_length = loop.temp_ss->string_length;
! }
else
loop.temp_ss->string_length = NULL;
loop.temp_ss->data.temp.dimen = loop.dimen;
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 3653,3659 ****
rse.ss = ss;
gfc_conv_scalarized_array_ref (&lse, NULL);
! gfc_conv_expr_val (&rse, expr);
gfc_add_block_to_block (&block, &rse.pre);
gfc_add_block_to_block (&block, &lse.pre);
--- 3664,3676 ----
rse.ss = ss;
gfc_conv_scalarized_array_ref (&lse, NULL);
! if (expr->ts.type == BT_CHARACTER)
! {
! gfc_conv_expr (&rse, expr);
! rse.expr = gfc_build_indirect_ref (rse.expr);
! }
! else
! gfc_conv_expr_val (&rse, expr);
gfc_add_block_to_block (&block, &rse.pre);
gfc_add_block_to_block (&block, &lse.pre);
Index: trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.47
diff -c -3 -p -r1.47 trans-expr.c
*** trans-expr.c 30 May 2005 15:33:32 -0000 1.47
--- trans-expr.c 30 May 2005 20:03:05 -0000
*************** gfc_conv_component_ref (gfc_se * se, gfc
*** 281,287 ****
se->string_length = tmp;
}
! if (c->pointer && c->dimension == 0)
se->expr = gfc_build_indirect_ref (se->expr);
}
--- 281,287 ----
se->string_length = tmp;
}
! if (c->pointer && c->dimension == 0 && c->ts.type != BT_CHARACTER)
se->expr = gfc_build_indirect_ref (se->expr);
}
*************** gfc_trans_subarray_assign (tree dest, gf
*** 1671,1676 ****
--- 1671,1679 ----
gfc_start_scalarized_body (&loop, &body);
gfc_conv_tmp_array_ref (&lse);
+ if (cm->ts.type == BT_CHARACTER)
+ lse.string_length = cm->ts.cl->backend_decl;
+
gfc_conv_expr (&rse, expr);
tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts.type);
! { dg do-run }
! Tests passing of character array initialiser as actual argument.
! Fixes PR18109.
! Contributed by Paul Thomas pault@gcc.gnu.org
program char_initialiser
character*5, dimension(3) :: x
character*5, dimension(:), pointer :: y
x=(/"is Ja","ne Fo","nda"/)
call sfoo ("is Ja", x(1))
call afoo ((/"is Ja","ne Fo","nda"/), x)
y => pfoo ((/"is Ja","ne Fo","nda"/))
call afoo (y, x)
contains
subroutine sfoo(ch1, ch2)
character*(*) :: ch1, ch2
if (ch1 /= ch2) call abort ()
end subroutine sfoo
subroutine afoo(ch1, ch2)
character*(*), dimension(:) :: ch1, ch2
if (any(ch1 /= ch2)) call abort ()
end subroutine afoo
function pfoo(ch2)
character*5, dimension(:), target :: ch2
character*5, dimension(:), pointer :: pfoo
pfoo => ch2
end function pfoo
end program
! { dg-do run }
! This test the fix of PR18283, where assignments of scalar,
! character pointer components of derived types caused an ICE.
! It also checks that the array counterparts remain operational.
! Contributed by Paul Thomas pault@gcc.gnu.org
!
program char_pointer_comp_assign
implicit none
type :: dt
character (len=4), pointer :: scalar
character (len=4), pointer :: array(:)
end type dt
type (dt) :: a
character (len=4), target :: scalar_t ="abcd"
character (len=4), target :: array_t(2) = (/"abcd","efgh"/)
! Do assignments first
allocate (a%scalar, a%array(2))
a%scalar = scalar_t
if (a%scalar /= "abcd") call abort ()
a%array = array_t
if (any(a%array /= (/"abcd","efgh"/))) call abort ()
deallocate (a%scalar, a%array)
! Now do pointer assignments.
a%scalar => scalar_t
if (a%scalar /= "abcd") call abort ()
a%array => array_t
if (any(a%array /= (/"abcd","efgh"/))) call abort ()
end program char_pointer_comp_assign
! { dg-do run }
! This test the fix of PR19107, where character array actual
! arguments in derived type constructors caused an ICE.
! It also checks that the scalar counterparts are OK.
! Contributed by Paul Thomas pault@gcc.gnu.org
!
MODULE global
TYPE :: dt
CHARACTER(4) a
CHARACTER(4) b(2)
END TYPE
TYPE (dt), DIMENSION(:), ALLOCATABLE, SAVE :: c
END MODULE global
program char_array_structure_constructor
USE global
call alloc (2)
if ((any (c%a /= "wxyz")) .OR. &
(any (c%b(1) /= "abcd")) .OR. &
(any (c%b(2) /= "efgh"))) call abort ()
contains
SUBROUTINE alloc (n)
USE global
ALLOCATE (c(n), STAT=IALLOC_FLAG)
DO i = 1,n
c (i) = dt ("wxyz",(/"abcd","efgh"/))
ENDDO
end subroutine alloc
END program char_array_structure_constructor