https://gcc.gnu.org/g:9988d7e004796ab531df7bcda45788a7aa9276d7
commit r15-2902-g9988d7e004796ab531df7bcda45788a7aa9276d7
Author: Harald Anlauf <anl...@gmx.de>
Date: Tue Aug 13 19:17:36 2024 +0200
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 <ka...@gcc.gnu.org>
Diff:
---
gcc/fortran/array.cc | 13 +++++++++++
gcc/testsuite/gfortran.dg/abstract_type_10.f90 | 30 ++++++++++++++++++++++++++
2 files changed, 43 insertions(+)
diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 79c774d59a0b..a5e94f1fa77e 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 000000000000..a4bf65d4e122
--- /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
