Fortran: Fixes for kind=4 characters strings [PR107266]

Message ID d7e998fb-2ab6-71a2-7e58-c72a08a453a7@codesourcery.com
State Accepted
Headers
Series Fortran: Fixes for kind=4 characters strings [PR107266] |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Tobias Burnus Oct. 14, 2022, 9:18 p.m. UTC
  Long introduction - but the patch is rather simple: Don't use kind=1
as type where kind=4 should be used.

Looooong introduction + background, feel free to skip.

---------------<intro/background>-------------

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 ...

---------------<END of intro/background>-------------

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
  

Comments

Harald Anlauf Oct. 16, 2022, 7:59 p.m. UTC | #1
Hi Tobias,

the patch LGTM.

Regarding testcase char4_decl-2.f90, I played a little and found that
one could in addition check the storage_size of aa, pp in the main and
compare with storage_size (4_'foo') etc.  Without your patch the
storage sizes look odd.  (Strictly speaking, a comparison like
   if (aa .ne. 4_'foo') stop 123
is not fully sufficient to catch such oddities.)

Thanks,
Harald


Am 14.10.22 um 23:18 schrieb Tobias Burnus:
> Long introduction - but the patch is rather simple: Don't use kind=1
> as type where kind=4 should be used.
>
> Looooong introduction + background, feel free to skip.
>
> ---------------<intro/background>-------------
>
> 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 ...
>
> ---------------<END of intro/background>-------------
>
> 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
  

Patch

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 (&block, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
+			       TREE_TYPE (tmp2), tmp,
+			       build_int_cst (TREE_TYPE (tmp2), sym->ts.kind));
+      gfc_add_modify (&block, 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 = gfc_build_addr_expr (type, se->expr);
 	}
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index c062a5b29d7..fdce56defec 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2314,7 +2314,7 @@  gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
 	      && sym->ns->proc_name->attr.is_bind_c)
 	  || (sym->ts.deferred && (!sym->ts.u.cl
 				   || !sym->ts.u.cl->backend_decl))))
-    type = gfc_character1_type_node;
+    type = gfc_get_char_type (sym->ts.kind);
   else
     type = gfc_typenode_for_spec (&sym->ts, sym->attr.codimension);
 
diff --git a/gcc/testsuite/gfortran.dg/char4_decl-2.f90 b/gcc/testsuite/gfortran.dg/char4_decl-2.f90
new file mode 100644
index 00000000000..3eeadd64981
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char4_decl-2.f90
@@ -0,0 +1,59 @@ 
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+
+! In this program shall be no kind=1,
+! except for the 'argv' of the 'main' program.
+
+! PR fortran/107266
+
+! { dg-final { scan-tree-dump-times "kind=1" 1 "original" } }
+! { dg-final { scan-tree-dump-times "character\\(kind=1\\) \\* \\* argv\\)" 1 "original" } }
+
+
+! { dg-final { scan-tree-dump-times "character\\(kind=4\\) f \\(character\\(kind=4\\) x\\)" 1 "original" } }
+
+character(kind=4) function f(x) bind(C)
+  character(kind=4), value :: x
+end
+
+program testit
+  implicit none (type, external)
+  character (kind=4, len=:), allocatable :: aa
+  character (kind=4, len=:), pointer :: pp
+
+  pp => NULL ()
+
+  call frobf (aa, pp)
+  if (.not. allocated (aa)) stop 101
+  if (aa .ne. 4_'foo') stop 102
+  if (.not. associated (pp)) stop 103
+  if (pp .ne. 4_'bar') stop 104
+
+  pp => NULL ()
+
+  call frobc (aa, pp)
+  if (.not. allocated (aa)) stop 101
+  if (aa .ne. 4_'frog') stop 102
+  if (.not. associated (pp)) stop 103
+  if (pp .ne. 4_'toad') stop 104
+
+
+  contains
+
+    subroutine frobf (a, p) Bind(C)
+      character (kind=4, len=:), allocatable :: a
+      character (kind=4, len=:), pointer :: p
+      allocate (character(kind=4, len=3) :: p)
+      a = 4_'foo'
+      p = 4_'bar'
+    end subroutine
+
+    subroutine frobc (a, p) Bind(C)
+      character (kind=4, len=:), allocatable :: a
+      character (kind=4, len=:), pointer :: p
+      allocate (character(kind=4, len=4) :: p)
+      a = 4_'frog'
+      p = 4_'toad'
+    end subroutine
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/char4_decl.f90 b/gcc/testsuite/gfortran.dg/char4_decl.f90
new file mode 100644
index 00000000000..ab7b372d731
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char4_decl.f90
@@ -0,0 +1,52 @@ 
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+
+! In this program shall be no kind=1,
+! except for the 'argv' of the 'main' program.
+
+! Related PR fortran/107266
+
+! { dg-final { scan-tree-dump-times "kind=1" 1 "original" } }
+! { dg-final { scan-tree-dump-times "character\\(kind=1\\) \\* \\* argv\\)" 1 "original" } }
+
+program testit
+  implicit none (type, external)
+  character (kind=4, len=:), allocatable :: aa
+  character (kind=4, len=:), pointer :: pp
+
+  pp => NULL ()
+
+  call frobf (aa, pp)
+  if (.not. allocated (aa)) stop 101
+  if (aa .ne. 4_'foo') stop 102
+  if (.not. associated (pp)) stop 103
+  if (pp .ne. 4_'bar') stop 104
+
+  pp => NULL ()
+
+  call frobc (aa, pp)
+  if (.not. allocated (aa)) stop 101
+  if (aa .ne. 4_'frog') stop 102
+  if (.not. associated (pp)) stop 103
+  if (pp .ne. 4_'toad') stop 104
+
+
+  contains
+
+    subroutine frobf (a, p)
+      character (kind=4, len=:), allocatable :: a
+      character (kind=4, len=:), pointer :: p
+      allocate (character(kind=4, len=3) :: p)
+      a = 4_'foo'
+      p = 4_'bar'
+    end subroutine
+
+    subroutine frobc (a, p)
+      character (kind=4, len=:), allocatable :: a
+      character (kind=4, len=:), pointer :: p
+      allocate (character(kind=4, len=4) :: p)
+      a = 4_'frog'
+      p = 4_'toad'
+    end subroutine
+
+end program