diff options
author | Julian Brown <julian@codesourcery.com> | 2019-12-20 01:20:42 +0000 |
---|---|---|
committer | Julian Brown <jules@gcc.gnu.org> | 2019-12-20 01:20:42 +0000 |
commit | 549188ea10757060b5de532d232813f09d64d9d1 (patch) | |
tree | 781ffdac59753e02eefac9cac647d862d6782a83 /gcc/fortran/trans-expr.c | |
parent | 519d7496beac32c26448c1d0eea176c90f543702 (diff) | |
download | gcc-549188ea10757060b5de532d232813f09d64d9d1.zip gcc-549188ea10757060b5de532d232813f09d64d9d1.tar.gz gcc-549188ea10757060b5de532d232813f09d64d9d1.tar.bz2 |
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
Diffstat (limited to 'gcc/fortran/trans-expr.c')
-rw-r--r-- | gcc/fortran/trans-expr.c | 184 |
1 files changed, 94 insertions, 90 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index eb3250a..61ba4a6 100644 --- a/gcc/fortran/trans-expr.c +++ b/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; } |