Re: [Patch] OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE [PR86470]
On Wed, Mar 10, 2021 at 11:55:43AM +0100, Tobias Burnus wrote:
> --- 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 (0 == strcmp ("_len", IDENTIFIER_POINTER (DECL_NAME (field;
strcmp (...) == 0 instead please.
> + 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)));
Indentation, decl_type is indented by 4 spaces, but this line by tab (== 8 sp).
Otherwise LGTM, sorry for the delay.
Jakub
Re: [Patch] OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE [PR86470]
*PING* (OpenMP patches: I note that the reduction + firstprivate→tofrom patch is still being reviewed and that there are bunch of recently posted patches by ChungLin + Julian which are also pending review.) (There is also one patch (affinity + iterator) I still have to repost – and will happen soon.) Tobias On 10.03.21 11:55, Tobias Burnus wrote: Belated follow-up to the patch from August ... https://gcc.gnu.org/pipermail/gcc-patches/2020-August/552588.html This patch handles CLASS variables in the FIRSTPRIVATE data-sharing clause, including freeing the memory at the end. Technically this patch fixes a regression as the ICE is new – before the code was just rejected. It is also rather contained. OK for mainline? Tobias PS: The dtor can be extended rather simply to support arrays, for the copy_ctor, some scalarization loop is needed. Todo: 'private', which has to allocate the dynamic type and copy the default initialization for this the dynamic type. - Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
[Patch] OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE [PR86470]
Belated follow-up to the patch from August ...
https://gcc.gnu.org/pipermail/gcc-patches/2020-August/552588.html
This patch handles CLASS variables in the FIRSTPRIVATE data-sharing
clause, including freeing the memory at the end.
Technically this patch fixes a regression as the ICE is new –
before the code was just rejected. It is also rather contained.
OK for mainline?
Tobias
PS: The dtor can be extended rather simply to support arrays, for
the copy_ctor, some scalarization loop is needed.
Todo: 'private', which has to allocate the
dynamic type and copy the default initialization
for this the dynamic type.
-
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank
Thürauf
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.
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 85c16d7f4c3..5389b9a4a37 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1524,7 +1524,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 349df1cc346..7c25241a863 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 (0 == strcmp ("_len", IDENTIFIER_POINTER (DECL_NAME (field;
+ 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));
+
Re: [Patch] OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE (PR86470)
On Tue, Aug 25, 2020 at 12:50:46PM +0200, Tobias Burnus wrote:
> OK for mainline?
Generally, you know Fortran FE much more than I do, so just a few random
comments.
> --- a/gcc/fortran/trans-openmp.c
> +++ b/gcc/fortran/trans-openmp.c
> @@ -355,6 +355,51 @@ 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);
> + if (TREE_CODE (type) != RECORD_TYPE)
> +return false;
> +
> + tree field = TYPE_FIELDS (type);
> + if (!field || 0 != strcmp ("_data", IDENTIFIER_POINTER (DECL_NAME
> (field
> +return false;
> + field = DECL_CHAIN (field);
> + if (!field || 0 != strcmp ("_vptr", IDENTIFIER_POINTER (DECL_NAME
> (field
Is it safe to just look at the field names? Shouldn't it at least also
test that the fields are DECL_ARTIFICIAL, or somehow else ensure that it
isn't a user derived type with _data and _vptr fields in it.
type foo
integer :: _data
integer :: _vptr
integer :: _len
end type
type(foo) :: a
a%_data = 1
a%_vptr = 2
a%_len = 3
end
compiles just fine with -fallow-leading-underscore ...
> @@ -740,6 +785,87 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree
> src)
>gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
> || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
>
> + /* TODO: implement support for polymorphic arrays; reject for now. */
> + /* Void arrays appear as var.0 = var._data.data. A bit hackish to
> + distinguish from 'type(c_ptr) :: var(5)' by scanning for '.';
> + this assumes that ASM_FORMAT_PRIVATE_NAME uses a '.', which most
> + systems do. */
> + if (TREE_CODE (type) == ARRAY_TYPE
> + && TREE_TYPE (type) == pvoid_type_node
> + && TREE_CODE (dest) == MEM_REF
> + && strchr (IDENTIFIER_POINTER (DECL_NAME (TREE_OPERAND (dest, 0))),
> '.'))
This seems very fragile, there are targets that use $ instead, other targets
use only underscores.
$ grep NO_DOT_IN_LABEL config/* config/*/* 2>/dev/null
config/vx-common.h:# define NO_DOT_IN_LABEL
config/mmix/mmix.h:#define NO_DOT_IN_LABEL
config/nvptx/nvptx.h:#define NO_DOT_IN_LABEL
config/xtensa/elf.h:#define NO_DOT_IN_LABEL
$ grep -w NO_DOLLAR_IN_LABEL config/* config/*/* 2>/dev/null
config/dragonfly.h:#undef NO_DOLLAR_IN_LABEL
config/elfos.h:#define NO_DOLLAR_IN_LABEL
config/freebsd.h:#undef NO_DOLLAR_IN_LABEL
config/vx-common.h:# undef NO_DOLLAR_IN_LABEL
config/alpha/alpha.h:#undef NO_DOLLAR_IN_LABEL
config/arm/aout.h:#ifndef NO_DOLLAR_IN_LABEL
config/arm/aout.h:#define NO_DOLLAR_IN_LABEL 1
config/mips/n32-elf.h:#define NO_DOLLAR_IN_LABEL
config/mmix/mmix.h:#define NO_DOLLAR_IN_LABEL
config/rs6000/rs6000.c:#ifdef NO_DOLLAR_IN_LABEL
config/rs6000/rs6000-protos.h:#ifdef NO_DOLLAR_IN_LABEL
config/rs6000/xcoff.h:#define NO_DOLLAR_IN_LABEL
config/tilegx/tilegx.h:#undef NO_DOLLAR_IN_LABEL
config/tilepro/tilepro.h:#undef NO_DOLLAR_IN_LABEL
config/xtensa/elf.h:#undef NO_DOLLAR_IN_LABEL
Couldn't it be recorded somewhere in DECL_LANG_SPECIFIC of the decl?
> +fatal_error (input_location,
> + "Sorry, polymorphic arrays not yet supported for "
> + "firstprivate");
Shouldn't this be sorry ("...") instead?
> + /* var._data - _data is void* for scalars and descriptor for arrays.
> */
> + if (TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == RECORD_TYPE)
> + fatal_error (input_location,
> + "Sorry, polymorphic arrays not yet supported for "
> + "firstprivate");
Likewise.
> + /* Malloc memory + call class->_vpt->_copy. */
> + call = builtin_decl_explicit (BUILT_IN_MALLOC);
Is malloc what the FE uses elsewhere for it? Will something free it
afterwards?
> + if (!GFC_DECL_GET_SCALAR_ALLOCATABLE (TREE_OPERAND (dest_data, 1)))
> + {
> + gfc_add_block_to_block (, _block);
> + }
Formatting, one stmt shouldn't be wrapped into {}s.
Jakub
Re: [Patch] OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE (PR86470)
Hi Andre,
On 8/31/20 12:55 PM, Andre Vehreschild wrote:
+gfc_is_unlimited_polymorphic_nonptr (tree type)
+ tree field = TYPE_FIELDS (type); /* _data */
+ if (!field)
^^^ here you don't . So theoretically this routine could match a type which
has a _len as its third field, but that is not a unlim-poly class. Maybe factor
out the test from the above routine and unify with this one to reuse the test
for a BT_CLASS?!
Granted. The reason was the code use:
if (polymophic)
{
...
if (unlimited_polymorphic)
Hence, I assumed that that check was already done, reducing
code size (but having less universality) and increasing
(cold-code) performance.
My new idea is to unify the two functions and add an
"bool only_unlimited" flag.
Btw, I believe the first routine can be better replaced by:
static bool
gfc_is_polymorphic_nonptr (tree type)
{
if (POINTER_TYPE_P (type))
type = TREE_TYPE (type);
return GFC_CLASS_TYPE_P (type);
}
Maybe. However, when looking into the check for polymorphic
arrays, the DECL_LANG_SPECIFIC (and I think TYPE_LANG_SPECIFIC)
were present but contained only garbage. Thus, it might not work.
(I have to check.) – If it works, I will use your nicer suggestion.
If it doesn't work, I would go for my proposal above.
(Eventually, in a follow-up patch for polymorphic arrays, it has
to be fixed properly to avoid the following hack.)
+ /* TODO: implement support for polymorphic arrays; reject for now. */
+ /* Void arrays appear as var.0 = var._data.data. A bit hackish to
+ distinguish from 'type(c_ptr) :: var(5)' by scanning for '.';
+ this assumes that ASM_FORMAT_PRIVATE_NAME uses a '.', which most
+ systems do. */
...
I totally agree that this is hackish and I don't like for that. But I can't
come up with a better solution at the moment.
I think some changes at multiple places are needed to implement this
properly – but for the 'sorry' I did not want to do non-local changes;
for the real version, it should use some nicer code!
Thanks for the suggestions and review.
Tobias
PS: I want to first finish working on some other tasks before coming back
to this patch.
Re: [Patch] OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE (PR86470)
Hi Tobias,
in (look for ^^^):
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 063d4c145e2..705cdc7749f 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -355,6 +355,51 @@ 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);
+ if (TREE_CODE (type) != RECORD_TYPE)
+return false;
+
+ tree field = TYPE_FIELDS (type);
+ if (!field || 0 != strcmp ("_data", IDENTIFIER_POINTER (DECL_NAME (field
^^^ here you are comparing the field - name
+return false;
+ field = DECL_CHAIN (field);
+ if (!field || 0 != strcmp ("_vptr", IDENTIFIER_POINTER (DECL_NAME (field
+return false;
+
+ return true;
+}
+
+/* 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 (TREE_CODE (type) != RECORD_TYPE)
+return false;
+
+ tree field = TYPE_FIELDS (type); /* _data */
+ if (!field)
^^^ here you don't . So theoretically this routine could match a type which
has a _len as its third field, but that is not a unlim-poly class. Maybe factor
out the test from the above routine and unify with this one to reuse the test
for a BT_CLASS?!
+return false;
+ field = DECL_CHAIN (field); /* _vptr */
+ if (!field)
+return false;
+ field = DECL_CHAIN (field);
+ if (!field || 0 != strcmp ("_len", IDENTIFIER_POINTER (DECL_NAME (field
+return false;
+
+ return true;
+}
+
+
---
Btw, I believe the first routine can be better replaced by:
static bool
gfc_is_polymorphic_nonptr (tree type)
{
if (POINTER_TYPE_P (type))
type = TREE_TYPE (type);
return GFC_CLASS_TYPE_P (type);
}
I have no better solution for learning whether a tree's type is unlimited poly
yet.
@@ -740,6 +785,87 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
|| OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
+ /* TODO: implement support for polymorphic arrays; reject for now. */
+ /* Void arrays appear as var.0 = var._data.data. A bit hackish to
+ distinguish from 'type(c_ptr) :: var(5)' by scanning for '.';
+ this assumes that ASM_FORMAT_PRIVATE_NAME uses a '.', which most
+ systems do. */
+ if (TREE_CODE (type) == ARRAY_TYPE
+ && TREE_TYPE (type) == pvoid_type_node
+ && TREE_CODE (dest) == MEM_REF
+ && strchr (IDENTIFIER_POINTER (DECL_NAME (TREE_OPERAND (dest, 0))), '.'))
+fatal_error (input_location,
+"Sorry, polymorphic arrays not yet supported for "
+"firstprivate");
I totally agree that this is hackish and I don't like for that. But I can't
come up with a better solution at the moment.
The remainder looks ok to me.
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
Re: [Patch] OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE (PR86470)
*PING* — For this part 1/n patch series.
On 8/25/20 12:50 PM, Tobias Burnus wrote:
This patch adds support for polymorphic variables ("CLASS")
to OpenMP's data-sharing clause FIRSTPRIVATE.
While the patch should be okay, there is more follow-up
work required, but one has to make a start :-)
* PRIVATE – as used in the testcase of the PR is not yet supported,
only FIRSTPRIVATE.
* polymorphic arrays are not supported (see 'sorry').
– For nonallocatable arrays, the decl passed to the function
does contain much information; the LANG_SPECIFIC is non-NULL
its the pointer components contain garbage :-(
– Handling noncharacter polymorphic arrays (hence: non-unlimited
polymorphic) seems to be simpler; the current patch seems to
work for some cases already, if the "sorry" is commented.
* ...
OK for mainline?
Tobias
PS: Supporting *map*ing of polymorphic variables is another matter,
which is unfortunately even harder.
-
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander
Walter
[Patch] OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE (PR86470)
This patch adds support for polymorphic variables ("CLASS")
to OpenMP's data-sharing clause FIRSTPRIVATE.
While the patch should be okay, there is more follow-up
work required, but one has to make a start :-)
* PRIVATE – as used in the testcase of the PR is not yet supported,
only FIRSTPRIVATE.
* polymorphic arrays are not supported (see 'sorry').
– For nonallocatable arrays, the decl passed to the function
does contain much information; the LANG_SPECIFIC is non-NULL
its the pointer components contain garbage :-(
– Handling noncharacter polymorphic arrays (hence: non-unlimited
polymorphic) seems to be simpler; the current patch seems to
work for some cases already, if the "sorry" is commented.
* ...
OK for mainline?
Tobias
PS: Supporting *map*ing of polymorphic variables is another matter,
which is unfortunately even harder.
-
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander
Walter
[Patch] 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): Handle polymorphic variables.
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.
gcc/fortran/trans-expr.c | 2 +-
gcc/fortran/trans-openmp.c | 126 +
gcc/testsuite/gfortran.dg/gomp/class-firstprivate-1.f90| 62 ++
gcc/testsuite/gfortran.dg/gomp/class-firstprivate-2.f90| 54 ++
gcc/testsuite/gfortran.dg/gomp/class-firstprivate-3.f90| 61 ++
libgomp/testsuite/libgomp.fortran/class-firstprivate-1.f90 | 323 +++
libgomp/testsuite/libgomp.fortran/class-firstprivate-2.f90 | 334 +
libgomp/testsuite/libgomp.fortran/class-firstprivate-3.f90 | 334 +
8 files changed, 1295 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 36ff9b5cbc6..b0c38e9f444 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1451,7 +1451,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 063d4c145e2..705cdc7749f 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -355,6 +355,51 @@ 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);
+ if (TREE_CODE (type) != RECORD_TYPE)
+return false;
+
+ tree field = TYPE_FIELDS (type);
+ if (!field || 0 != strcmp ("_data", IDENTIFIER_POINTER (DECL_NAME (field
+return false;
+ field = DECL_CHAIN (field);
+ if (!field || 0 != strcmp ("_vptr", IDENTIFIER_POINTER (DECL_NAME (field
+return false;
+
+ return true;
+}
+
+/* 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 (TREE_CODE (type) != RECORD_TYPE)
+return false;
+
+ tree field = TYPE_FIELDS (type); /* _data */
+ if (!field)
+return false;
+ field = DECL_CHAIN (field); /* _vptr */
+ if (!field)
+return false;
+ field = DECL_CHAIN (field);
+ if (!field || 0 != strcmp ("_len", IDENTIFIER_POINTER (DECL_NAME (field
+return false;
+
+ return true;
+}
+
+
/* Return true if DECL in private clause needs
OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause. */
bool
@@ -740,6 +785,87 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
|| OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
+ /* TODO: implement support for
