Hi all,

the attached patch corrects reporting of "Sorry, unimplemented yet" for
allocatable and pointer components in polymorphic objects (BT_CLASS) thus
fixing two ICEs reported in the PR.

The next chunk fixes an ICE when the declaration containing the token
information is of type POINTER or REFERENCE.

Bootstraps and regtests ok on x86_64-linux/f23. Ok for trunk?

- Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 
gcc/fortran/ChangeLog:

2016-12-12  Andre Vehreschild  <ve...@gcc.gnu.org>

        PR fortran/77785
        * resolve.c (resolve_symbol): Correct attr lookup to the _data
        component.
        * trans-array.c (gfc_alloc_allocatable_for_assignment): Indirect ref
        pointers and references before retrieving the caf-token.

gcc/testsuite/ChangeLog:

2016-12-12  Andre Vehreschild  <ve...@gcc.gnu.org>

        PR fortran/77785
        * gfortran.dg/coarray_38.f90: Added expecting error message.
        * gfortran.dg/coarray_class_2.f90: New test.


diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2093de91..a967bfd 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -14067,8 +14067,8 @@ resolve_symbol (gfc_symbol *sym)
   if (flag_coarray == GFC_FCOARRAY_LIB && sym->ts.type == BT_CLASS
       && sym->ts.u.derived && CLASS_DATA (sym)
       && CLASS_DATA (sym)->attr.codimension
-      && (sym->ts.u.derived->attr.alloc_comp
-	  || sym->ts.u.derived->attr.pointer_comp))
+      && (CLASS_DATA (sym)->ts.u.derived->attr.alloc_comp
+	  || CLASS_DATA (sym)->ts.u.derived->attr.pointer_comp))
     {
       gfc_error ("Sorry, allocatable/pointer components in polymorphic (CLASS) "
 		 "type coarrays at %L are unsupported", &sym->declared_at);
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 8753cbf..0cd83f4 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -9337,6 +9337,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
       if (token == NULL_TREE)
 	{
 	  tmp = gfc_get_tree_for_caf_expr (expr1);
+	  if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+	    tmp = build_fold_indirect_ref (tmp);
 	  gfc_get_caf_token_offset (&caf_se, &token, NULL, tmp, NULL_TREE,
 				    expr1);
 	  token = gfc_build_addr_expr (NULL_TREE, token);
diff --git a/gcc/testsuite/gfortran.dg/coarray_38.f90 b/gcc/testsuite/gfortran.dg/coarray_38.f90
index c8011d4..04ef742 100644
--- a/gcc/testsuite/gfortran.dg/coarray_38.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_38.f90
@@ -92,7 +92,7 @@ end type t
 type t2
   class(t), allocatable :: caf2[:]
 end type t2
-class(t), save, allocatable :: caf[:]
+class(t), save, allocatable :: caf[:] ! { dg-error "Sorry, allocatable/pointer components in polymorphic" }
 type(t) :: x
 type(t2) :: y
 
diff --git a/gcc/testsuite/gfortran.dg/coarray_class_2.f90 b/gcc/testsuite/gfortran.dg/coarray_class_2.f90
new file mode 100644
index 0000000..58dce1a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_class_2.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+! Check that error message is presented as long as polymorphic coarrays are
+! not implemented.
+
+module maccscal
+   type t
+      real, allocatable :: a
+   end type
+contains
+   subroutine s(x) ! { dg-error "Sorry, allocatable/pointer components in polymorphic \\(CLASS\\)" }
+      class(t) :: x[*]
+      allocate (x%a)
+   end
+end
+module mptrscal
+   type t
+      real, pointer :: a
+   end type
+contains
+   subroutine s(x) ! { dg-error "Sorry, allocatable/pointer components in polymorphic \\(CLASS\\)" }
+      class(t) :: x[*]
+      allocate (x%a)
+   end
+end
+module mallarr
+   type t
+      real, allocatable :: a(:)
+   end type
+contains
+   subroutine s(x) ! { dg-error "Sorry, allocatable/pointer components in polymorphic \\(CLASS\\)" }
+      class(t) :: x[*]
+      allocate (x%a(2))
+   end
+end
+module mptrarr
+   type t
+      real, pointer :: a(:)
+   end type
+contains
+   subroutine s(x) ! { dg-error "Sorry, allocatable/pointer components in polymorphic \\(CLASS\\)" }
+      class(t) :: x[*]
+      allocate (x%a(2))
+   end
+end

Reply via email to