[Bug fortran/101967] New: Implement F2018:C949

[kargl at gcc dot gnu.org]

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