diff options
Diffstat (limited to 'gcc-4.9/gcc/fortran/resolve.c')
| -rw-r--r-- | gcc-4.9/gcc/fortran/resolve.c | 117 |
1 files changed, 98 insertions, 19 deletions
diff --git a/gcc-4.9/gcc/fortran/resolve.c b/gcc-4.9/gcc/fortran/resolve.c index 38755fef6..c959f5d95 100644 --- a/gcc-4.9/gcc/fortran/resolve.c +++ b/gcc-4.9/gcc/fortran/resolve.c @@ -40,7 +40,7 @@ typedef enum seq_type seq_type; /* Stack to keep track of the nesting of blocks as we move through the - code. See resolve_branch() and resolve_code(). */ + code. See resolve_branch() and gfc_resolve_code(). */ typedef struct code_stack { @@ -2887,7 +2887,8 @@ resolve_function (gfc_expr *expr) /* See if function is already resolved. */ - if (expr->value.function.name != NULL) + if (expr->value.function.name != NULL + || expr->value.function.isym != NULL) { if (expr->ts.type == BT_UNKNOWN) expr->ts = sym->ts; @@ -4884,7 +4885,7 @@ resolve_variable (gfc_expr *e) if (check_assumed_size_reference (sym, e)) return false; - /* Deal with forward references to entries during resolve_code, to + /* Deal with forward references to entries during gfc_resolve_code, to satisfy, at least partially, 12.5.2.5. */ if (gfc_current_ns->entries && current_entry_id == sym->entry_id @@ -8926,8 +8927,6 @@ resolve_block_construct (gfc_code* code) /* Resolve lists of blocks found in IF, SELECT CASE, WHERE, FORALL, GOTO and DO code nodes. */ -static void resolve_code (gfc_code *, gfc_namespace *); - void gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) { @@ -8979,18 +8978,39 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_ATOMIC: case EXEC_OMP_CRITICAL: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: break; @@ -8998,7 +9018,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) gfc_internal_error ("gfc_resolve_blocks(): Bad block type"); } - resolve_code (b->next, ns); + gfc_resolve_code (b->next, ns); } } @@ -9411,7 +9431,7 @@ nonscalar_typebound_assign (gfc_symbol *derived, int depth) The pointer assignments are taken care of by the intrinsic assignment of the structure itself. This function recursively adds defined assignments where required. The recursion is accomplished - by calling resolve_code. + by calling gfc_resolve_code. When the lhs in a defined assignment has intent INOUT, we need a temporary for the lhs. In pseudo-code: @@ -9529,9 +9549,9 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) comp1, comp2, (*code)->loc); /* Convert the assignment if there is a defined assignment for - this type. Otherwise, using the call from resolve_code, + this type. Otherwise, using the call from gfc_resolve_code, recurse into its components. */ - resolve_code (this_code, ns); + gfc_resolve_code (this_code, ns); if (this_code->op == EXEC_ASSIGN_CALL) { @@ -9695,8 +9715,8 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) /* Given a block of code, recursively resolve everything pointed to by this code block. */ -static void -resolve_code (gfc_code *code, gfc_namespace *ns) +void +gfc_resolve_code (gfc_code *code, gfc_namespace *ns) { int omp_workshare_save; int forall_save, do_concurrent_save; @@ -9733,13 +9753,28 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_TASK: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: omp_workshare_save = omp_workshare_flag; omp_workshare_flag = 0; gfc_resolve_omp_parallel_blocks (code, ns); break; + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: + case EXEC_OMP_SIMD: gfc_resolve_omp_do_blocks (code, ns); break; case EXEC_SELECT_TYPE: @@ -9960,7 +9995,8 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_DO_WHILE: if (code->expr1 == NULL) - gfc_internal_error ("resolve_code(): No expression on DO WHILE"); + gfc_internal_error ("gfc_resolve_code(): No expression on " + "DO WHILE"); if (t && (code->expr1->rank != 0 || code->expr1->ts.type != BT_LOGICAL)) @@ -10054,24 +10090,47 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: case EXEC_OMP_FLUSH: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: + case EXEC_OMP_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: gfc_resolve_omp_directive (code, ns); break; case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: - case EXEC_OMP_TASK: omp_workshare_save = omp_workshare_flag; omp_workshare_flag = 0; gfc_resolve_omp_directive (code, ns); @@ -10079,7 +10138,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; default: - gfc_internal_error ("resolve_code(): Bad statement code"); + gfc_internal_error ("gfc_resolve_code(): Bad statement code"); } } @@ -10779,7 +10838,10 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) } /* Constraints on deferred type parameter. */ - if (sym->ts.deferred && !(sym->attr.pointer || sym->attr.allocatable)) + if (sym->ts.deferred + && !(sym->attr.pointer + || sym->attr.allocatable + || sym->attr.omp_udr_artificial_var)) { gfc_error ("Entity '%s' at %L has a deferred type parameter and " "requires either the pointer or allocatable attribute", @@ -10794,7 +10856,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) dummy arguments. */ e = sym->ts.u.cl->length; if (e == NULL && !sym->attr.dummy && !sym->attr.result - && !sym->ts.deferred && !sym->attr.select_type_temporary) + && !sym->ts.deferred && !sym->attr.select_type_temporary + && !sym->attr.omp_udr_artificial_var) { gfc_error ("Entity with assumed character length at %L must be a " "dummy argument or a PARAMETER", &sym->declared_at); @@ -13429,6 +13492,18 @@ resolve_symbol (gfc_symbol *sym) || sym->ns->proc_name->attr.flavor != FL_MODULE))) gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at); + /* Check omp declare target restrictions. */ + if (sym->attr.omp_declare_target + && sym->attr.flavor == FL_VARIABLE + && !sym->attr.save + && !sym->ns->save_all + && (!sym->attr.in_common + && sym->module == NULL + && (sym->ns->proc_name == NULL + || sym->ns->proc_name->attr.flavor != FL_MODULE))) + gfc_error ("!$OMP DECLARE TARGET variable '%s' at %L isn't SAVEd", + sym->name, &sym->declared_at); + /* If we have come this far we can apply default-initializers, as described in 14.7.5, to those variables that have not already been assigned one. */ @@ -14526,7 +14601,7 @@ gfc_resolve_uops (gfc_symtree *symtree) assign types to all intermediate expressions, make sure that all assignments are to compatible types and figure out which names refer to which functions or subroutines. It doesn't check code - block, which is handled by resolve_code. */ + block, which is handled by gfc_resolve_code. */ static void resolve_types (gfc_namespace *ns) @@ -14607,11 +14682,15 @@ resolve_types (gfc_namespace *ns) gfc_resolve_uops (ns->uop_root); + gfc_resolve_omp_declare_simd (ns); + + gfc_resolve_omp_udrs (ns->omp_udr_root); + gfc_current_ns = old_ns; } -/* Call resolve_code recursively. */ +/* Call gfc_resolve_code recursively. */ static void resolve_codes (gfc_namespace *ns) @@ -14637,7 +14716,7 @@ resolve_codes (gfc_namespace *ns) old_obstack = labels_obstack; bitmap_obstack_initialize (&labels_obstack); - resolve_code (ns->code, ns); + gfc_resolve_code (ns->code, ns); bitmap_obstack_release (&labels_obstack); labels_obstack = old_obstack; |