diff options
author | Jakub Jelinek <jakub@redhat.com> | 2014-06-24 09:45:22 +0200 |
---|---|---|
committer | Jakub Jelinek <jakub@gcc.gnu.org> | 2014-06-24 09:45:22 +0200 |
commit | b46ebd6c7beaf55974973de0f02d39299b733bc9 (patch) | |
tree | 55405c922bb430cb45ea2427418eb2ed8cd74292 /gcc/fortran/module.c | |
parent | 335123531f234436288975eb80d3655756878d29 (diff) | |
download | gcc-b46ebd6c7beaf55974973de0f02d39299b733bc9.zip gcc-b46ebd6c7beaf55974973de0f02d39299b733bc9.tar.gz gcc-b46ebd6c7beaf55974973de0f02d39299b733bc9.tar.bz2 |
gimplify.c (gimplify_scan_omp_clauses) <case OMP_CLAUSE_MAP, [...]): Make sure OMP_CLAUSE_SIZE is non-NULL.
* gimplify.c (gimplify_scan_omp_clauses) <case OMP_CLAUSE_MAP,
OMP_CLAUSE_TO, OMP_CLAUSE_FROM): Make sure OMP_CLAUSE_SIZE is
non-NULL.
<case OMP_CLAUSE_ALIGNED>: Gimplify OMP_CLAUSE_ALIGNED_ALIGNMENT.
(gimplify_adjust_omp_clauses_1): Make sure OMP_CLAUSE_SIZE is
non-NULL.
(gimplify_adjust_omp_clauses): Likewise.
* omp-low.c (lower_rec_simd_input_clauses,
lower_rec_input_clauses, expand_omp_simd): Handle non-constant
safelen the same as safelen(1).
* tree-nested.c (convert_nonlocal_omp_clauses,
convert_local_omp_clauses): Handle OMP_CLAUSE_ALIGNED. For
OMP_CLAUSE_{MAP,TO,FROM} if not decl use walk_tree.
(convert_nonlocal_reference_stmt, convert_local_reference_stmt):
Fixup handling of GIMPLE_OMP_TARGET.
(convert_tramp_reference_stmt, convert_gimple_call): Handle
GIMPLE_OMP_TARGET.
gcc/fortran/
* dump-parse-tree.c (show_omp_namelist): Use n->udr->udr instead
of n->udr.
* f95-lang.c (gfc_init_builtin_functions): Initialize
BUILT_IN_ASSUME_ALIGNED.
* gfortran.h (gfc_omp_namelist): Change udr field type to
struct gfc_omp_namelist_udr.
(gfc_omp_namelist_udr): New type.
(gfc_get_omp_namelist_udr): Define.
(gfc_resolve_code): New prototype.
* match.c (gfc_free_omp_namelist): Free name->udr.
* module.c (intrinsics): Add INTRINSIC_USER.
(fix_mio_expr): Likewise.
(mio_expr): Handle INSTRINSIC_USER and non-resolved EXPR_FUNCTION.
* openmp.c (gfc_match_omp_clauses): Adjust initialization of n->udr.
(gfc_match_omp_declare_reduction): Treat len=: the same as len=*.
Set attr.flavor on omp_{out,in,priv,orig} artificial variables.
(struct resolve_omp_udr_callback_data): New type.
(resolve_omp_udr_callback, resolve_omp_udr_callback2,
resolve_omp_udr_clause): New functions.
(resolve_omp_clauses): Adjust for n->udr changes, resolve UDR clauses
here.
(omp_udr_callback): Don't check for implicitly declared functions
here.
(gfc_resolve_omp_udr): Don't call gfc_resolve. Don't check for
implicitly declared subroutines here.
* resolve.c (resolve_function): If value.function.isym is non-NULL,
consider it already resolved.
(resolve_code): Renamed to ...
(gfc_resolve_code): ... this. No longer static.
(gfc_resolve_blocks, generate_component_assignments, resolve_codes):
Adjust callers.
* trans-openmp.c (gfc_omp_privatize_by_reference): Don't privatize
by reference type (C_PTR) variables.
(gfc_omp_finish_clause): Make sure OMP_CLAUSE_SIZE is non-NULL.
(gfc_trans_omp_udr_expr): Remove.
(gfc_trans_omp_array_reduction_or_udr): Adjust for n->udr changes.
Don't call gfc_trans_omp_udr_expr, even for sym->attr.dimension
expand it as assignment or subroutine call. Don't initialize
value.function.isym.
gcc/testsuite/
* gfortran.dg/gomp/udr2.f90 (f7, f9): Add !$omp parallel with
reduction clause.
* gfortran.dg/gomp/udr4.f90 (f4): Likewise.
Remove Label is never defined expected error.
* gfortran.dg/gomp/udr8.f90: New test.
libgomp/
* testsuite/libgomp.fortran/aligned1.f03: New test.
* testsuite/libgomp.fortran/nestedfn5.f90: New test.
* testsuite/libgomp.fortran/target7.f90: Surround loop spawning
tasks with !$omp parallel !$omp single.
* testsuite/libgomp.fortran/target8.f90: New test.
* testsuite/libgomp.fortran/udr4.f90 (foo UDR, bar UDR): Adjust
not to use trim in the combiner, instead call elemental function.
(fn): New elemental function.
* testsuite/libgomp.fortran/udr6.f90 (do_add, dp_add, dp_init):
Make elemental.
* testsuite/libgomp.fortran/udr7.f90 (omp_priv, omp_orig, omp_out,
omp_in): Likewise.
* testsuite/libgomp.fortran/udr12.f90: New test.
* testsuite/libgomp.fortran/udr13.f90: New test.
* testsuite/libgomp.fortran/udr14.f90: New test.
* testsuite/libgomp.fortran/udr15.f90: New test.
From-SVN: r211929
Diffstat (limited to 'gcc/fortran/module.c')
-rw-r--r-- | gcc/fortran/module.c | 41 |
1 files changed, 39 insertions, 2 deletions
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index bdd9961..ec67960 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -3136,6 +3136,7 @@ static const mstring intrinsics[] = minit ("LE", INTRINSIC_LE_OS), minit ("NOT", INTRINSIC_NOT), minit ("PARENTHESES", INTRINSIC_PARENTHESES), + minit ("USER", INTRINSIC_USER), minit (NULL, -1) }; @@ -3172,7 +3173,8 @@ fix_mio_expr (gfc_expr *e) && !e->symtree->n.sym->attr.dummy) e->symtree = ns_st; } - else if (e->expr_type == EXPR_FUNCTION && e->value.function.name) + else if (e->expr_type == EXPR_FUNCTION + && (e->value.function.name || e->value.function.isym)) { gfc_symbol *sym; @@ -3287,6 +3289,32 @@ mio_expr (gfc_expr **ep) mio_expr (&e->value.op.op2); break; + case INTRINSIC_USER: + /* INTRINSIC_USER should not appear in resolved expressions, + though for UDRs we need to stream unresolved ones. */ + if (iomode == IO_OUTPUT) + write_atom (ATOM_STRING, e->value.op.uop->name); + else + { + char *name = read_string (); + const char *uop_name = find_use_name (name, true); + if (uop_name == NULL) + { + size_t len = strlen (name); + char *name2 = XCNEWVEC (char, len + 2); + memcpy (name2, name, len); + name2[len] = ' '; + name2[len + 1] = '\0'; + free (name); + uop_name = name = name2; + } + e->value.op.uop = gfc_get_uop (uop_name); + free (name); + } + mio_expr (&e->value.op.op1); + mio_expr (&e->value.op.op2); + break; + default: bad_module ("Bad operator"); } @@ -3305,6 +3333,8 @@ mio_expr (gfc_expr **ep) flag = 1; else if (e->ref) flag = 2; + else if (e->value.function.isym == NULL) + flag = 3; else flag = 0; mio_integer (&flag); @@ -3316,6 +3346,8 @@ mio_expr (gfc_expr **ep) case 2: mio_ref_list (&e->ref); break; + case 3: + break; default: write_atom (ATOM_STRING, e->value.function.isym->name); } @@ -3323,7 +3355,10 @@ mio_expr (gfc_expr **ep) else { require_atom (ATOM_STRING); - e->value.function.name = gfc_get_string (atom_string); + if (atom_string[0] == '\0') + e->value.function.name = NULL; + else + e->value.function.name = gfc_get_string (atom_string); free (atom_string); mio_integer (&flag); @@ -3335,6 +3370,8 @@ mio_expr (gfc_expr **ep) case 2: mio_ref_list (&e->ref); break; + case 3: + break; default: require_atom (ATOM_STRING); e->value.function.isym = gfc_find_function (atom_string); |