public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-12] Fortran: Fixes for kind=4 characters strings [PR107266]
@ 2022-10-17 15:02 Tobias Burnus
0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2022-10-17 15:02 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:cc4b1e41c766ffcbcb60caec06e1d65cfe89a802
commit cc4b1e41c766ffcbcb60caec06e1d65cfe89a802
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Mon Oct 17 17:00:20 2022 +0200
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.
(cherry picked from commit c610cf20ebb3444ef4224d789aca670a12f5da40)
Diff:
---
gcc/fortran/ChangeLog.omp | 12 ++++++
gcc/fortran/trans-decl.cc | 10 ++---
gcc/fortran/trans-expr.cc | 12 +++---
gcc/fortran/trans-types.cc | 2 +-
gcc/testsuite/ChangeLog.omp | 10 +++++
gcc/testsuite/gfortran.dg/char4_decl-2.f90 | 63 ++++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/char4_decl.f90 | 56 ++++++++++++++++++++++++++
7 files changed, 153 insertions(+), 12 deletions(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index c0da9049a32..685fe68667a 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,15 @@
+2022-10-17 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline:
+ 2022-10-17 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/107266
+ * 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.
+
2022-10-05 Tobias Burnus <tobias@codesourcery.com>
Backport from mainline:
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 344df1a7d23..99e6b60a3cd 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7401,13 +7401,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 eb113d0ceec..05d57fbe9f5 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10358,15 +10358,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 c109c14ca4b..2dc25347b69 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2310,7 +2310,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/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 4f1976b8209..b2b4381e3ce 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,13 @@
+2022-10-17 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline:
+ 2022-10-17 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/107266
+ PR fortran/107266
+ * gfortran.dg/char4_decl.f90: New test.
+ * gfortran.dg/char4_decl-2.f90: New test.
+
2022-10-12 Andrew Stubbs <ams@codesourcery.com>
Backport from mainline:
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..d6461614a4f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char4_decl-2.f90
@@ -0,0 +1,63 @@
+! { 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 (storage_size(aa) /= storage_size(4_'foo')) stop 1
+ if (aa .ne. 4_'foo') stop 102
+ if (.not. associated (pp)) stop 103
+ if (storage_size(pp) /= storage_size(4_'bar')) stop 2
+ if (pp .ne. 4_'bar') stop 104
+
+ pp => NULL ()
+
+ call frobc (aa, pp)
+ if (.not. allocated (aa)) stop 105
+ if (storage_size(aa) /= storage_size(4_'frog')) stop 3
+ if (aa .ne. 4_'frog') stop 106
+ if (.not. associated (pp)) stop 107
+ if (storage_size(pp) /= storage_size(4_'toad')) stop 4
+ if (pp .ne. 4_'toad') stop 108
+
+
+ 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..bb6b6a8318a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char4_decl.f90
@@ -0,0 +1,56 @@
+! { 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 (storage_size(aa) /= storage_size(4_'foo')) stop 1
+ if (aa .ne. 4_'foo') stop 102
+ if (.not. associated (pp)) stop 103
+ if (storage_size(pp) /= storage_size(4_'bar')) stop 2
+ if (pp .ne. 4_'bar') stop 104
+
+ pp => NULL ()
+
+ call frobc (aa, pp)
+ if (.not. allocated (aa)) stop 105
+ if (storage_size(aa) /= storage_size(4_'frog')) stop 3
+ if (aa .ne. 4_'frog') stop 106
+ if (.not. associated (pp)) stop 107
+ if (storage_size(pp) /= storage_size(4_'toad')) stop 4
+ if (pp .ne. 4_'toad') stop 108
+
+
+ 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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-10-17 15:02 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-10-17 15:02 [gcc/devel/omp/gcc-12] Fortran: Fixes for kind=4 characters strings [PR107266] Tobias Burnus
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).