https://gcc.gnu.org/bugzilla/show_bug.cgi?id=101967
Bug ID: 101967
Summary: Implement F2018:C949
Product: gcc
Version: 12.0
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: kargl at gcc dot gnu.org
Target Milestone: ---
The source-expr in an ALLOCATE statement cannot
have a type with an coarray ultimate component.
This patch catches the issue.
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 16502da001d..03d250985d7 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -4373,7 +4383,7 @@ gfc_match_allocate (void)
if (!gfc_type_compatible (&tail->expr->ts, &ts))
{
gfc_error ("Type of entity at %L is type incompatible with "
- "typespec", &tail->expr->where);
+ "type-spec", &tail->expr->where);
goto cleanup;
}
@@ -4381,7 +4391,7 @@ gfc_match_allocate (void)
if (ts.kind != tail->expr->ts.kind && !UNLIMITED_POLY (tail->expr))
{
gfc_error ("Kind type parameter for entity at %L differs from "
- "the kind type parameter of the typespec",
+ "the kind type parameter of the type-spec",
&tail->expr->where);
goto cleanup;
}
@@ -4476,7 +4486,7 @@ alloc_opt_list:
/* The next 2 conditionals check C631. */
if (ts.type != BT_UNKNOWN)
{
- gfc_error ("SOURCE tag at %L conflicts with the typespec at %L",
+ gfc_error ("SOURCE tag at %L conflicts with the type-spec at %L",
&tmp->where, &old_locus);
goto cleanup;
}
@@ -4487,6 +4497,8 @@ alloc_opt_list:
&tmp->where))
goto cleanup;
+
+
source = tmp;
tmp = NULL;
saw_source = true;
@@ -4536,6 +4548,17 @@ alloc_opt_list:
if (gfc_match (" )%t") != MATCH_YES)
goto syntax;
+ /* C949 (R930) The declared type of source-expr shall not have a
+ coarray ultimate component. */
+ if (source
+ && source->ts.type == BT_DERIVED
+ && source->ts.u.derived->attr.coarray_comp)
+ {
+ gfc_error ("Declared type of source expression at %L has a coarray "
+ "ultimate component", &source->where);
+ goto cleanup;
+ }
+
/* Check F08:C637. */
if (source && mold)
{
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_4.f90
b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_4.f90
index ee6c3635912..b98352a9104 100644
--- a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_4.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_4.f90
@@ -15,7 +15,7 @@ program a
allocate(i(4), source=42, source=n) ! { dg-error "Redundant SOURCE tag
found" }
- allocate(integer(4) :: i(4), source=n) ! { dg-error "conflicts with the
typespec" }
+ allocate(integer(4) :: i(4), source=n) ! { dg-error "conflicts with the
type-spec" }
allocate(i(4), j(n), source=n) ! { dg-error "Fortran 2008: SOURCE tag at .1.
with more than a single allocate object" }
diff --git a/gcc/testsuite/gfortran.dg/allocate_derived_1.f90
b/gcc/testsuite/gfortran.dg/allocate_derived_1.f90
index d2c65ffa38b..12633eb5dc7 100644
--- a/gcc/testsuite/gfortran.dg/allocate_derived_1.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_derived_1.f90
@@ -34,16 +34,16 @@
allocate(t3 :: x(4))
allocate(tx :: x(5)) ! { dg-error "Error in type-spec at" }
allocate(u0 :: x(6)) ! { dg-error "may not be ABSTRACT" }
- allocate(v1 :: x(7)) ! { dg-error "is type incompatible with typespec" }
+ allocate(v1 :: x(7)) ! { dg-error "is type incompatible with type-spec" }
allocate( y(1))
- allocate(t1 :: y(2)) ! { dg-error "is type incompatible with typespec" }
+ allocate(t1 :: y(2)) ! { dg-error "is type incompatible with type-spec" }
allocate(t2 :: y(3))
- allocate(t3 :: y(3)) ! { dg-error "is type incompatible with typespec" }
+ allocate(t3 :: y(3)) ! { dg-error "is type incompatible with type-spec" }
allocate( z(1))
- allocate(t1 :: z(2)) ! { dg-error "is type incompatible with typespec" }
- allocate(t2 :: z(3)) ! { dg-error "is type incompatible with typespec" }
+ allocate(t1 :: z(2)) ! { dg-error "is type incompatible with type-spec" }
+ allocate(t2 :: z(3)) ! { dg-error "is type incompatible with type-spec" }
allocate(t3 :: z(4))
end
diff --git a/gcc/testsuite/gfortran.dg/f2018c949.f90
b/gcc/testsuite/gfortran.dg/f2018c949.f90
new file mode 100644
index 00000000000..14a1facbd73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2018c949.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+program main
+ type :: type
+ integer, allocatable :: a[:]
+ end type
+
+ type(type) :: x
+ class(*), allocatable :: y
+
+ allocate(x%a[*])
+ allocate(y, source = x) !{ dg-error "coarray ultimate component" }
+end
