[fortran] PR92959 - ICE in gfc_conv_associated, at fortran/trans-intrinsic.c:8634

Message ID CAGkQGi+ZJoD8K_EVrZ9Oqbw7_61=RDV1rsaSEmUSN4eGVnV2TQ@mail.gmail.com
State New
Headers show
Series
  • [fortran] PR92959 - ICE in gfc_conv_associated, at fortran/trans-intrinsic.c:8634
Related show

Commit Message

Paul Richard Thomas Feb. 29, 2020, 12:18 p.m.
This is a another case of the gotcha's that come from trying to use
ts.u.cl->backend_decl directly, where deferred length and even, in
this case fixed length characters are concerned. The fix is to make
use of the string length obtained from evaluation of the expression.

Regtested on FC31/x86_64 - OK for trunk?

Paul

2020-02-29  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/92959
    * trans-intrinsic.c (gfc_conv_associated): Eliminate
    'nonzero_charlen' and move the chunk to evaluate zero character
    length until after the argument evaluation so that the string
    length can be used.

2020-02-29  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/92959
    * gfortran.dg/associated_8.f90 : New test.

Comments

Thomas Koenig March 1, 2020, 1:44 p.m. | #1
Hi Paul,

> Regtested on FC31/x86_64 - OK for trunk?



OK. Thanks for the patch!

Regards

	Thomas
Paul Richard Thomas March 1, 2020, 4:21 p.m. | #2
Committed to head as r10-6952-g7067f8c814088c1d02e40adf79a80f5ec53dbdde

Thanks, Thomas

Paul

On Sun, 1 Mar 2020 at 13:44, Thomas Koenig <tkoenig@netcologne.de> wrote:
>

> Hi Paul,

>

> > Regtested on FC31/x86_64 - OK for trunk?

>

>

> OK. Thanks for the patch!

>

> Regards

>

>         Thomas




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Patch

Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c	(revision 279842)
--- gcc/fortran/trans-intrinsic.c	(working copy)
*************** gfc_conv_associated (gfc_se *se, gfc_exp
*** 8573,8579 ****
    gfc_se arg2se;
    tree tmp2;
    tree tmp;
-   tree nonzero_charlen;
    tree nonzero_arraylen;
    gfc_ss *ss;
    bool scalar;
--- 8573,8578 ----
*************** gfc_conv_associated (gfc_se *se, gfc_exp
*** 8629,8641 ****
        if (arg2->expr->ts.type == BT_CLASS)
  	gfc_add_data_component (arg2->expr);

-       nonzero_charlen = NULL_TREE;
-       if (arg1->expr->ts.type == BT_CHARACTER)
- 	nonzero_charlen = fold_build2_loc (input_location, NE_EXPR,
- 					   logical_type_node,
- 					   arg1->expr->ts.u.cl->backend_decl,
- 					   build_zero_cst
- 					   (TREE_TYPE (arg1->expr->ts.u.cl->backend_decl)));
        if (scalar)
          {
  	  /* A pointer to a scalar.  */
--- 8628,8633 ----
*************** gfc_conv_associated (gfc_se *se, gfc_exp
*** 8705,8714 ****

        /* If target is present zero character length pointers cannot
  	 be associated.  */
!       if (nonzero_charlen != NULL_TREE)
! 	se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
! 				    logical_type_node,
! 				    se->expr, nonzero_charlen);
      }

    se->expr = convert (gfc_typenode_for_spec (&expr->ts), se->expr);
--- 8697,8711 ----

        /* If target is present zero character length pointers cannot
  	 be associated.  */
!       if (arg1->expr->ts.type == BT_CHARACTER)
! 	{
! 	  tmp = arg1se.string_length;
! 	  tmp = fold_build2_loc (input_location, NE_EXPR,
! 				 logical_type_node, tmp,
! 				 build_zero_cst (TREE_TYPE (tmp)));
! 	  se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
! 				      logical_type_node, se->expr, tmp);
! 	}
      }

    se->expr = convert (gfc_typenode_for_spec (&expr->ts), se->expr);
Index: gcc/testsuite/gfortran.dg/associated_8.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associated_8.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/associated_8.f90	(working copy)
***************
*** 0 ****
--- 1,37 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR92959, where compilation of ASSOCIATED segfaulted in 's1' and 's2'.
+ !
+ ! Contributed by Gerhard Steinmetz  <gscfq@t-online.de>
+ !
+ program p
+    character(:), pointer :: x, y => NULL()
+    character, pointer :: u, v => NULL ()
+    character(4), target :: tgt = "abcd"
+
+ ! Manifestly not associated
+    x => tgt
+    u => tgt(1:1)
+    call s1 (.false., 1)
+    call s2 (.false., 2)
+ ! Manifestly associated
+    y => x
+    v => u
+    call s1 (.true., 3)
+    call s2 (.true., 4)
+ ! Zero sized storage sequences must give a false.
+    y => tgt(1:0)
+    x => y
+    call s1 (.false., 5)
+ contains
+    subroutine s1 (state, err_no)
+       logical :: state
+       integer :: err_no
+       if (associated(x, y) .neqv. state) stop err_no
+    end
+    subroutine s2 (state, err_no)
+       logical :: state
+       integer :: err_no
+       if (associated(u, v) .neqv. state) stop err_no
+     end
+ end