Fortran: fix ICE on LOC intrinsic with polymorphic argument [PR125606]

The fix for PR122977 improved the gfc_is_simply_contiguous check for
associate variables, but had a side effect when using the LOC() intrinsic
on SELECT TYPE temporaries where gfc_is_simply_contiguous could return
false.  Fall back to simply taking the address of the variable's address.

	PR fortran/125606

gcc/fortran/ChangeLog:

	* trans-intrinsic.cc (gfc_conv_intrinsic_loc): When the argument
	of LOC() is not scalar or known to be simply contiguous, simply
	take the address of the argument array's first element.

gcc/testsuite/ChangeLog:

	* gfortran.dg/loc_3.f90: New test.

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index fdb9ddb52eaac21ffbe9e380b673903758492627..a2a6c6979d98fe07210a09161ebed3a51ce26209 100644 (file)
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -9829,9 +9829,15 @@ gfc_conv_intrinsic_loc (gfc_se * se, gfc_expr * expr)
        gfc_add_data_component (arg_expr);
       gfc_conv_expr_reference (se, arg_expr);
     }
-  else
+  else if (gfc_is_simply_contiguous (arg_expr, false, false))
     gfc_conv_array_parameter (se, arg_expr, true, NULL, NULL, NULL);
+  else
+    {
+      gfc_conv_expr_descriptor (se, arg_expr);
+      se->expr = gfc_conv_descriptor_data_get (se->expr);
+    }
   se->expr = convert (gfc_get_int_type (gfc_index_integer_kind), se->expr);
+  se->expr = gfc_evaluate_now (se->expr, &se->pre);
 
   /* Create a temporary variable for loc return value.  Without this,
      we get an error an ICE in gcc/expr.cc(expand_expr_addr_expr_1).  */

diff --git a/gcc/testsuite/gfortran.dg/loc_3.f90 b/gcc/testsuite/gfortran.dg/loc_3.f90
new file mode 100644 (file)
index 0000000..efc7d0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/loc_3.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-additional-options "-O1" }
+!
+! PR fortran/125606
+!
+! Derived from Fujitsu testsuite
+! Reported by David Binderman
+
+module m
+  implicit none
+  type ty
+     class(*), allocatable :: c1(:)
+  end type ty
+  type tt
+     class(*), allocatable :: node1(:)
+  end type tt
+  type,extends(tt)::tte
+     class(*), allocatable :: c2e(:)
+  end type tte
+contains
+  subroutine put_addr
+    class(*), allocatable :: t(:)
+    integer :: unit
+    select type (t)
+    class is (tt)
+       select type (p=>t(2)%node1)
+       class is (ty)
+          write (unit) loc(p(2)%c1)
+       end select
+       select type (t)
+       type is (tte)
+          write (7) loc(t(2)%c2e)
+       end select
+    end select
+  end subroutine put_addr
+end module m