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>

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 79c774d59a0b1d1a16910eaf5682d3d60a446277..a5e94f1fa77e33487d6ea00892b8e86d675c159a 100644 (file)
--- 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 (file)
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