Skip to content

R
riscv-gcc-1
Commit 549188ea by Julian Brown Committed by Julian Brown
Options

OpenACC 2.6 deep copy: Fortran front-end parts 

        gcc/fortran/
        * gfortran.h (gfc_omp_map_op): Add OMP_MAP_ATTACH, OMP_MAP_DETACH.
        * openmp.c (gfc_match_omp_variable_list): Add allow_derived parameter.
        Parse derived-type member accesses if true.
        (omp_mask2): Add OMP_CLAUSE_ATTACH and OMP_CLAUSE_DETACH.
        (gfc_match_omp_map_clause): Add allow_derived parameter.  Pass to
        gfc_match_omp_variable_list.
        (gfc_match_omp_clauses): Support attach and detach.  Support derived
        types for appropriate OpenACC directives.
        (OACC_PARALLEL_CLAUSES, OACC_SERIAL_CLAUSES, OACC_KERNELS_CLAUSES,
        OACC_DATA_CLAUSES, OACC_ENTER_DATA_CLAUSES): Add OMP_CLAUSE_ATTACH.
        (OACC_EXIT_DATA_CLAUSES): Add OMP_CLAUSE_DETACH.
        (check_symbol_not_pointer): Don't disallow pointer objects of derived
        type.
        (resolve_oacc_data_clauses): Don't disallow allocatable derived types.
        (resolve_omp_clauses): Perform duplicate checking only for non-derived
        type component accesses (plain variables and arrays or array sections).
        Support component refs.
        * trans-expr.c (gfc_conv_component_ref,
        conv_parent_component_references): Make global.
        (gfc_maybe_dereference_var): New function, broken out of...
        (gfc_conv_variable): ...here.  Call above function.
        * trans-openmp.c (gfc_omp_privatize_by_reference): Support component
        refs.
        (gfc_trans_omp_array_section): New function, broken out of...
        (gfc_trans_omp_clauses): ...here.  Support component refs/derived
        types, attach and detach clauses.
        * trans.h (gfc_conv_component_ref, conv_parent_component_references,
        gfc_maybe_dereference_var): Add prototypes.

        gcc/testsuite/
        * gfortran.dg/goacc/derived-types.f90: New test.
        * gfortran.dg/goacc/derived-types-2.f90: New test.
        * gfortran.dg/goacc/derived-types-3.f90: New test.
        * gfortran.dg/goacc/data-clauses.f95: Adjust for expected errors.
        * gfortran.dg/goacc/enter-exit-data.f95: Likewise.

