Fortran: reject array constructor value of abstract type [PR114308]

gcc/fortran/ChangeLog:

	PR fortran/114308
	* array.cc (resolve_array_list): Reject array constructor value if
	its declared type is abstract (F2018:C7114).

gcc/testsuite/ChangeLog:

	PR fortran/114308
	* gfortran.dg/abstract_type_10.f90: New test.

Co-Authored-By: Steven G. Kargl <kargl@gcc.gnu.org>

2 files changed, 43 insertions, 0 deletions

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 79c774d..a5e94f1 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -2127,6 +2127,19 @@ resolve_array_list (gfc_constructor_base base)
 		     "polymorphic [F2008: C4106]", &c->expr->where);
 	  t = false;
 	}
+
+      /* F2018:C7114 The declared type of an ac-value shall not be abstract.  */
+      if (c->expr->ts.type == BT_CLASS
+	  && c->expr->ts.u.derived
+	  && c->expr->ts.u.derived->attr.abstract
+	  && CLASS_DATA (c->expr))
+	{
+	  gfc_error ("Array constructor value %qs at %L is of the ABSTRACT "
+		     "type %qs", c->expr->symtree->name, &c->expr->where,
+		     CLASS_DATA (c->expr)->ts.u.derived->name);
+	  t = false;
+	}
+
     }
 
   return t;
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_10.f90 b/gcc/testsuite/gfortran.dg/abstract_type_10.f90
new file mode 100644
index 0000000..a4bf65d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_10.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR fortran/114308 - reject array constructor value of abstract type
+
+module my_module
+  implicit none
+  private
+
+  type, abstract, public :: a
+  end type
+
+  type, extends(a), public :: b
+  end type
+end
+
+program main
+  use my_module
+  implicit none
+  type(b)               :: b_instance
+  class(a), allocatable :: a_array(:)
+  class(b), allocatable :: b_array(:)
+
+  a_array = [b_instance]
+  b_array = [b_instance]
+  a_array = [a_array]             ! { dg-error "is of the ABSTRACT type" }
+  a_array = [a_array(1)]          ! { dg-error "is of the ABSTRACT type" }
+  a_array = [a_array, b_instance] ! { dg-error "is of the ABSTRACT type" }
+  a_array = [b_instance, a_array] ! { dg-error "is of the ABSTRACT type" }
+  b_array = [b_array, a_array]    ! { dg-error "is of the ABSTRACT type" }
+end program