This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH, fortran, pr77785, v2] [Coarray] ICE in gfc_get_caf_token_offset, at fortran/trans-expr.c:1990


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 

Attachment: pr77785_v2.clog
Description: Text document

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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]