procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

trans-expr.c (gfc_trans_assignment_1): Character kind conversion may create a loop variant temporary, too.

Browse source 
gcc/fortran/ChangeLog:

2017-11-04  Andre Vehreschild  <vehre@gcc.gnu.org>

	* trans-expr.c (gfc_trans_assignment_1): Character kind conversion may
	create a loop variant temporary, too.
	* trans-intrinsic.c (conv_caf_send): Treat char arrays as arrays and
	not as scalars.
	* trans.c (get_array_span): Take the character kind into account when
	doing pointer arithmetic.

gcc/testsuite/ChangeLog:

2017-11-04  Andre Vehreschild  <vehre@gcc.gnu.org>

	* gfortran.dg/coarray/send_char_array_1.f90: New test.

From-SVN: r254407
This commit is contained in:
Andre Vehreschild 2017-11-04 15:35:45 +01:00
parent 0260e27840
commit 7c4acac3a0
6 changed files with 95 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View file

@ -1,3 +1,12 @@
2017-11-04 Andre Vehreschild <vehre@gcc.gnu.org>
* trans-expr.c (gfc_trans_assignment_1): Character kind conversion may
create a loop variant temporary, too.
* trans-intrinsic.c (conv_caf_send): Treat char arrays as arrays and
not as scalars.
* trans.c (get_array_span): Take the character kind into account when
doing pointer arithmetic.
2017-11-04 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/29600

10
gcc/fortran/trans-expr.c
View file

@ -10084,12 +10084,16 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
NOTE: This relies on having the exact dependence of the length type
parameter available to the caller; gfortran saves it in the .mod files.
NOTE ALSO: The concatenation operation generates a temporary pointer,
whose allocation must go to the innermost loop. */
whose allocation must go to the innermost loop.
NOTE ALSO (2): A character conversion may generate a temporary, too. */
if (flag_realloc_lhs
&& expr2->ts.type == BT_CHARACTER && expr1->ts.deferred
&& !(lss != gfc_ss_terminator
&& expr2->expr_type == EXPR_OP
&& expr2->value.op.op == INTRINSIC_CONCAT))
&& ((expr2->expr_type == EXPR_OP
&& expr2->value.op.op == INTRINSIC_CONCAT)
|| (expr2->expr_type == EXPR_FUNCTION
&& expr2->value.function.isym != NULL
&& expr2->value.function.isym->id == GFC_ISYM_CONVERSION))))
gfc_add_block_to_block (&block, &rse.pre);
/* Nullify the allocatable components corresponding to those of the lhs

21
gcc/fortran/trans-intrinsic.c
View file

@ -1871,12 +1871,21 @@ conv_caf_send (gfc_code *code) {
gfc_init_se (&lhs_se, NULL);
if (lhs_expr->rank == 0)
{
symbol_attribute attr;
gfc_clear_attr (&attr);
gfc_conv_expr (&lhs_se, lhs_expr);
lhs_type = TREE_TYPE (lhs_se.expr);
lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr, attr);
lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr);
if (lhs_expr->ts.type == BT_CHARACTER && lhs_expr->ts.deferred)
{
lhs_se.expr = gfc_get_tree_for_caf_expr (lhs_expr);
lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr);
}
else
{
symbol_attribute attr;
gfc_clear_attr (&attr);
gfc_conv_expr (&lhs_se, lhs_expr);
lhs_type = TREE_TYPE (lhs_se.expr);
lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr,
attr);
lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr);
}
}
else if ((lhs_caf_attr.alloc_comp || lhs_caf_attr.pointer_comp)
&& lhs_caf_attr.codimension)

8
gcc/fortran/trans.c
View file

@ -320,8 +320,12 @@ get_array_span (tree type, tree decl)
|| DECL_CONTEXT (TYPE_MAX_VALUE (TYPE_DOMAIN (type)))
== DECL_CONTEXT (decl)))
{
span = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
span = fold_convert (gfc_array_index_type, span);
span = fold_convert (gfc_array_index_type,
TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
span = fold_build2 (MULT_EXPR, gfc_array_index_type,
fold_convert (gfc_array_index_type,
TYPE_SIZE_UNIT (TREE_TYPE (type))),
span);
}
/* Likewise for class array or pointer array references. */
else if (TREE_CODE (decl) == FIELD_DECL

4
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,7 @@
2017-11-04 Andre Vehreschild <vehre@gcc.gnu.org>
* gfortran.dg/coarray/send_char_array_1.f90: New test.
2017-11-04 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/70330

54
gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 Normal file
View file

@ -0,0 +1,54 @@
!{ dg-do run }
program send_convert_char_array
implicit none
character(kind=1, len=:), allocatable, codimension[:] :: co_str_k1_scal
character(kind=1, len=:), allocatable :: str_k1_scal
character(kind=4, len=:), allocatable, codimension[:] :: co_str_k4_scal
character(kind=4, len=:), allocatable :: str_k4_scal
character(kind=1, len=:), allocatable, codimension[:] :: co_str_k1_arr(:)
character(kind=1, len=:), allocatable :: str_k1_arr(:)
character(kind=4, len=:), allocatable, codimension[:] :: co_str_k4_arr(:)
character(kind=4, len=:), allocatable :: str_k4_arr(:)
allocate(str_k1_scal, SOURCE='abcdefghij')
allocate(str_k4_scal, SOURCE=4_'abcdefghij')
allocate(character(len=20)::co_str_k1_scal[*]) ! allocate syncs here
allocate(character(kind=4, len=20)::co_str_k4_scal[*]) ! allocate syncs here
allocate(str_k1_arr, SOURCE=['abc', 'EFG', 'klm', 'NOP'])
allocate(str_k4_arr, SOURCE=[4_'abc', 4_'EFG', 4_'klm', 4_'NOP'])
allocate(character(len=5)::co_str_k1_arr(4)[*])
allocate(character(kind=4, len=5)::co_str_k4_arr(4)[*])
! First check send/copy to self
co_str_k1_scal[1] = str_k1_scal
if (co_str_k1_scal /= str_k1_scal // ' ') call abort()
co_str_k4_scal[1] = str_k4_scal
if (co_str_k4_scal /= str_k4_scal // 4_' ') call abort()
co_str_k4_scal[1] = str_k1_scal
if (co_str_k4_scal /= str_k4_scal // 4_' ') call abort()
co_str_k1_scal[1] = str_k4_scal
if (co_str_k1_scal /= str_k1_scal // ' ') call abort()
co_str_k1_arr(:)[1] = str_k1_arr
if (any(co_str_k1_arr /= ['abc ', 'EFG ', 'klm ', 'NOP '])) call abort()
co_str_k4_arr(:)[1] = [4_'abc', 4_'EFG', 4_'klm', 4_'NOP']! str_k4_arr
if (any(co_str_k4_arr /= [4_'abc ', 4_'EFG ', 4_'klm ', 4_'NOP '])) call abort()
co_str_k4_arr(:)[1] = str_k1_arr
if (any(co_str_k4_arr /= [ 4_'abc ', 4_'EFG ', 4_'klm ', 4_'NOP '])) call abort()
co_str_k1_arr(:)[1] = str_k4_arr
if (any(co_str_k1_arr /= ['abc ', 'EFG ', 'klm ', 'NOP '])) call abort()
end program send_convert_char_array
! vim:ts=2:sts=2:sw=2: