https://gcc.gnu.org/g:102d52967bde164d6b99037465688b62d57ae560

commit r13-8715-g102d52967bde164d6b99037465688b62d57ae560
Author: Paul Thomas <pa...@gcc.gnu.org>
Date:   Tue Apr 9 15:23:46 2024 +0100

    Fortran: Fix ICE in gfc_trans_pointer_assignment [PR113956]
    
    2024-04-09  Paul Thomas  <pa...@gcc.gnu.org>
    
    gcc/fortran
            PR fortran/113956
            * trans-expr.cc (gfc_trans_pointer_assignment): Remove assert
            causing the ICE since it was unnecesary.
    
    gcc/testsuite/
            PR fortran/113956
            * gfortran.dg/pr113956.f90: New test.
    
    (cherry picked from commit 88aea122a7ee639230bf17a9eda4bf8a5eb7e282)

Diff:
---
 gcc/fortran/trans-expr.cc              |  9 +++------
 gcc/testsuite/gfortran.dg/pr113956.f90 | 21 +++++++++++++++++++++
 2 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index c7ec591e279d..5c5fabf5f5ae 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10257,12 +10257,9 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, 
gfc_expr * expr2)
        {
          gfc_symbol *psym = expr1->symtree->n.sym;
          tmp = NULL_TREE;
-         if (psym->ts.type == BT_CHARACTER)
-           {
-             gcc_assert (psym->ts.u.cl->backend_decl
-                         && VAR_P (psym->ts.u.cl->backend_decl));
-             tmp = psym->ts.u.cl->backend_decl;
-           }
+         if (psym->ts.type == BT_CHARACTER
+             && psym->ts.u.cl->backend_decl)
+           tmp = psym->ts.u.cl->backend_decl;
          else if (expr1->ts.u.cl->backend_decl
                   && VAR_P (expr1->ts.u.cl->backend_decl))
            tmp = expr1->ts.u.cl->backend_decl;
diff --git a/gcc/testsuite/gfortran.dg/pr113956.f90 
b/gcc/testsuite/gfortran.dg/pr113956.f90
new file mode 100644
index 000000000000..229e891f847b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr113956.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! Test the fix for PR113956
+! Contributed by David Binderman  <dcb...@hotmail.com>
+module m
+contains
+  subroutine test_array_char(p, x)
+    character(*), target  :: x(:)
+    character(:), pointer :: p(:)
+    p => x                       ! ICE
+  end subroutine
+end module
+
+  use m
+  character(:), allocatable, target :: chr(:)
+  character(:), pointer :: p(:)
+  chr = ["ab","cd"]
+  call test_array_char (p, chr)
+  if (loc (chr) .ne. loc (p)) stop 1
+  if (len (p) .ne. 2) stop 2
+  if (any (p .ne. chr)) stop 3
+end

Reply via email to