From-SVN: r279628
parent 519d7496
Showing with 275 additions and 119 deletions
gcc/fortran/ChangeLog
2019-12-19 Julian Brown <julian@codesourcery.com>
* gfortran.h (gfc_omp_map_op): Add OMP_MAP_ATTACH, OMP_MAP_DETACH.
* openmp.c (gfc_match_omp_variable_list): Add allow_derived parameter.
Parse derived-type member accesses if true.
(omp_mask2): Add OMP_CLAUSE_ATTACH and OMP_CLAUSE_DETACH.
(gfc_match_omp_map_clause): Add allow_derived parameter. Pass to
gfc_match_omp_variable_list.
(gfc_match_omp_clauses): Support attach and detach. Support derived
types for appropriate OpenACC directives.
(OACC_PARALLEL_CLAUSES, OACC_SERIAL_CLAUSES, OACC_KERNELS_CLAUSES,
OACC_DATA_CLAUSES, OACC_ENTER_DATA_CLAUSES): Add OMP_CLAUSE_ATTACH.
(OACC_EXIT_DATA_CLAUSES): Add OMP_CLAUSE_DETACH.
(check_symbol_not_pointer): Don't disallow pointer objects of derived
type.
(resolve_oacc_data_clauses): Don't disallow allocatable derived types.
(resolve_omp_clauses): Perform duplicate checking only for non-derived
type component accesses (plain variables and arrays or array sections).
Support component refs.
* trans-expr.c (gfc_conv_component_ref,
conv_parent_component_references): Make global.
(gfc_maybe_dereference_var): New function, broken out of...
(gfc_conv_variable): ...here. Call above function.
* trans-openmp.c (gfc_omp_privatize_by_reference): Support component
refs.
(gfc_trans_omp_array_section): New function, broken out of...
(gfc_trans_omp_clauses): ...here. Support component refs/derived
types, attach and detach clauses.
* trans.h (gfc_conv_component_ref, conv_parent_component_references,
gfc_maybe_dereference_var): Add prototypes.
2019-12-19 Mark Eggleston <mark.eggleston@codethink.com>
PR fortran/92896
......
gcc/fortran/gfortran.h
......@@ -1193,10 +1193,12 @@ enum gfc_omp_map_op
{
OMP_MAP_ALLOC,
OMP_MAP_IF_PRESENT,
OMP_MAP_ATTACH,
OMP_MAP_TO,
OMP_MAP_FROM,
OMP_MAP_TOFROM,
OMP_MAP_DELETE,
OMP_MAP_DETACH,
OMP_MAP_FORCE_ALLOC,
OMP_MAP_FORCE_TO,
OMP_MAP_FORCE_FROM,
......
gcc/fortran/trans-expr.c
......@@ -2423,7 +2423,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
/* Convert a derived type component reference. */
static void
void
gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
{
gfc_component *c;
......@@ -2513,7 +2513,7 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
/* This function deals with component references to components of the
parent type for derived type extensions. */
static void
void
conv_parent_component_references (gfc_se * se, gfc_ref * ref)
{
gfc_component *c;
......@@ -2579,6 +2579,95 @@ conv_inquiry (gfc_se * se, gfc_ref * ref, gfc_expr *expr, gfc_typespec *ts)
se->expr = res;
}
/* Dereference VAR where needed if it is a pointer, reference, etc.
according to Fortran semantics. */
tree
gfc_maybe_dereference_var (gfc_symbol *sym, tree var, bool descriptor_only_p,
bool is_classarray)
{
/* Characters are entirely different from other types, they are treated
separately. */
if (sym->ts.type == BT_CHARACTER)
{
/* Dereference character pointer dummy arguments
or results. */
if ((sym->attr.pointer || sym->attr.allocatable)
&& (sym->attr.dummy
|| sym->attr.function
|| sym->attr.result))
var = build_fold_indirect_ref_loc (input_location, var);
}
else if (!sym->attr.value)
{
/* Dereference temporaries for class array dummy arguments. */
if (sym->attr.dummy && is_classarray
&& GFC_ARRAY_TYPE_P (TREE_TYPE (var)))
{
if (!descriptor_only_p)
var = GFC_DECL_SAVED_DESCRIPTOR (var);
var = build_fold_indirect_ref_loc (input_location, var);
}
/* Dereference non-character scalar dummy arguments. */
if (sym->attr.dummy && !sym->attr.dimension
&& !(sym->attr.codimension && sym->attr.allocatable)
&& (sym->ts.type != BT_CLASS
|| (!CLASS_DATA (sym)->attr.dimension
&& !(CLASS_DATA (sym)->attr.codimension
&& CLASS_DATA (sym)->attr.allocatable))))
var = build_fold_indirect_ref_loc (input_location, var);
/* Dereference scalar hidden result. */
if (flag_f2c && sym->ts.type == BT_COMPLEX
&& (sym->attr.function || sym->attr.result)
&& !sym->attr.dimension && !sym->attr.pointer
&& !sym->attr.always_explicit)
var = build_fold_indirect_ref_loc (input_location, var);
/* Dereference non-character, non-class pointer variables.
These must be dummies, results, or scalars. */
if (!is_classarray
&& (sym->attr.pointer || sym->attr.allocatable
|| gfc_is_associate_pointer (sym)
|| (sym->as && sym->as->type == AS_ASSUMED_RANK))
&& (sym->attr.dummy
|| sym->attr.function
|| sym->attr.result
|| (!sym->attr.dimension
&& (!sym->attr.codimension || !sym->attr.allocatable))))
var = build_fold_indirect_ref_loc (input_location, var);
/* Now treat the class array pointer variables accordingly. */
else if (sym->ts.type == BT_CLASS
&& sym->attr.dummy
&& (CLASS_DATA (sym)->attr.dimension
|| CLASS_DATA (sym)->attr.codimension)
&& ((CLASS_DATA (sym)->as
&& CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
|| CLASS_DATA (sym)->attr.allocatable
|| CLASS_DATA (sym)->attr.class_pointer))
var = build_fold_indirect_ref_loc (input_location, var);
/* And the case where a non-dummy, non-result, non-function,
non-allotable and non-pointer classarray is present. This case was
previously covered by the first if, but with introducing the
condition !is_classarray there, that case has to be covered
explicitly. */
else if (sym->ts.type == BT_CLASS
&& !sym->attr.dummy
&& !sym->attr.function
&& !sym->attr.result
&& (CLASS_DATA (sym)->attr.dimension
|| CLASS_DATA (sym)->attr.codimension)
&& (sym->assoc
|| !CLASS_DATA (sym)->attr.allocatable)
&& !CLASS_DATA (sym)->attr.class_pointer)
var = build_fold_indirect_ref_loc (input_location, var);
}
return var;
}
/* Return the contents of a variable. Also handles reference/pointer
variables (all Fortran pointer references are implicit). */
......@@ -2685,94 +2774,9 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
return;
}
/* Dereference the expression, where needed. Since characters
are entirely different from other types, they are treated
separately. */
if (sym->ts.type == BT_CHARACTER)
{
/* Dereference character pointer dummy arguments
or results. */
if ((sym->attr.pointer || sym->attr.allocatable)
&& (sym->attr.dummy
|| sym->attr.function
|| sym->attr.result))
se->expr = build_fold_indirect_ref_loc (input_location,
se->expr);
}
else if (!sym->attr.value)
{
/* Dereference temporaries for class array dummy arguments. */
if (sym->attr.dummy && is_classarray
&& GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr)))
{
if (!se->descriptor_only)
se->expr = GFC_DECL_SAVED_DESCRIPTOR (se->expr);
se->expr = build_fold_indirect_ref_loc (input_location,
se->expr);
}
/* Dereference non-character scalar dummy arguments. */
if (sym->attr.dummy && !sym->attr.dimension
&& !(sym->attr.codimension && sym->attr.allocatable)
&& (sym->ts.type != BT_CLASS
|| (!CLASS_DATA (sym)->attr.dimension
&& !(CLASS_DATA (sym)->attr.codimension
&& CLASS_DATA (sym)->attr.allocatable))))
se->expr = build_fold_indirect_ref_loc (input_location,
se->expr);
/* Dereference scalar hidden result. */
if (flag_f2c && sym->ts.type == BT_COMPLEX
&& (sym->attr.function || sym->attr.result)
&& !sym->attr.dimension && !sym->attr.pointer
&& !sym->attr.always_explicit)
se->expr = build_fold_indirect_ref_loc (input_location,
se->expr);
/* Dereference non-character, non-class pointer variables.
These must be dummies, results, or scalars. */
if (!is_classarray
&& (sym->attr.pointer || sym->attr.allocatable
|| gfc_is_associate_pointer (sym)
|| (sym->as && sym->as->type == AS_ASSUMED_RANK))
&& (sym->attr.dummy
|| sym->attr.function
|| sym->attr.result
|| (!sym->attr.dimension
&& (!sym->attr.codimension || !sym->attr.allocatable))))
se->expr = build_fold_indirect_ref_loc (input_location,
se->expr);
/* Now treat the class array pointer variables accordingly. */
else if (sym->ts.type == BT_CLASS
&& sym->attr.dummy
&& (CLASS_DATA (sym)->attr.dimension
|| CLASS_DATA (sym)->attr.codimension)
&& ((CLASS_DATA (sym)->as
&& CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
|| CLASS_DATA (sym)->attr.allocatable
|| CLASS_DATA (sym)->attr.class_pointer))
se->expr = build_fold_indirect_ref_loc (input_location,
se->expr);
/* And the case where a non-dummy, non-result, non-function,
non-allotable and non-pointer classarray is present. This case was
previously covered by the first if, but with introducing the
condition !is_classarray there, that case has to be covered
explicitly. */
else if (sym->ts.type == BT_CLASS
&& !sym->attr.dummy
&& !sym->attr.function
&& !sym->attr.result
&& (CLASS_DATA (sym)->attr.dimension
|| CLASS_DATA (sym)->attr.codimension)
&& (sym->assoc
|| !CLASS_DATA (sym)->attr.allocatable)
&& !CLASS_DATA (sym)->attr.class_pointer)
se->expr = build_fold_indirect_ref_loc (input_location,
se->expr);
}
/* Dereference the expression, where needed. */
se->expr = gfc_maybe_dereference_var (sym, se->expr, se->descriptor_only,
is_classarray);
ref = expr->ref;
}
......
gcc/fortran/trans.h
......@@ -565,6 +565,14 @@ tree gfc_conv_expr_present (gfc_symbol *);
/* Convert a missing, dummy argument into a null or zero. */
void gfc_conv_missing_dummy (gfc_se *, gfc_expr *, gfc_typespec, int);
/* Lowering of component references. */
void gfc_conv_component_ref (gfc_se * se, gfc_ref * ref);
void conv_parent_component_references (gfc_se * se, gfc_ref * ref);
/* Automatically dereference var. */
tree gfc_maybe_dereference_var (gfc_symbol *, tree, bool desc_only = false,
bool is_classarray = false);
/* Generate code to allocate a string temporary. */
tree gfc_conv_string_tmp (gfc_se *, tree, tree);
/* Get the string length variable belonging to an expression. */
......
gcc/testsuite/ChangeLog
2019-12-19 Julian Brown <julian@codesourcery.com>
* gfortran.dg/goacc/derived-types.f90: New test.
* gfortran.dg/goacc/derived-types-2.f90: New test.
* gfortran.dg/goacc/derived-types-3.f90: New test.
* gfortran.dg/goacc/data-clauses.f95: Adjust for expected errors.
* gfortran.dg/goacc/enter-exit-data.f95: Likewise.
2019-12-19 Julian Brown <julian@codesourcery.com>
Cesar Philippidis <cesar@codesourcery.com>
* c-c++-common/goacc/deep-copy-arrayofstruct.c: New test.
......
gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
......@@ -39,9 +39,9 @@ contains
!$acc end data
!$acc parallel copy (tip) ! { dg-error "POINTER" }
!$acc parallel copy (tip)
!$acc end parallel
!$acc parallel copy (tia) ! { dg-error "ALLOCATABLE" }
!$acc parallel copy (tia)
!$acc end parallel
!$acc parallel deviceptr (i) copy (i) ! { dg-error "multiple clauses" }
!$acc end parallel
......@@ -54,9 +54,9 @@ contains
!$acc end data
!$acc parallel copyin (tip) ! { dg-error "POINTER" }
!$acc parallel copyin (tip)
!$acc end parallel
!$acc parallel copyin (tia) ! { dg-error "ALLOCATABLE" }
!$acc parallel copyin (tia)
!$acc end parallel
!$acc parallel deviceptr (i) copyin (i) ! { dg-error "multiple clauses" }
!$acc end parallel
......@@ -71,9 +71,9 @@ contains
!$acc end data
!$acc parallel copyout (tip) ! { dg-error "POINTER" }
!$acc parallel copyout (tip)
!$acc end parallel
!$acc parallel copyout (tia) ! { dg-error "ALLOCATABLE" }
!$acc parallel copyout (tia)
!$acc end parallel
!$acc parallel deviceptr (i) copyout (i) ! { dg-error "multiple clauses" }
!$acc end parallel
......@@ -90,9 +90,9 @@ contains
!$acc end data
!$acc parallel create (tip) ! { dg-error "POINTER" }
!$acc parallel create (tip)
!$acc end parallel
!$acc parallel create (tia) ! { dg-error "ALLOCATABLE" }
!$acc parallel create (tia)
!$acc end parallel
!$acc parallel deviceptr (i) create (i) ! { dg-error "multiple clauses" }
!$acc end parallel
......@@ -134,7 +134,7 @@ contains
!$acc parallel present (tip) ! { dg-error "POINTER" }
!$acc end parallel
!$acc parallel present (tia) ! { dg-error "ALLOCATABLE" }
!$acc parallel present (tia)
!$acc end parallel
!$acc parallel deviceptr (i) present (i) ! { dg-error "multiple clauses" }
!$acc end parallel
......@@ -165,9 +165,9 @@ contains
!$acc end parallel
!$acc parallel present_or_copy (tip) ! { dg-error "POINTER" }
!$acc parallel present_or_copy (tip)
!$acc end parallel
!$acc parallel present_or_copy (tia) ! { dg-error "ALLOCATABLE" }
!$acc parallel present_or_copy (tia)
!$acc end parallel
!$acc parallel deviceptr (i) present_or_copy (i) ! { dg-error "multiple clauses" }
!$acc end parallel
......@@ -190,9 +190,9 @@ contains
!$acc end data
!$acc parallel present_or_copyin (tip) ! { dg-error "POINTER" }
!$acc parallel present_or_copyin (tip)
!$acc end parallel
!$acc parallel present_or_copyin (tia) ! { dg-error "ALLOCATABLE" }
!$acc parallel present_or_copyin (tia)
!$acc end parallel
!$acc parallel deviceptr (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
!$acc end parallel
......@@ -217,9 +217,9 @@ contains
!$acc end data
!$acc parallel present_or_copyout (tip) ! { dg-error "POINTER" }
!$acc parallel present_or_copyout (tip)
!$acc end parallel
!$acc parallel present_or_copyout (tia) ! { dg-error "ALLOCATABLE" }
!$acc parallel present_or_copyout (tia)
!$acc end parallel
!$acc parallel deviceptr (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
!$acc end parallel
......@@ -246,9 +246,9 @@ contains
!$acc end data
!$acc parallel present_or_create (tip) ! { dg-error "POINTER" }
!$acc parallel present_or_create (tip)
!$acc end parallel
!$acc parallel present_or_create (tia) ! { dg-error "ALLOCATABLE" }
!$acc parallel present_or_create (tia)
!$acc end parallel
!$acc parallel deviceptr (i) present_or_create (i) ! { dg-error "multiple clauses" }
!$acc end parallel
......
gcc/testsuite/gfortran.dg/goacc/derived-types-2.f90 0 → 100644
module bar
type :: type1
real(8), pointer, public :: p(:) => null()
end type
type :: type2
class(type1), pointer :: p => null()
end type
end module
subroutine foo (var)
use bar
type(type2), intent(inout) :: var
!$acc enter data create(var%p%p)
end subroutine
gcc/testsuite/gfortran.dg/goacc/derived-types-3.f90 0 → 100644
module bar
type :: type1
integer :: a(5)
integer :: b(5)
end type
end module
subroutine foo
use bar
type(type1) :: var
!$acc enter data copyin(var%a) copyin(var%a) ! { dg-error ".var\.a. appears more than once in map clauses" }
end subroutine
gcc/testsuite/gfortran.dg/goacc/derived-types.f90 0 → 100644
! Test ACC UPDATE with derived types.
module dt
integer, parameter :: n = 10
type inner
integer :: d(n)
end type inner
type dtype
integer(8) :: a, b, c(n)
type(inner) :: in
end type dtype
end module dt
program derived_acc
use dt
implicit none
type(dtype):: var
integer i
!$acc declare create(var)
!$acc declare pcopy(var%a) ! { dg-error "Syntax error in OpenMP" }
!$acc update host(var)
!$acc update host(var%a)
!$acc update device(var)
!$acc update device(var%a)
!$acc update self(var)
!$acc update self(var%a)
!$acc enter data copyin(var)
!$acc enter data copyin(var%a)
!$acc exit data copyout(var)
!$acc exit data copyout(var%a)
!$acc data copy(var)
!$acc end data
!$acc data copyout(var%a)
!$acc end data
!$acc parallel loop pcopyout(var)
do i = 1, 10
end do
!$acc end parallel loop
!$acc parallel loop copyout(var%a)
do i = 1, 10
end do
!$acc end parallel loop
!$acc parallel pcopy(var)
!$acc end parallel
!$acc parallel pcopy(var%a)
do i = 1, 10
end do
!$acc end parallel
!$acc kernels pcopyin(var)
!$acc end kernels
!$acc kernels pcopy(var%a)
do i = 1, 10
end do
!$acc end kernels
!$acc kernels loop pcopyin(var)
do i = 1, 10
end do
!$acc end kernels loop
!$acc kernels loop pcopy(var%a)
do i = 1, 10
end do
!$acc end kernels loop
end program derived_acc
gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
......@@ -44,14 +44,14 @@ contains
!$acc enter data wait (i, 1)
!$acc enter data wait (a) ! { dg-error "INTEGER" }
!$acc enter data wait (b(5:6)) ! { dg-error "INTEGER" }
!$acc enter data copyin (tip) ! { dg-error "POINTER" }
!$acc enter data copyin (tia) ! { dg-error "ALLOCATABLE" }
!$acc enter data create (tip) ! { dg-error "POINTER" }
!$acc enter data create (tia) ! { dg-error "ALLOCATABLE" }
!$acc enter data present_or_copyin (tip) ! { dg-error "POINTER" }
!$acc enter data present_or_copyin (tia) ! { dg-error "ALLOCATABLE" }
!$acc enter data present_or_create (tip) ! { dg-error "POINTER" }
!$acc enter data present_or_create (tia) ! { dg-error "ALLOCATABLE" }
!$acc enter data copyin (tip)
!$acc enter data copyin (tia)
!$acc enter data create (tip)
!$acc enter data create (tia)
!$acc enter data present_or_copyin (tip)
!$acc enter data present_or_copyin (tia)
!$acc enter data present_or_create (tip)
!$acc enter data present_or_create (tia)
!$acc enter data copyin (i) create (i) ! { dg-error "multiple clauses" }
!$acc enter data copyin (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
!$acc enter data create (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
......@@ -79,10 +79,10 @@ contains
!$acc exit data wait (i, 1)
!$acc exit data wait (a) ! { dg-error "INTEGER" }
!$acc exit data wait (b(5:6)) ! { dg-error "INTEGER" }
!$acc exit data copyout (tip) ! { dg-error "POINTER" }
!$acc exit data copyout (tia) ! { dg-error "ALLOCATABLE" }
!$acc exit data delete (tip) ! { dg-error "POINTER" }
!$acc exit data delete (tia) ! { dg-error "ALLOCATABLE" }
!$acc exit data copyout (tip)
!$acc exit data copyout (tia)
!$acc exit data delete (tip)
!$acc exit data delete (tia)
!$acc exit data copyout (i) delete (i) ! { dg-error "multiple clauses" }
!$acc exit data finalize
!$acc exit data finalize copyout (i)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment