[Bug fortran/93714] [8/9/10 Regression] ICE in gfc_check_same_strlen, at fortran/check.c:1253

[markeggleston at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93714

markeggleston at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |markeggleston at gcc dot gnu.org

--- Comment #2 from markeggleston at gcc dot gnu.org ---
Patch in comment 1 produces:

z1.f90 -> pr93714_1.f90

pr93714_1.f90:3:4:

    3 |    character, pointer :: b => a
      |    1
Error: Unclassifiable statement at (1)
pr93714_1.f90:2:13:

    2 |    character((1.)) :: a
      |             1
Error: Expression at (1) must be of INTEGER type, found REAL

z2.f90 -> pr93714_1.f90

pr93714_2.f90:3:4:

    3 |    character(:), pointer :: b => a
      |    1
Error: Unclassifiable statement at (1)
pr93714_2.f90:2:13:

    2 |    character((9.)), target :: a
      |             1
Error: Expression at (1) must be of INTEGER type, found REAL

Can do better than "Unclassifiable statement".

Moving the check for lvalue being a character to after the handling of pointer
and target attributes:

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a9698c3e3d2..79e00b4112a 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4222,13 +4222,6 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr
*rvalue,
   if (rvalue->expr_type == EXPR_NULL)
     return true;

-  if (lvalue->ts.type == BT_CHARACTER)
-    {
-      bool t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment");
-      if (!t)
-       return false;
-    }
-
   if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
     lvalue->symtree->n.sym->attr.subref_array_pointer = 1;

@@ -4284,6 +4277,13 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr
*rvalue,
        }
     }

+  if (lvalue->ts.type == BT_CHARACTER)
+    {
+      bool t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment");
+      if (!t)
+       return false;
+    }
+
   if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym))
     {
       gfc_error ("Bad target in pointer assignment in PURE "

and omitting Steve Kargl's patch results in:

pr93714_1.f90:3:31:

    3 |    character, pointer :: b => a
      |                               1
Error: Pointer assignment target in initialization expression does not have the
TARGET attribute at (1)
pr93714_1.f90:2:13:

    2 |    character((1.)) :: a
      |             1
Error: Expression at (1) must be of INTEGER type, found REAL

and

pr93714_2.f90:3:34:

    3 |    character(:), pointer :: b => a
      |                                  1
Error: Pointer assignment target in initialization expression does not have the
TARGET attribute at (1)
pr93714_2.f90:2:13:

    2 |    character((9.)) :: a
      |             1
Error: Expression at (1) must be of INTEGER type, found REAL

Running make with check-fortran resulted in char_pointer_assign_6.f90 failing:

char_pointer_assign_6.f90:8:2:

    8 |   p1 => s1(2:3) ! { dg-error "Unequal character lengths \\(20/2\\)" }
      |  1
Error: Unequal character lengths (20/2) in pointer assignment at (1)
char_pointer_assign_6.f90:9:8:

    9 |   p1 => c(1:) ! { dg-error "Unequal character lengths \\(20/4\\)" }
      |        1
Error: Pointer assignment target is neither TARGET nor POINTER at (1)
char_pointer_assign_6.f90:10:8:

   10 |   p1 => c(:4) ! { dg-error "Unequal character lengths \\(20/4\\)" }
      |        1
Error: Pointer assignment target is neither TARGET nor POINTER at (1)

The variable c does not have the target attribute so the unequal character
lengths messages should not have occurred.

I'm now modifying char_pointer_assign_6.f90 and adding test cases so I can send
a patch upstream for approval.