* [Fortran, Patch, v1] Three small patches for character arrays
@ 2017-11-01 11:27 Andre Vehreschild
2017-11-04 10:27 ` [Ping, Fortran, " Andre Vehreschild
0 siblings, 1 reply; 4+ messages in thread
From: Andre Vehreschild @ 2017-11-01 11:27 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 615 bytes --]
Hi all,
during development on OpenCoarrays I found these three issues in gfortran:
- caf_send: Did not treat char arrays as arrays when calling caf_send.
- gfc_trans_assignment_1: Conversion of character kind creates a loop variant
temporary which must not be put before the loop body, but within.
- get_array_span: When doing pointer arithmetic on char arrays the character
kind was not applied.
The attached patch fixes all of these issues for trunk and gcc-7. Bootstrapped
and regtested on x86_64-linux-gnu/f25. Ok for trunk and gcc-7?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: fixes_1.clog --]
[-- Type: text/plain, Size: 508 bytes --]
gcc/fortran/ChangeLog:
2017-11-01 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-01 Andre Vehreschild <vehre@gcc.gnu.org>
* gfortran.dg/coarray/send_char_array_1.f90: New test.
[-- Attachment #3: fixes_1.diff --]
[-- Type: text/x-patch, Size: 5641 bytes --]
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 1a3e3d4..57b62a6 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -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
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 532d3ab..b0f0ab2 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -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)
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 53bc428..4115308 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 b/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90
new file mode 100644
index 0000000..800a8ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90
@@ -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:
[-- Attachment #4: fixes_1.gcc7.diff --]
[-- Type: text/x-patch, Size: 5572 bytes --]
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index fa04ed4..1cd4627 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -10066,12 +10066,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
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 3c9e1d5..6032727 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1872,12 +1872,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)
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 2323e0a..6d698ba 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -342,7 +342,14 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
|| TREE_CODE (decl) == FUNCTION_DECL
|| DECL_CONTEXT (TYPE_MAXVAL (TYPE_DOMAIN (type)))
== DECL_CONTEXT (decl)))
- span = TYPE_MAXVAL (TYPE_DOMAIN (type));
+ {
+ 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);
+ }
else
span = NULL_TREE;
diff --git a/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 b/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90
new file mode 100644
index 0000000..800a8ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90
@@ -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:
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Ping, Fortran, Patch, v1] Three small patches for character arrays
2017-11-01 11:27 [Fortran, Patch, v1] Three small patches for character arrays Andre Vehreschild
@ 2017-11-04 10:27 ` Andre Vehreschild
2017-11-04 12:06 ` Paul Richard Thomas
0 siblings, 1 reply; 4+ messages in thread
From: Andre Vehreschild @ 2017-11-04 10:27 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 729 bytes --]
Ping!
On Wed, 1 Nov 2017 12:27:11 +0100
Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
> during development on OpenCoarrays I found these three issues in gfortran:
>
> - caf_send: Did not treat char arrays as arrays when calling caf_send.
> - gfc_trans_assignment_1: Conversion of character kind creates a loop variant
> temporary which must not be put before the loop body, but within.
> - get_array_span: When doing pointer arithmetic on char arrays the character
> kind was not applied.
>
> The attached patch fixes all of these issues for trunk and gcc-7. Bootstrapped
> and regtested on x86_64-linux-gnu/f25. Ok for trunk and gcc-7?
>
> Regards,
> Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: fixes_1.clog --]
[-- Type: text/plain, Size: 508 bytes --]
gcc/fortran/ChangeLog:
2017-11-01 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-01 Andre Vehreschild <vehre@gcc.gnu.org>
* gfortran.dg/coarray/send_char_array_1.f90: New test.
[-- Attachment #3: fixes_1.diff --]
[-- Type: text/x-patch, Size: 5641 bytes --]
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 1a3e3d4..57b62a6 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -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
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 532d3ab..b0f0ab2 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -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)
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 53bc428..4115308 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 b/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90
new file mode 100644
index 0000000..800a8ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90
@@ -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:
[-- Attachment #4: fixes_1.gcc7.diff --]
[-- Type: text/x-patch, Size: 5572 bytes --]
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index fa04ed4..1cd4627 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -10066,12 +10066,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
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 3c9e1d5..6032727 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1872,12 +1872,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)
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 2323e0a..6d698ba 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -342,7 +342,14 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
|| TREE_CODE (decl) == FUNCTION_DECL
|| DECL_CONTEXT (TYPE_MAXVAL (TYPE_DOMAIN (type)))
== DECL_CONTEXT (decl)))
- span = TYPE_MAXVAL (TYPE_DOMAIN (type));
+ {
+ 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);
+ }
else
span = NULL_TREE;
diff --git a/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 b/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90
new file mode 100644
index 0000000..800a8ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90
@@ -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:
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Ping, Fortran, Patch, v1] Three small patches for character arrays
2017-11-04 10:27 ` [Ping, Fortran, " Andre Vehreschild
@ 2017-11-04 12:06 ` Paul Richard Thomas
2017-11-04 14:37 ` [Committed, " Andre Vehreschild
0 siblings, 1 reply; 4+ messages in thread
From: Paul Richard Thomas @ 2017-11-04 12:06 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML
Hi Andre,
These patches look fine to me. Thanks for taking account of the array
descriptor change between trunk and 7-branch :-)
OK for trunk and 7-branch.
Thanks
Paul
On 4 November 2017 at 10:27, Andre Vehreschild <vehre@gmx.de> wrote:
> Ping!
>
> On Wed, 1 Nov 2017 12:27:11 +0100
> Andre Vehreschild <vehre@gmx.de> wrote:
>
>> Hi all,
>>
>> during development on OpenCoarrays I found these three issues in gfortran:
>>
>> - caf_send: Did not treat char arrays as arrays when calling caf_send.
>> - gfc_trans_assignment_1: Conversion of character kind creates a loop variant
>> temporary which must not be put before the loop body, but within.
>> - get_array_span: When doing pointer arithmetic on char arrays the character
>> kind was not applied.
>>
>> The attached patch fixes all of these issues for trunk and gcc-7. Bootstrapped
>> and regtested on x86_64-linux-gnu/f25. Ok for trunk and gcc-7?
>>
>> Regards,
>> Andre
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Committed, Fortran, Patch, v1] Three small patches for character arrays
2017-11-04 12:06 ` Paul Richard Thomas
@ 2017-11-04 14:37 ` Andre Vehreschild
0 siblings, 0 replies; 4+ messages in thread
From: Andre Vehreschild @ 2017-11-04 14:37 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 1336 bytes --]
Hi Paul,
thanks for the review. Committed as r254407 to trunk and r254408 to gcc-7.
Regards,
Andre
On Sat, 4 Nov 2017 12:06:15 +0000
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
> Hi Andre,
>
> These patches look fine to me. Thanks for taking account of the array
> descriptor change between trunk and 7-branch :-)
>
> OK for trunk and 7-branch.
>
> Thanks
>
> Paul
>
>
> On 4 November 2017 at 10:27, Andre Vehreschild <vehre@gmx.de> wrote:
> > Ping!
> >
> > On Wed, 1 Nov 2017 12:27:11 +0100
> > Andre Vehreschild <vehre@gmx.de> wrote:
> >
> >> Hi all,
> >>
> >> during development on OpenCoarrays I found these three issues in gfortran:
> >>
> >> - caf_send: Did not treat char arrays as arrays when calling caf_send.
> >> - gfc_trans_assignment_1: Conversion of character kind creates a loop
> >> variant temporary which must not be put before the loop body, but within.
> >> - get_array_span: When doing pointer arithmetic on char arrays the
> >> character kind was not applied.
> >>
> >> The attached patch fixes all of these issues for trunk and gcc-7.
> >> Bootstrapped and regtested on x86_64-linux-gnu/f25. Ok for trunk and gcc-7?
> >>
> >> Regards,
> >> Andre
> >
> >
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 6648 bytes --]
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 254406)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -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
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 254406)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -10084,12 +10084,16 @@
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
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (Revision 254406)
+++ gcc/fortran/trans-intrinsic.c (Arbeitskopie)
@@ -1871,12 +1871,21 @@
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)
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c (Revision 254406)
+++ gcc/fortran/trans.c (Arbeitskopie)
@@ -320,8 +320,12 @@
|| 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
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 254406)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -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
Index: gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 (Arbeitskopie)
@@ -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:
[-- Attachment #3: submit-7.diff --]
[-- Type: text/x-patch, Size: 6542 bytes --]
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 254404)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -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-03 Paul Thomas <pault@gcc.gnu.org>
PR fortran/81735
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 254404)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -10066,12 +10066,16 @@
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
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (Revision 254404)
+++ gcc/fortran/trans-intrinsic.c (Arbeitskopie)
@@ -1872,12 +1872,21 @@
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)
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c (Revision 254404)
+++ gcc/fortran/trans.c (Arbeitskopie)
@@ -342,7 +342,14 @@
|| TREE_CODE (decl) == FUNCTION_DECL
|| DECL_CONTEXT (TYPE_MAXVAL (TYPE_DOMAIN (type)))
== DECL_CONTEXT (decl)))
- span = TYPE_MAXVAL (TYPE_DOMAIN (type));
+ {
+ 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);
+ }
else
span = NULL_TREE;
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 254404)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -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-03 Paul Thomas <pault@gcc.gnu.org>
PR fortran/81735
Index: gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 (Arbeitskopie)
@@ -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:
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2017-11-04 14:37 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-11-01 11:27 [Fortran, Patch, v1] Three small patches for character arrays Andre Vehreschild
2017-11-04 10:27 ` [Ping, Fortran, " Andre Vehreschild
2017-11-04 12:06 ` Paul Richard Thomas
2017-11-04 14:37 ` [Committed, " Andre Vehreschild
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).