public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-1016] OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE [PR86470]
@ 2021-05-24 14:59 Tobias Burnus
  0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2021-05-24 14:59 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:0e3b3b77e13cac764a135a7118613c47686e0a62

commit r12-1016-g0e3b3b77e13cac764a135a7118613c47686e0a62
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Mon May 24 16:50:51 2021 +0200

    OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE [PR86470]
    
    gcc/fortran/ChangeLog:
    
            PR fortran/86470
            * trans-expr.c (gfc_copy_class_to_class): Add unshare_expr.
            * trans-openmp.c (gfc_is_polymorphic_nonptr,
            gfc_is_unlimited_polymorphic_nonptr): New.
            (gfc_omp_clause_copy_ctor, gfc_omp_clause_dtor): Handle
            polymorphic scalars.
    
    libgomp/ChangeLog:
    
            PR fortran/86470
            * testsuite/libgomp.fortran/class-firstprivate-1.f90: New test.
            * testsuite/libgomp.fortran/class-firstprivate-2.f90: New test.
            * testsuite/libgomp.fortran/class-firstprivate-3.f90: New test.
    
    gcc/testsuite/ChangeLog:
    
            PR fortran/86470
            * gfortran.dg/gomp/class-firstprivate-1.f90: New test.
            * gfortran.dg/gomp/class-firstprivate-2.f90: New test.
            * gfortran.dg/gomp/class-firstprivate-3.f90: New test.
            * gfortran.dg/gomp/class-firstprivate-4.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.c                           |   2 +-
 gcc/fortran/trans-openmp.c                         | 162 +++++++++-
 .../gfortran.dg/gomp/class-firstprivate-1.f90      |  62 ++++
 .../gfortran.dg/gomp/class-firstprivate-2.f90      |  54 ++++
 .../gfortran.dg/gomp/class-firstprivate-3.f90      |  61 ++++
 .../gfortran.dg/gomp/class-firstprivate-4.f90      |  44 +++
 .../libgomp.fortran/class-firstprivate-1.f90       | 323 ++++++++++++++++++++
 .../libgomp.fortran/class-firstprivate-2.f90       | 334 +++++++++++++++++++++
 .../libgomp.fortran/class-firstprivate-3.f90       | 334 +++++++++++++++++++++
 9 files changed, 1374 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 3432cd4fdfd..00690fe9ed4 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1561,7 +1561,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
 	{
 	  vec_safe_push (args, from_len);
 	  vec_safe_push (args, to_len);
-	  extcopy = build_call_vec (fcn_type, fcn, args);
+	  extcopy = build_call_vec (fcn_type, unshare_expr (fcn), args);
 	  tmp = fold_build2_loc (input_location, GT_EXPR,
 				 logical_type_node, from_len,
 				 build_zero_cst (TREE_TYPE (from_len)));
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 5666cd68c7e..44542d9ab1a 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -360,6 +360,39 @@ gfc_has_alloc_comps (tree type, tree decl)
   return false;
 }
 
+/* Return true if TYPE is polymorphic but not with pointer attribute.  */
+
+static bool
+gfc_is_polymorphic_nonptr (tree type)
+{
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+  return GFC_CLASS_TYPE_P (type);
+}
+
+/* Return true if TYPE is unlimited polymorphic but not with pointer attribute;
+   unlimited means also intrinsic types are handled and _len is used.  */
+
+static bool
+gfc_is_unlimited_polymorphic_nonptr (tree type)
+{
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+  if (!GFC_CLASS_TYPE_P (type))
+    return false;
+
+  tree field = TYPE_FIELDS (type); /* _data */
+  gcc_assert (field);
+  field = DECL_CHAIN (field); /* _vptr */
+  gcc_assert (field);
+  field = DECL_CHAIN (field);
+  if (!field)
+    return false;
+  gcc_assert (strcmp ("_len", IDENTIFIER_POINTER (DECL_NAME (field))) == 0);
+  return true;
+}
+
+
 /* Return true if DECL in private clause needs
    OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause.  */
 bool
@@ -743,12 +776,88 @@ tree
 gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
 {
   tree type = TREE_TYPE (dest), ptr, size, call;
+  tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause));
   tree cond, then_b, else_b;
   stmtblock_t block, cond_block;
 
   gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
 	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
 
