Long introduction - but the patch is rather simple: Don't use kind=1
as type where kind=4 should be used.
Long introduction + background, feel free to skip.
This popped up for libgomp/testsuite/libgomp.fortran/struct-elem-map-1.f90
which uses kind=4 characters – if Sandra's "Fortran: delinearize
multi-dimensional
array accesses" patch is applied.
Patch: https://gcc.gnu.org/pipermail/gcc-patches/2020-December/562230.html
Used for OG11:
https://gcc.gnu.org/pipermail/gcc-patches/2021-November/584716.html
On the OG12 alias devel/omp/gcc-12 vendor branch, it is used:
https://gcc.gnu.org/g:39a8c371fda6136cf77c74895a00b136409e0ba3
* * *
For mainline, I did not observe a wrong-code issue at runtime, still:
void frobc (character(kind=4)[1:*_a] * & restrict a, ...
...
static void frobc (character(kind=1) * & restrict, ...
feels odd, i.e. having the definition as kind=4 and the declaration as kind=1.
With the patch, it becomes:
static void frobc (character(kind=4) * & restrict, character(kind=4) * &, ...
* * *
For the following, questionable code (→ PR107266), it is even worse:
character(kind=4) function f(x) bind(C)
character(kind=4), value :: x
end
this gives the following, which has the wrong ABI:
character(kind=1) f (character(kind=1) x)
{
(void) 0;
}
With the patch, it becomes:
character(kind=4) f (character(kind=4) x)
* * *
I think that all only exercises the trans-type.cc patch;
the trans-expr.cc code gets called – as an assert shows,
but I fail to get a dump where this goes wrong.
However, for struct-elem-map-1.f90 with mainline or with
OG12 and the patch:
#pragma omp target map(tofrom:var.uni2[40 / 20] [len: 20])
while on OG12 without the attached patch:
#pragma omp target map(tofrom:var.uni2[40 / 5] [len: 5])
where the problem is that TYPE_SIZE_UNIT is wrong. Whether
this only affects OG12 due to the delinearizer patch or
some code on mainline as well, I don't know.
Still, I think it should be fixed ...
OK for mainline?
Tobias
-
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634
München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas
Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht
München, HRB 106955
Fortran: Fixes for kind=4 characters strings [PR107266]
PR fortran/107266
gcc/fortran/
* trans-expr.cc (gfc_conv_string_parameter): Use passed
type to honor character kind.
* trans-types.cc (gfc_sym_type): Honor character kind.
* trans-decl.cc (gfc_conv_cfi_to_gfc): Fix handling kind=4
character strings.
gcc/testsuite/
* gfortran.dg/char4_decl.f90: New test.
* gfortran.dg/char4_decl-2.f90: New test.
gcc/fortran/trans-decl.cc | 10 ++---
gcc/fortran/trans-expr.cc | 12 +++---
gcc/fortran/trans-types.cc | 2 +-
gcc/testsuite/gfortran.dg/char4_decl-2.f90 | 59 ++
gcc/testsuite/gfortran.dg/char4_decl.f90 | 52 ++
5 files changed, 123 insertions(+), 12 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 5d16d640322..4b570c3551a 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7378,13 +7378,13 @@ done:
/* Set string length for len=:, only. */
if (sym->ts.type == BT_CHARACTER && !sym->ts.u.cl->length)
{
- tmp = sym->ts.u.cl->backend_decl;
+ tmp2 = gfc_get_cfi_desc_elem_len (cfi);
+ tmp = fold_convert (TREE_TYPE (tmp2), sym->ts.u.cl->backend_decl);
if (sym->ts.kind != 1)
tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type,
- sym->ts.u.cl->backend_decl, tmp);
- tmp2 = gfc_get_cfi_desc_elem_len (cfi);
- gfc_add_modify (, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
+ TREE_TYPE (tmp2), tmp,
+ build_int_cst (TREE_TYPE (tmp2), sym->ts.kind));
+ gfc_add_modify (, tmp2, tmp);
}
if (!sym->attr.dimension)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 1551a2e4df4..e7b9211f17e 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10374,15 +10374,15 @@ gfc_conv_string_parameter (gfc_se * se)
|| TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE)
&& TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
{
+ type = TREE_TYPE (se->expr);
if (TREE_CODE (se->expr) != INDIRECT_REF)
- {
- type = TREE_TYPE (se->expr);
- se->expr = gfc_build_addr_expr (build_pointer_type (type), se->expr);
- }
+ se->expr = gfc_build_addr_expr (build_pointer_type (type), se->expr);
else
{
- type = gfc_get_character_type_len (gfc_default_character_kind,
- se->string_length);
+ if (TREE_CODE (type) == ARRAY_TYPE)
+ type = TREE_TYPE (type);
+ type = gfc_get_character_type_len_for_eltype (type,
+ se->string_length);
type = build_pointer_type (type);
se->expr =
