Fortran: Fix ICE with -fcheck=pointer [PR100136]

gcc/fortran/ChangeLog:

	PR fortran/100136
	* trans-expr.cc (gfc_conv_procedure_call): Add handling of pointer
	expressions.

gcc/testsuite/ChangeLog:

	PR fortran/100136
	* gfortran.dg/PR100136.f90: New test.

(cherry picked from commit 20d30e737ad79dc36817e59f1676aa8bc0c6b325)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 850007fd2e14da21c39e075d55904a25627e552e..e35ea2fc790b0c587adc9d7a9e81f89f54370ad2 100644 (file)
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7220,16 +7220,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
              else
                goto end_pointer_check;
 
+             tmp = parmse.expr;
              if (fsym && fsym->ts.type == BT_CLASS)
                {
-                 tmp = build_fold_indirect_ref_loc (input_location,
-                                                     parmse.expr);
+                 if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+                   tmp = build_fold_indirect_ref_loc (input_location, tmp);
                  tmp = gfc_class_data_get (tmp);
                  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
                    tmp = gfc_conv_descriptor_data_get (tmp);
                }
-             else
-               tmp = parmse.expr;
 
              /* If the argument is passed by value, we need to strip the
                 INDIRECT_REF.  */

diff --git a/gcc/testsuite/gfortran.dg/PR100136.f90 b/gcc/testsuite/gfortran.dg/PR100136.f90
new file mode 100644 (file)
index 0000000..922af4a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100136.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Argument not allocated" }
+! { dg-output "Fortran runtime error: Allocatable actual argument 'c_init2' is not allocated" }
+!
+! Tests fix for PR100136
+!
+! Test cut down from PR58586
+!
+
+module test_pr58586_mod
+  implicit none
+
+  type :: a
+  end type
+
+  type :: c
+     type(a), allocatable :: a
+  end type
+
+contains
+
+  subroutine add_class_c (d)
+    class(c), value :: d
+  end subroutine
+
+  class(c) function c_init2()
+    allocatable :: c_init2
+  end function
+
+end module test_pr58586_mod
+
+program test_pr58586
+  use test_pr58586_mod
+
+  ! This needs to execute, to see whether the segfault at runtime is resolved
+  call add_class_c(c_init2())
+
+end program