Fortran: fix check for class array valued constructors and functions [PR123961]

	PR fortran/123961

gcc/fortran/ChangeLog:

	* check.cc (array_check): Extend check to class array functions.
	* class.cc (gfc_add_class_array_ref): Fix NULL pointer dereference.

gcc/testsuite/ChangeLog:

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

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 6bba58e7d1c32f757bf3022e8ded76849028998d..4a4e1a8d21d20deaf1154ea30207c68a4b802ab0 100644 (file)
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -832,6 +832,9 @@ array_check (gfc_expr *e, int n)
   if (e->rank != 0 && e->ts.type != BT_PROCEDURE)
     return true;
 
+  if (gfc_is_class_array_function (e))
+    return true;
+
   gfc_error ("%qs argument of %qs intrinsic at %L must be an array",
             gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
             &e->where);

diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index 2798651c41196e0073960e509d09ed6116b7d355..9c02b9bc81e9691b01377c3d370892322b2fbc20 100644 (file)
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -273,7 +273,7 @@ gfc_add_class_array_ref (gfc_expr *e)
   for (ref = e->ref; ref; ref = ref->next)
     if (!ref->next)
       break;
-  if (ref->type != REF_ARRAY)
+  if (ref && ref->type != REF_ARRAY)
     {
       ref->next = gfc_get_ref ();
       ref = ref->next;

diff --git a/gcc/testsuite/gfortran.dg/class_array_24.f90 b/gcc/testsuite/gfortran.dg/class_array_24.f90
new file mode 100644 (file)
index 0000000..c6b1ec1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_array_24.f90
@@ -0,0 +1,58 @@
+! { dg-do run }
+! { dg-additional-options "-O2 -fdump-tree-optimized" }
+!
+! PR fortran/123961 - SIZE and class array valued constructors and functions
+
+module test_overload_m
+  implicit none
+
+  type :: foo_t
+  end type foo_t
+
+  interface foo_t
+     module procedure foo_t_0_
+     module procedure foo_t_1_
+     module procedure foo_c_0_
+     module procedure foo_c_1_
+  end interface foo_t
+
+contains
+
+  function foo_t_0_(i) result(foo)
+    integer, intent(in)      :: i
+    type(foo_t), allocatable :: foo
+    allocate (foo)
+  end function foo_t_0_
+
+  function foo_t_1_(i) result(foo)
+    integer, intent(in)      :: i(:)
+    type(foo_t), allocatable :: foo(:)
+
+    allocate (foo(size (i)))
+  end function foo_t_1_
+
+  function foo_c_0_(r) result(foo)
+    real, intent(in)          :: r
+    class(foo_t), allocatable :: foo
+    allocate (foo)
+  end function foo_c_0_
+
+  function foo_c_1_(r) result(foo)
+    real, intent(in)          :: r(:)
+    class(foo_t), allocatable :: foo(:)
+
+    allocate (foo(size (r)))
+  end function foo_c_1_
+
+end module test_overload_m
+
+program test_overload
+   use test_overload_m
+   implicit none
+
+   if (size (foo_t([1,2,3])) /= 3) stop 1   ! Optimized
+   if (size (foo_t([1.,2.])) /= 2) stop 2   ! Optimized
+
+end program test_overload
+
+! { dg-final { scan-tree-dump-not "_gfortran_error_stop_numeric" "optimized" } }