+  if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause))
+      && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause))
+      && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)))
+    decl_type
+      = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)));
+
+  if (gfc_is_polymorphic_nonptr (decl_type))
+    {
+      if (POINTER_TYPE_P (decl_type))
+	decl_type = TREE_TYPE (decl_type);
+      decl_type = TREE_TYPE (TYPE_FIELDS (decl_type));
+      if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type))
+	fatal_error (input_location,
+		     "Sorry, polymorphic arrays not yet supported for "
+		     "firstprivate");
+      tree src_len;
+      tree nelems = build_int_cst (size_type_node, 1);  /* Scalar.  */
+      tree src_data = gfc_class_data_get (unshare_expr (src));
+      tree dest_data = gfc_class_data_get (unshare_expr (dest));
+      bool unlimited = gfc_is_unlimited_polymorphic_nonptr (type);
+
+      gfc_start_block (&block);
+      gfc_add_modify (&block, gfc_class_vptr_get (dest),
+		      gfc_class_vptr_get (src));
+      gfc_init_block (&cond_block);
+
+      if (unlimited)
+	{
+	  src_len = gfc_class_len_get (src);
+	  gfc_add_modify (&cond_block, gfc_class_len_get (unshare_expr (dest)), src_len);
+	}
+
+      /* Use: size = class._vtab._size * (class._len > 0 ? class._len : 1).  */
+      size = fold_convert (size_type_node, gfc_class_vtab_size_get (src));
+      if (unlimited)
+	{
+	  cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+				  unshare_expr (src_len),
+				  build_zero_cst (TREE_TYPE (src_len)));
+	  cond = build3_loc (input_location, COND_EXPR, size_type_node, cond,
+			     fold_convert (size_type_node,
+					   unshare_expr (src_len)),
+			     build_int_cst (size_type_node, 1));
+	  size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+				  size, cond);
+	}
+
+      /* Malloc memory + call class->_vpt->_copy.  */
+      call = builtin_decl_explicit (BUILT_IN_MALLOC);
+      call = build_call_expr_loc (input_location, call, 1, size);
+      gfc_add_modify (&cond_block, dest_data,
+		      fold_convert (TREE_TYPE (dest_data), call));
+      gfc_add_expr_to_block (&cond_block,
+			     gfc_copy_class_to_class (src, dest, nelems,
+						      unlimited));
+
+      gcc_assert (TREE_CODE (dest_data) == COMPONENT_REF);
+      if (!GFC_DECL_GET_SCALAR_ALLOCATABLE (TREE_OPERAND (dest_data, 1)))
+	{
+	  gfc_add_block_to_block (&block, &cond_block);
+	}
+      else
+	{
+	  /* Create: if (class._data != 0) <cond_block> else class._data = NULL; */
+	  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				  src_data, null_pointer_node);
+	  gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
+				 void_type_node, cond,
+				 gfc_finish_block (&cond_block),
+				 fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+				 unshare_expr (dest_data), null_pointer_node)));
+	}
+      return gfc_finish_block (&block);
+    }
+
   if ((! GFC_DESCRIPTOR_TYPE_P (type)
        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
@@ -773,7 +882,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
 
   gfc_init_block (&cond_block);
 
-  gfc_add_modify (&cond_block, dest, src);
+  gfc_add_modify (&cond_block, dest, fold_convert (TREE_TYPE (dest), src));
   if (GFC_DESCRIPTOR_TYPE_P (type))
     {
       tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
@@ -1185,6 +1294,57 @@ tree
 gfc_omp_clause_dtor (tree clause, tree decl)
 {
   tree type = TREE_TYPE (decl), tem;
+  tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause));
+
+  if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause))
+      && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause))
+      && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)))
+    decl_type
+	= TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)));
+  if (gfc_is_polymorphic_nonptr (decl_type))
+    {
+      if (POINTER_TYPE_P (decl_type))
+	decl_type = TREE_TYPE (decl_type);
+      decl_type = TREE_TYPE (TYPE_FIELDS (decl_type));
+      if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type))
+	fatal_error (input_location,
+		     "Sorry, polymorphic arrays not yet supported for "
+		     "firstprivate");
+      stmtblock_t block, cond_block;
+      gfc_start_block (&block);
+      gfc_init_block (&cond_block);
+      tree final = gfc_class_vtab_final_get (decl);
+      tree size = fold_convert (size_type_node, gfc_class_vtab_size_get (decl));
+      gfc_se se;
+      gfc_init_se (&se, NULL);
+      symbol_attribute attr = {};
+      tree data = gfc_class_data_get (decl);
+      tree desc = gfc_conv_scalar_to_descriptor (&se, data, attr);
+
+      /* Call class->_vpt->_finalize + free.  */
+      tree call = build_fold_indirect_ref (final);
+      call = build_call_expr_loc (input_location, call, 3,
+				  gfc_build_addr_expr (NULL, desc),
+				  size, boolean_false_node);
+      gfc_add_block_to_block (&cond_block, &se.pre);
+      gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
+      gfc_add_block_to_block (&cond_block, &se.post);
+      /* Create: if (_vtab && _final) <cond_block>  */
+      tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				   gfc_class_vptr_get (decl),
+				   null_pointer_node);
+      tree cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				   final, null_pointer_node);
+      cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+			      boolean_type_node, cond, cond2);
+      gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
+				 void_type_node, cond,
+				 gfc_finish_block (&cond_block), NULL_TREE));
+      call = builtin_decl_explicit (BUILT_IN_FREE);
+      call = build_call_expr_loc (input_location, call, 1, data);
+      gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
+      return gfc_finish_block (&block);
+    }
 
   if ((! GFC_DESCRIPTOR_TYPE_P (type)
        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
diff --git a/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-1.f90
new file mode 100644
index 00000000000..0ff851db390
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-1.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+! { dg-prune-output "compilation terminated." }
+!
+! FIRSTPRIVATE + class array
+!
+! For now: Expected to give "Sorry" for polymorphic arrays.
+!
+! Polymorphic arrays are tricky - at least if not allocatable, they become:
+!   var.0 = var._data.data
+! which needs to be handled properly.
+!
+!
+program select_type_openmp
+  use iso_c_binding
+  !use omp_lib
+  implicit none
+  integer :: i
+  integer :: A(4)
+  type(c_ptr) :: B(4)
+
+  B = [(c_null_ptr, i=1,4)]
+  A = [1,2,3,4]
+  call sub(A, B)
+contains
+  subroutine sub(val1, val2)
+    class(*) :: val1(4)
+    type(c_ptr) :: val2(2:5)
+
+    !$OMP PARALLEL firstprivate(val2)
+      do i = 2, 5
+        if (c_associated (val2(i))) stop 123
+      end do
+    !$OMP END PARALLEL
+
+    !$OMP PARALLEL firstprivate(val1)  ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" }
+      select type (val1)
+        type is (integer)
+          if (size(val1) /= 4) stop 33
+          if (any (val1 /= [1, 2, 3, 4])) stop 4549
+          val1 = [32,6,48,28]
+        class default
+          stop 99
+      end select
+      select type (val1)
+        type is (integer)
+          if (size(val1) /= 4) stop 33
+          if (any (val1 /= [32,6,48,28])) stop 4512
+        class default
+          stop 99
+      end select
+    !$OMP END PARALLEL
+
+    select type (val1)
+      type is (integer)
+        if (size(val1) /= 4) stop 33
+        if (any (val1 /= [1, 2, 3, 4])) stop 454
+      class default
+        stop 99
+    end select
+    print *, "PASS!"
+  end subroutine
+end program select_type_openmp
diff --git a/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-2.f90
new file mode 100644
index 00000000000..354223741f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-2.f90
@@ -0,0 +1,54 @@
+! { dg-do compile }
+! { dg-prune-output "compilation terminated." }
+!
+! FIRSTPRIVATE + class array
+!
+! For now: Expected to give "Sorry" for polymorphic arrays.
+!
+! Polymorphic arrays are tricky - at least if not allocatable, they become:
+!   var.0 = var._data.data
+! which needs to be handled properly.
+!
+!
+program select_type_openmp
+  !use omp_lib
+  implicit none
+  class(*), allocatable :: B(:)
+
+ allocate(B, source=["abcdef","cdefi2"])
+ allocate(B, source=[1,2,3])
+ call sub(B)
+contains
+  subroutine sub(val2)
+    class(*), allocatable :: val2(:)
+
+    !$OMP PARALLEL firstprivate(val2)  ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" }
+      if (.not.allocated(val2)) stop 3
+      select type (val2)
+        type is (character(len=*))
+          if (len(val2) /= 6) stop 44
+          if (val2(1) /= "abcdef" .or. val2(2) /= "cdefi2") stop 4545
+          val2 = ["123456", "789ABC"]
+        class default
+          stop 991
+      end select
+      select type (val2)
+        type is (character(len=*))
+          if (len(val2) /= 6) stop 44
+          if (val2(1) /= "123456" .or. val2(2) /= "789ABC") stop 453
+        class default
+          stop 991
+      end select
+    !$OMP END PARALLEL
+
+    if (.not.allocated(val2)) stop 3
+    select type (val2)
+      type is (character(len=*))
+        if (len(val2) /= 6) stop 44
+        if (val2(1) /= "abcdef" .or. val2(2) /= "cdefi2") stop 456
+      class default
+        stop 991
+    end select
+    print *, "PASS!"
+  end subroutine
+end program select_type_openmp
diff --git a/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-3.f90 b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-3.f90
new file mode 100644
index 00000000000..c83bf297511
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-3.f90
@@ -0,0 +1,61 @@
+! { dg-do compile }
+! { dg-prune-output "compilation terminated." }
+!
+! FIRSTPRIVATE + class array
+!
+! For now: Expected to give "Sorry" for polymorphic arrays.
+!
+! Polymorphic arrays are tricky - at least if not allocatable, they become:
+!   var.0 = var._data.data
+! which needs to be handled properly.
+!
+!
+program select_type_openmp
+  use iso_c_binding
+  !use omp_lib
+  implicit none
+  call sub
+contains
+  subroutine sub
+    integer :: i
+    class(*), allocatable :: val1(:)
+    type(c_ptr), allocatable :: val2(:)
+ 
+    allocate(val1, source=[1, 2, 3, 4])
+    allocate(val2(2:5))
+    val2 = c_null_ptr
+
+    !$OMP PARALLEL firstprivate(val2)
+      do i = 2, 5
+        if (c_associated (val2(i))) stop 123
+      end do
+    !$OMP END PARALLEL
+
+    !$OMP PARALLEL firstprivate(val1)  ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" }
+      select type (val1)
+        type is (integer)
+          if (size(val1) /= 4) stop 33
+          if (any (val1 /= [1, 2, 3, 4])) stop 4549
+          val1 = [32,6,48,28]
+        class default
+          stop 99
+      end select
+      select type (val1)
+        type is (integer)
+          if (size(val1) /= 4) stop 33
+          if (any (val1 /= [32,6,48,28])) stop 4512
+        class default
+          stop 99
+      end select
+    !$OMP END PARALLEL
+
+    select type (val1)
+      type is (integer)
+        if (size(val1) /= 4) stop 33
+        if (any (val1 /= [1, 2, 3, 4])) stop 454
+      class default
+        stop 99
+    end select
+    print *, "PASS!"
+  end subroutine
+end program select_type_openmp
diff --git a/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-4.f90
new file mode 100644
index 00000000000..237c6c535f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-4.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-prune-output "compilation terminated." }
+!
+! FIRSTPRIVATE + class array
+!
+! For now: Expected to give "Sorry" for polymorphic arrays.
+!
+! Polymorphic arrays are tricky - at least if not allocatable, they become:
+!   var.0 = var._data.data
+! which needs to be handled properly.
+!
+!
+program select_type_openmp
+  use iso_c_binding
+  !use omp_lib
+  implicit none
+  integer x(4)
+  x = [1, 2, 3, 4]
+  call sub(x)
+  if (any (x /= [1,2,3,4])) stop 3
+contains
+  subroutine sub(val1)
+    integer :: i
+    class(*) :: val1(4)
+ 
+    !$OMP PARALLEL firstprivate(val1)  ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" }
+      select type (val1)
+        type is (integer)
+          if (size(val1) /= 4) stop 33
+          if (any (val1 /= [1, 2, 3, 4])) stop 4549
+          val1 = [32,6,48,28]
+        class default
+          stop 99
+      end select
+      select type (val1)
+        type is (integer)
+          if (size(val1) /= 4) stop 34
+          if (any (val1 /= [32,6,48,28])) stop 4512
+        class default
+          stop 98
+      end select
+    !$OMP END PARALLEL
+  end
+end
diff --git a/libgomp/testsuite/libgomp.fortran/class-firstprivate-1.f90 b/libgomp/testsuite/libgomp.fortran/class-firstprivate-1.f90
new file mode 100644
index 00000000000..b77117ec611
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/class-firstprivate-1.f90
@@ -0,0 +1,323 @@
+! FIRSTPRIVATE: CLASS(*) + intrinsic types
+program select_type_openmp
+  implicit none
+  class(*), allocatable :: val1, val1a, val2, val3
+
+  call sub() ! local var
+
+  call sub2(val1, val1a, val2, val3) ! allocatable args
+
+  allocate(val1, source=7)
+  allocate(val1a, source=7)
+  allocate(val2, source="abcdef")
+  allocate(val3, source=4_"zyx4")
+  call sub3(val1, val1a, val2, val3)  ! nonallocatable vars
+  deallocate(val1, val1a, val2, val3)
+contains
+subroutine sub()
+  class(*), allocatable :: val1, val1a, val2, val3
+  allocate(val1a, source=7)
+  allocate(val2, source="abcdef")
+  allocate(val3, source=4_"zyx4")
+
+  if (allocated(val1)) stop 1
+
+  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
+    if (allocated(val1)) stop 2
+    if (.not.allocated(val1a)) stop 3
+    if (.not.allocated(val2)) stop 4
+    if (.not.allocated(val3)) stop 5
+
+    allocate(val1, source=7)
+
+    select type (val1)
+      type is (integer)
+        if (val1 /= 7) stop 6
+        val1 = 8
+      class default
+        stop 7
+    end select
+
+    select type (val1a)
+      type is (integer)
+        if (val1a /= 7) stop 8
+        val1a = 8
+      class default
+        stop 9
+    end select
+
+    select type (val2)
+      type is (character(len=*))
+        if (len(val2) /= 6) stop 10
+        if (val2 /= "abcdef") stop 11
+        val2 = "123456"
+      class default
+        stop 12
+    end select
+
+    select type (val3)
+      type is (character(len=*, kind=4))
+        if (len(val3) /= 4) stop 13
+        if (val3 /= 4_"zyx4") stop 14
+        val3 = 4_"AbCd"
+      class default
+        stop 15
+    end select
+
+    select type (val3)
+      type is (character(len=*, kind=4))
+        if (len(val3) /= 4) stop 16
+        if (val3 /= 4_"AbCd") stop 17
+        val3 = 4_"1ab2"
+      class default
+        stop 18
+    end select
+
+    select type (val2)
+      type is (character(len=*))
+        if (len(val2) /= 6) stop 19
+        if (val2 /= "123456") stop 20
+        val2 = "A2C4E6"
+      class default
+        stop 21
+    end select
+
+    select type (val1)
+      type is (integer)
+        if (val1 /= 8) stop 22
+        val1 = 9
+      class default
+        stop 23
+    end select
+
+    select type (val1a)
+      type is (integer)
+        if (val1a /= 8) stop 24
+        val1a = 9
+      class default
+        stop 25
+    end select
+  !$OMP END PARALLEL
+
+  if (allocated(val1)) stop 26
+  if (.not. allocated(val1a)) stop 27
+  if (.not. allocated(val2)) stop 28
+
+  select type (val2)
+    type is (character(len=*))
+      if (len(val2) /= 6) stop 29
+      if (val2 /= "abcdef") stop 30
+    class default
+      stop 31
+  end select
+  select type (val3)
+    type is (character(len=*,kind=4))
+      if (len(val3) /= 4) stop 32
+      if (val3 /= 4_"zyx4") stop 33
+    class default
+      stop 34
+  end select
+  deallocate(val1a, val2, val3)
+end subroutine sub
+
+subroutine sub2(val1, val1a, val2, val3)
+  class(*), allocatable :: val1, val1a, val2, val3
+  optional :: val1a
+  allocate(val1a, source=7)
+  allocate(val2, source="abcdef")
+  allocate(val3, source=4_"zyx4")
+ 
+  if (allocated(val1)) stop 35
+
+  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
+    if (allocated(val1)) stop 36
+    if (.not.allocated(val1a)) stop 37
+    if (.not.allocated(val2)) stop 38
+    if (.not.allocated(val3)) stop 39
+
+    allocate(val1, source=7)
+
+    select type (val1)
+      type is (integer)
+        if (val1 /= 7) stop 40
+        val1 = 8
+      class default
+        stop 41
+    end select
+
+    select type (val1a)
+      type is (integer)
+        if (val1a /= 7) stop 42
+        val1a = 8
+      class default
+        stop 43
+    end select
+
+    select type (val2)
+      type is (character(len=*))
+        if (len(val2) /= 6) stop 44
+        if (val2 /= "abcdef") stop 45
+        val2 = "123456"
+      class default
+        stop 46
+    end select
+
+    select type (val3)
+      type is (character(len=*, kind=4))
+        if (len(val3) /= 4) stop 47
+        if (val3 /= 4_"zyx4") stop 48
+        val3 = "AbCd"
+      class default
+        stop 49
+    end select
+
+    select type (val3)
+      type is (character(len=*, kind=4))
+        if (len(val3) /= 4) stop 50
+        if (val3 /= 4_"AbCd") stop 51
+        val3 = 4_"1ab2"
+      class default
+        stop 52
+    end select
+
+    select type (val2)
+      type is (character(len=*))
+        if (len(val2) /= 6) stop 53
+        if (val2 /= "123456") stop 54
+        val2 = "A2C4E6"
+      class default
+        stop 55
+    end select
+
+    select type (val1)
+      type is (integer)
+        if (val1 /= 8) stop 56
+        val1 = 9
+      class default
+        stop 57
+    end select
+
+    select type (val1a)
+      type is (integer)
+        if (val1a /= 8) stop 58
+        val1a = 9
+      class default
+        stop 59
+    end select
+  !$OMP END PARALLEL
+
+  if (allocated(val1)) stop 60
+  if (.not. allocated(val1a)) stop 61
+  if (.not. allocated(val2)) stop 62
+
+  select type (val2)
+    type is (character(len=*))
+      if (len(val2) /= 6) stop 63
+      if (val2 /= "abcdef") stop 64
+    class default
+        stop 65
+  end select
+
+  select type (val3)
+    type is (character(len=*, kind=4))
+      if (len(val3) /= 4) stop 66
+      if (val3 /= 4_"zyx4") stop 67
+      val3 = 4_"AbCd"
+    class default
+      stop 68
+  end select
+  deallocate(val1a, val2, val3)
+end subroutine sub2
+
+subroutine sub3(val1, val1a, val2, val3)
+  class(*) :: val1, val1a, val2, val3
+  optional :: val1a
+
+  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
+    select type (val1)
+      type is (integer)
+        if (val1 /= 7) stop 69
+        val1 = 8
+      class default
+        stop 70
+    end select
+
+    select type (val1a)
+      type is (integer)
+        if (val1a /= 7) stop 71
+        val1a = 8
+      class default
+        stop 72
+    end select
+
+    select type (val2)
+      type is (character(len=*))
+        if (len(val2) /= 6) stop 73
+        if (val2 /= "abcdef") stop 74
+        val2 = "123456"
+      class default
+        stop 75
+    end select
+
+    select type (val3)
+      type is (character(len=*, kind=4))
+        if (len(val3) /= 4) stop 76
+        if (val3 /= 4_"zyx4") stop 77
+        val3 = 4_"AbCd"
+      class default
+        stop 78
+    end select
+
+    select type (val3)
+      type is (character(len=*, kind=4))
+        if (len(val3) /= 4) stop 79
+        if (val3 /= 4_"AbCd") stop 80
+        val3 = 4_"1ab2"
+      class default
+        stop 81
+    end select
+
+    select type (val2)
+      type is (character(len=*))
+        if (len(val2) /= 6) stop 82
+        if (val2 /= "123456") stop 83
+        val2 = "A2C4E6"
+      class default
+        stop 84
+    end select
+
+    select type (val1)
+      type is (integer)
+        if (val1 /= 8) stop 85
+        val1 = 9
+      class default
+        stop 86
+    end select
+
+    select type (val1a)
+      type is (integer)
+        if (val1a /= 8) stop 87
+        val1a = 9
+      class default
+        stop 88
+    end select
+  !$OMP END PARALLEL
+
+  select type (val2)
+    type is (character(len=*))
+      if (len(val2) /= 6) stop 89
+      if (val2 /= "abcdef") stop 90
+    class default
+      stop 91
+  end select
+
+  select type (val3)
+    type is (character(len=*, kind=4))
+      if (len(val3) /= 4) stop 92
+      if (val3 /= 4_"zyx4") stop 93
+      val3 = 4_"AbCd"
+    class default
+      stop 94
+  end select
+end subroutine sub3
+end program select_type_openmp
diff --git a/libgomp/testsuite/libgomp.fortran/class-firstprivate-2.f90 b/libgomp/testsuite/libgomp.fortran/class-firstprivate-2.f90
new file mode 100644
index 00000000000..7528d32e8db
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/class-firstprivate-2.f90
@@ -0,0 +1,334 @@
+! FIRSTPRIVATE: CLASS(t) + derived types
+program select_type_openmp
+  implicit none
+  type t
+  end type t
+  type, extends(t) :: t_int
+    integer :: i
+  end type 
+  type, extends(t) :: t_char1
+    character(len=:, kind=1), allocatable :: str
+  end type 
+  type, extends(t) :: t_char4
+    character(len=:, kind=4), allocatable :: str
+  end type 
+  class(t), allocatable :: val1, val1a, val2, val3
+
+  call sub() ! local var
+
+  call sub2(val1, val1a, val2, val3) ! allocatable args
+
+  allocate(val1, source=t_int(7))
+  allocate(val1a, source=t_int(7))
+  allocate(val2, source=t_char1("abcdef"))
+  allocate(val3, source=t_char4(4_"zyx4"))
+  call sub3(val1, val1a, val2, val3)  ! nonallocatable vars
+  deallocate(val1, val1a, val2, val3)
+contains
+subroutine sub()
+  class(t), allocatable :: val1, val1a, val2, val3
+  allocate(val1a, source=t_int(7))
+  allocate(val2, source=t_char1("abcdef"))
+  allocate(val3, source=t_char4(4_"zyx4"))
+
+  if (allocated(val1)) stop 1
+
+  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
+    if (allocated(val1)) stop 2
+    if (.not.allocated(val1a)) stop 3
+    if (.not.allocated(val2)) stop 4
+    if (.not.allocated(val3)) stop 5
+
+    allocate(val1, source=t_int(7))
+
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 7) stop 6
+        val1%i = 8
+      class default
+        stop 7
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 7) stop 8
+        val1a%i = 8
+      class default
+        stop 9
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 10
+        if (val2%str /= "abcdef") stop 11
+        val2%str = "123456"
+      class default
+        stop 12
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 13
+        if (val3%str /= 4_"zyx4") stop 14
+        val3%str = 4_"AbCd"
+      class default
+        stop 15
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 16
+        if (val3%str /= 4_"AbCd") stop 17
+        val3%str = 4_"1ab2"
+      class default
+        stop 18
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 19
+        if (val2%str /= "123456") stop 20
+        val2%str = "A2C4E6"
+      class default
+        stop 21
+    end select
+
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 8) stop 22
+        val1%i = 9
+      class default
+        stop 23
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 8) stop 24
+        val1a%i = 9
+      class default
+        stop 25
+    end select
+  !$OMP END PARALLEL
+
+  if (allocated(val1)) stop 26
+  if (.not. allocated(val1a)) stop 27
+  if (.not. allocated(val2)) stop 28
+
+  select type (val2)
+    type is (t_char1)
+      if (len(val2%str) /= 6) stop 29
+      if (val2%str /= "abcdef") stop 30
+    class default
+      stop 31
+  end select
+  select type (val3)
+    type is (t_char4)
+      if (len(val3%str) /= 4) stop 32
+      if (val3%str /= 4_"zyx4") stop 33
+    class default
+      stop 34
+  end select
+  deallocate(val1a,val2, val3)
+end subroutine sub
+
+subroutine sub2(val1, val1a, val2, val3)
+  class(t), allocatable :: val1, val1a, val2, val3
+  optional :: val1a
+  allocate(val1a, source=t_int(7))
+  allocate(val2, source=t_char1("abcdef"))
+  allocate(val3, source=t_char4(4_"zyx4"))
+ 
+  if (allocated(val1)) stop 35
+
+  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
+    if (allocated(val1)) stop 36
+    if (.not.allocated(val1a)) stop 37
+    if (.not.allocated(val2)) stop 38
+    if (.not.allocated(val3)) stop 39
+
+    allocate(val1, source=t_int(7))
+
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 7) stop 40
+        val1%i = 8
+      class default
+        stop 41
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 7) stop 42
+        val1a%i = 8
+      class default
+        stop 43
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 44
+        if (val2%str /= "abcdef") stop 45
+        val2%str = "123456"
+      class default
+        stop 46
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 47
+        if (val3%str /= 4_"zyx4") stop 48
+        val3%str = "AbCd"
+      class default
+        stop 49
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 50
+        if (val3%str /= 4_"AbCd") stop 51
+        val3%str = 4_"1ab2"
+      class default
+        stop 52
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 53
+        if (val2%str /= "123456") stop 54
+        val2%str = "A2C4E6"
+      class default
+        stop 55
+    end select
+
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 8) stop 56
+        val1%i = 9
+      class default
+        stop 57
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 8) stop 58
+        val1a%i = 9
+      class default
+        stop 59
+    end select
+  !$OMP END PARALLEL
+
+  if (allocated(val1)) stop 60
+  if (.not. allocated(val1a)) stop 61
+  if (.not. allocated(val2)) stop 62
+
+  select type (val2)
+    type is (t_char1)
+      if (len(val2%str) /= 6) stop 63
+      if (val2%str /= "abcdef") stop 64
+    class default
+        stop 65
+  end select
+
+  select type (val3)
+    type is (t_char4)
+      if (len(val3%str) /= 4) stop 66
+      if (val3%str /= 4_"zyx4") stop 67
+      val3%str = 4_"AbCd"
+    class default
+      stop 68
+  end select
+  deallocate(val1a, val2, val3)
+end subroutine sub2
+
+subroutine sub3(val1, val1a, val2, val3)
+  class(t) :: val1, val1a, val2, val3
+  optional :: val1a
+
+  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 7) stop 69
+        val1%i = 8
+      class default
+        stop 70
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 7) stop 71
+        val1a%i = 8
+      class default
+        stop 72
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 73
+        if (val2%str /= "abcdef") stop 74
+        val2%str = "123456"
+      class default
+        stop 75
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 76
+        if (val3%str /= 4_"zyx4") stop 77
+        val3%str = 4_"AbCd"
+      class default
+        stop 78
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 79
+        if (val3%str /= 4_"AbCd") stop 80
+        val3%str = 4_"1ab2"
+      class default
+        stop 81
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 82
+        if (val2%str /= "123456") stop 83
+        val2%str = "A2C4E6"
+      class default
+        stop 84
+    end select
+
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 8) stop 85
+        val1%i = 9
+      class default
+        stop 86
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 8) stop 87
+        val1a%i = 9
+      class default
+        stop 88
+    end select
+  !$OMP END PARALLEL
+
+  select type (val2)
+    type is (t_char1)
+      if (len(val2%str) /= 6) stop 89
+      if (val2%str /= "abcdef") stop 90
+    class default
+      stop 91
+  end select
+
+  select type (val3)
+    type is (t_char4)
+      if (len(val3%str) /= 4) stop 92
+      if (val3%str /= 4_"zyx4") stop 93
+      val3%str = 4_"AbCd"
+    class default
+      stop 94
+  end select
+end subroutine sub3
+end program select_type_openmp
diff --git a/libgomp/testsuite/libgomp.fortran/class-firstprivate-3.f90 b/libgomp/testsuite/libgomp.fortran/class-firstprivate-3.f90
new file mode 100644
index 00000000000..a450fdee1ac
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/class-firstprivate-3.f90
@@ -0,0 +1,334 @@
+! FIRSTPRIVATE: CLASS(*) + derived types
+program select_type_openmp
+  implicit none
+  type t
+  end type t
+  type, extends(t) :: t_int
+    integer :: i
+  end type 
+  type, extends(t) :: t_char1
+    character(len=:, kind=1), allocatable :: str
+  end type 
+  type, extends(t) :: t_char4
+    character(len=:, kind=4), allocatable :: str
+  end type 
+  class(*), allocatable :: val1, val1a, val2, val3
+
+  call sub() ! local var
+
+  call sub2(val1, val1a, val2, val3) ! allocatable args
+
+  allocate(val1, source=t_int(7))
+  allocate(val1a, source=t_int(7))
+  allocate(val2, source=t_char1("abcdef"))
+  allocate(val3, source=t_char4(4_"zyx4"))
+  call sub3(val1, val1a, val2, val3)  ! nonallocatable vars
+  deallocate(val1, val1a, val2, val3)
+contains
+subroutine sub()
+  class(*), allocatable :: val1, val1a, val2, val3
+  allocate(val1a, source=t_int(7))
+  allocate(val2, source=t_char1("abcdef"))
+  allocate(val3, source=t_char4(4_"zyx4"))
+
+  if (allocated(val1)) stop 1
+
+  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
+    if (allocated(val1)) stop 2
+    if (.not.allocated(val1a)) stop 3
+    if (.not.allocated(val2)) stop 4
+    if (.not.allocated(val3)) stop 5
+
+    allocate(val1, source=t_int(7))
+
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 7) stop 6
+        val1%i = 8
+      class default
+        stop 7
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 7) stop 8
+        val1a%i = 8
+      class default
+        stop 9
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 10
+        if (val2%str /= "abcdef") stop 11
+        val2%str = "123456"
+      class default
+        stop 12
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 13
+        if (val3%str /= 4_"zyx4") stop 14
+        val3%str = 4_"AbCd"
+      class default
+        stop 15
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 16
+        if (val3%str /= 4_"AbCd") stop 17
+        val3%str = 4_"1ab2"
+      class default
+        stop 18
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 19
+        if (val2%str /= "123456") stop 20
+        val2%str = "A2C4E6"
+      class default
+        stop 21
+    end select
+
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 8) stop 22
+        val1%i = 9
+      class default
+        stop 23
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 8) stop 24
+        val1a%i = 9
+      class default
+        stop 25
+    end select
+  !$OMP END PARALLEL
+
+  if (allocated(val1)) stop 26
+  if (.not. allocated(val1a)) stop 27
+  if (.not. allocated(val2)) stop 28
+
+  select type (val2)
+    type is (t_char1)
+      if (len(val2%str) /= 6) stop 29
+      if (val2%str /= "abcdef") stop 30
+    class default
+      stop 31
+  end select
+  select type (val3)
+    type is (t_char4)
+      if (len(val3%str) /= 4) stop 32
+      if (val3%str /= 4_"zyx4") stop 33
+    class default
+      stop 34
+  end select
+  deallocate(val1a,val2, val3)
+end subroutine sub
+
+subroutine sub2(val1, val1a, val2, val3)
+  class(*), allocatable :: val1, val1a, val2, val3
+  optional :: val1a
+  allocate(val1a, source=t_int(7))
+  allocate(val2, source=t_char1("abcdef"))
+  allocate(val3, source=t_char4(4_"zyx4"))
+ 
+  if (allocated(val1)) stop 35
+
+  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
+    if (allocated(val1)) stop 36
+    if (.not.allocated(val1a)) stop 37
+    if (.not.allocated(val2)) stop 38
+    if (.not.allocated(val3)) stop 39
+
+    allocate(val1, source=t_int(7))
+
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 7) stop 40
+        val1%i = 8
+      class default
+        stop 41
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 7) stop 42
+        val1a%i = 8
+      class default
+        stop 43
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 44
+        if (val2%str /= "abcdef") stop 45
+        val2%str = "123456"
+      class default
+        stop 46
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 47
+        if (val3%str /= 4_"zyx4") stop 48
+        val3%str = "AbCd"
+      class default
+        stop 49
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 50
+        if (val3%str /= 4_"AbCd") stop 51
+        val3%str = 4_"1ab2"
+      class default
+        stop 52
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 53
+        if (val2%str /= "123456") stop 54
+        val2%str = "A2C4E6"
+      class default
+        stop 55
+    end select
+
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 8) stop 56
+        val1%i = 9
+      class default
+        stop 57
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 8) stop 58
+        val1a%i = 9
+      class default
+        stop 59
+    end select
+  !$OMP END PARALLEL
+
+  if (allocated(val1)) stop 60
+  if (.not. allocated(val1a)) stop 61
+  if (.not. allocated(val2)) stop 62
+
+  select type (val2)
+    type is (t_char1)
+      if (len(val2%str) /= 6) stop 63
+      if (val2%str /= "abcdef") stop 64
+    class default
+        stop 65
+  end select
+
+  select type (val3)
+    type is (t_char4)
+      if (len(val3%str) /= 4) stop 66
+      if (val3%str /= 4_"zyx4") stop 67
+      val3%str = 4_"AbCd"
+    class default
+      stop 68
+  end select
+  deallocate(val1a, val2, val3)
+end subroutine sub2
+
+subroutine sub3(val1, val1a, val2, val3)
+  class(*) :: val1, val1a, val2, val3
+  optional :: val1a
+
+  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 7) stop 69
+        val1%i = 8
+      class default
+        stop 70
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 7) stop 71
+        val1a%i = 8
+      class default
+        stop 72
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 73
+        if (val2%str /= "abcdef") stop 74
+        val2%str = "123456"
+      class default
+        stop 75
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 76
+        if (val3%str /= 4_"zyx4") stop 77
+        val3%str = 4_"AbCd"
+      class default
+        stop 78
+    end select
+
+    select type (val3)
+      type is (t_char4)
+        if (len(val3%str) /= 4) stop 79
+        if (val3%str /= 4_"AbCd") stop 80
+        val3%str = 4_"1ab2"
+      class default
+        stop 81
+    end select
+
+    select type (val2)
+      type is (t_char1)
+        if (len(val2%str) /= 6) stop 82
+        if (val2%str /= "123456") stop 83
+        val2%str = "A2C4E6"
+      class default
+        stop 84
+    end select
+
+    select type (val1)
+      type is (t_int)
+        if (val1%i /= 8) stop 85
+        val1%i = 9
+      class default
+        stop 86
+    end select
+
+    select type (val1a)
+      type is (t_int)
+        if (val1a%i /= 8) stop 87
+        val1a%i = 9
+      class default
+        stop 88
+    end select
+  !$OMP END PARALLEL
+
+  select type (val2)
+    type is (t_char1)
+      if (len(val2%str) /= 6) stop 89
+      if (val2%str /= "abcdef") stop 90
+    class default
+      stop 91
+  end select
+
+  select type (val3)
+    type is (t_char4)
+      if (len(val3%str) /= 4) stop 92
+      if (val3%str /= 4_"zyx4") stop 93
+      val3%str = 4_"AbCd"
+    class default
+      stop 94
+  end select
+end subroutine sub3
+end program select_type_openmp


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2021-05-24 14:59 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-05-24 14:59 [gcc r12-1016] OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE [PR86470] Tobias Burnus

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).