From 2ac33bca8a98148859c5375663fe93f5046697b0 Mon Sep 17 00:00:00 2001 From: Cesar Philippidis Date: Fri, 30 Oct 2015 15:16:52 -0700 Subject: [PATCH] gfortran.h (gfc_omp_namespace): Add locus where member. gcc/fortran/ * gfortran.h (gfc_omp_namespace): Add locus where member. * openmp.c (gfc_match_omp_variable_list): Set where for each list item found. (resolve_omp_clauses): Remove where argument and use the where gfc_omp_namespace member when reporting errors. (resolve_omp_do): Update call to resolve_omp_clauses. (resolve_oacc_loop): Likewise. (gfc_resolve_oacc_directive): Likewise. (gfc_resolve_omp_directive): Likewise. (gfc_resolve_omp_declare_simd): Likewise. gcc/testsuite/ * gfortran.dg/gomp/intentin1.f90: Adjust copyprivate warning. From-SVN: r229609 --- gcc/fortran/ChangeLog | 13 +++ gcc/fortran/gfortran.h | 1 + gcc/fortran/openmp.c | 113 ++++++++++--------- gcc/testsuite/ChangeLog | 4 + gcc/testsuite/gfortran.dg/gomp/intentin1.f90 | 4 +- 5 files changed, 77 insertions(+), 58 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8b99c0349f7..8b180ab98d8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2015-10-30 Cesar Philippidis + + * gfortran.h (gfc_omp_namespace): Add locus where member. + * openmp.c (gfc_match_omp_variable_list): Set where for each list + item found. + (resolve_omp_clauses): Remove where argument and use the where + gfc_omp_namespace member when reporting errors. + (resolve_omp_do): Update call to resolve_omp_clauses. + (resolve_oacc_loop): Likewise. + (gfc_resolve_oacc_directive): Likewise. + (gfc_resolve_omp_directive): Likewise. + (gfc_resolve_omp_declare_simd): Likewise. + 2015-10-15 Steven G. Kargl PR fortran/51993 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 90f63cf4807..13e730f41b7 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1123,6 +1123,7 @@ typedef struct gfc_omp_namelist } u; struct gfc_omp_namelist_udr *udr; struct gfc_omp_namelist *next; + locus where; } gfc_omp_namelist; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 6c78c97288b..3fd19b82fa1 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -244,6 +244,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, } tail->sym = sym; tail->expr = expr; + tail->where = cur_loc; goto next_item; case MATCH_NO: break; @@ -278,6 +279,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, tail = tail->next; } tail->sym = sym; + tail->where = cur_loc; } next_item: @@ -2860,9 +2862,8 @@ oacc_compatible_clauses (gfc_omp_clauses *clauses, int list, /* OpenMP directive resolving routines. */ static void -resolve_omp_clauses (gfc_code *code, locus *where, - gfc_omp_clauses *omp_clauses, gfc_namespace *ns, - bool openacc = false) +resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, + gfc_namespace *ns, bool openacc = false) { gfc_omp_namelist *n; gfc_expr_list *el; @@ -2921,7 +2922,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, { if (!code && (!n->sym->attr.dummy || n->sym->ns != ns)) gfc_error ("Variable %qs is not a dummy argument at %L", - n->sym->name, where); + n->sym->name, n->where); continue; } if (n->sym->attr.flavor == FL_PROCEDURE @@ -2953,7 +2954,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, } } gfc_error ("Object %qs is not a variable at %L", n->sym->name, - where); + &n->where); } for (list = 0; list < OMP_LIST_NUM; list++) @@ -2969,7 +2970,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, if (n->sym->mark && !oacc_compatible_clauses (omp_clauses, list, n->sym, openacc)) gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, where); + n->sym->name, &n->where); else n->sym->mark = 1; } @@ -2980,7 +2981,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, if (n->sym->mark) { gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, where); + n->sym->name, &n->where); n->sym->mark = 0; } @@ -2988,7 +2989,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, { if (n->sym->mark) gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, where); + n->sym->name, &n->where); else n->sym->mark = 1; } @@ -2999,7 +3000,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, { if (n->sym->mark) gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, where); + n->sym->name, &n->where); else n->sym->mark = 1; } @@ -3011,7 +3012,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, { if (n->sym->mark) gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, where); + n->sym->name, &n->where); else n->sym->mark = 1; } @@ -3025,7 +3026,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, { if (n->expr == NULL && n->sym->mark) gfc_error ("Symbol %qs present on both FROM and TO clauses at %L", - n->sym->name, where); + n->sym->name, &n->where); else n->sym->mark = 1; } @@ -3047,7 +3048,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, { if (!n->sym->attr.threadprivate) gfc_error ("Non-THREADPRIVATE object %qs in COPYIN clause" - " at %L", n->sym->name, where); + " at %L", n->sym->name, &n->where); } break; case OMP_LIST_COPYPRIVATE: @@ -3055,10 +3056,10 @@ resolve_omp_clauses (gfc_code *code, locus *where, { if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE) gfc_error ("Assumed size array %qs in COPYPRIVATE clause " - "at %L", n->sym->name, where); + "at %L", n->sym->name, &n->where); if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN) gfc_error ("INTENT(IN) POINTER %qs in COPYPRIVATE clause " - "at %L", n->sym->name, where); + "at %L", n->sym->name, &n->where); } break; case OMP_LIST_SHARED: @@ -3066,13 +3067,13 @@ resolve_omp_clauses (gfc_code *code, locus *where, { if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object %qs in SHARED clause at " - "%L", n->sym->name, where); + "%L", n->sym->name, &n->where); if (n->sym->attr.cray_pointee) gfc_error ("Cray pointee %qs in SHARED clause at %L", - n->sym->name, where); + n->sym->name, &n->where); if (n->sym->attr.associate_var) gfc_error ("ASSOCIATE name %qs in SHARED clause at %L", - n->sym->name, where); + n->sym->name, &n->where); } break; case OMP_LIST_ALIGNED: @@ -3088,7 +3089,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, != ISOCBINDING_PTR))) gfc_error ("%qs in ALIGNED clause must be POINTER, " "ALLOCATABLE, Cray pointer or C_PTR at %L", - n->sym->name, where); + n->sym->name, &n->where); else if (n->expr) { gfc_expr *expr = n->expr; @@ -3100,7 +3101,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, || alignment <= 0) gfc_error ("%qs in ALIGNED clause at %L requires a scalar " "positive constant integer alignment " - "expression", n->sym->name, where); + "expression", n->sym->name, &n->where); } } break; @@ -3119,10 +3120,11 @@ resolve_omp_clauses (gfc_code *code, locus *where, || n->expr->ref->next || n->expr->ref->type != REF_ARRAY) gfc_error ("%qs in %s clause at %L is not a proper " - "array section", n->sym->name, name, where); + "array section", n->sym->name, name, + &n->where); else if (n->expr->ref->u.ar.codimen) gfc_error ("Coarrays not supported in %s clause at %L", - name, where); + name, &n->where); else { int i; @@ -3132,7 +3134,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, { gfc_error ("Stride should not be specified for " "array section in %s clause at %L", - name, where); + name, &n->where); break; } else if (ar->dimen_type[i] != DIMEN_ELEMENT @@ -3140,7 +3142,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, { gfc_error ("%qs in %s clause at %L is not a " "proper array section", - n->sym->name, name, where); + n->sym->name, name, &n->where); break; } else if (list == OMP_LIST_DEPEND @@ -3153,7 +3155,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, { gfc_error ("%qs in DEPEND clause at %L is a " "zero size array section", - n->sym->name, where); + n->sym->name, &n->where); break; } } @@ -3162,9 +3164,9 @@ resolve_omp_clauses (gfc_code *code, locus *where, { if (list == OMP_LIST_MAP && n->u.map_op == OMP_MAP_FORCE_DEVICEPTR) - resolve_oacc_deviceptr_clause (n->sym, *where, name); + resolve_oacc_deviceptr_clause (n->sym, n->where, name); else - resolve_oacc_data_clauses (n->sym, *where, name); + resolve_oacc_data_clauses (n->sym, n->where, name); } } @@ -3174,10 +3176,10 @@ resolve_omp_clauses (gfc_code *code, locus *where, n->sym->attr.referenced = 1; if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); if (n->sym->attr.cray_pointee) gfc_error ("Cray pointee %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); } break; default: @@ -3186,35 +3188,35 @@ resolve_omp_clauses (gfc_code *code, locus *where, bool bad = false; if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); if (n->sym->attr.cray_pointee) gfc_error ("Cray pointee %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); if (n->sym->attr.associate_var) gfc_error ("ASSOCIATE name %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); if (list != OMP_LIST_PRIVATE) { if (n->sym->attr.proc_pointer && list == OMP_LIST_REDUCTION) gfc_error ("Procedure pointer %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); if (n->sym->attr.pointer && list == OMP_LIST_REDUCTION) gfc_error ("POINTER object %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); if (n->sym->attr.cray_pointer && list == OMP_LIST_REDUCTION) gfc_error ("Cray pointer %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); } if (code && (oacc_is_loop (code) || code->op == EXEC_OACC_PARALLEL)) - check_array_not_assumed (n->sym, *where, name); + check_array_not_assumed (n->sym, n->where, name); else if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE) gfc_error ("Assumed size array %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); if (n->sym->attr.in_namelist && list != OMP_LIST_REDUCTION) gfc_error ("Variable %qs in %s clause is used in " "NAMELIST statement at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN) switch (list) { @@ -3223,7 +3225,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, case OMP_LIST_LINEAR: /* case OMP_LIST_REDUCTION: */ gfc_error ("INTENT(IN) POINTER %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); break; default: break; @@ -3317,7 +3319,7 @@ resolve_omp_clauses (gfc_code *code, locus *where, } gfc_error ("!$OMP DECLARE REDUCTION %s not found " "for type %s at %L", udr_name, - gfc_typename (&n->sym->ts), where); + gfc_typename (&n->sym->ts), &n->where); } else { @@ -3339,10 +3341,10 @@ resolve_omp_clauses (gfc_code *code, locus *where, case OMP_LIST_LINEAR: if (n->sym->ts.type != BT_INTEGER) gfc_error ("LINEAR variable %qs must be INTEGER " - "at %L", n->sym->name, where); + "at %L", n->sym->name, &n->where); else if (!code && !n->sym->attr.value) gfc_error ("LINEAR dummy argument %qs must have VALUE " - "attribute at %L", n->sym->name, where); + "attribute at %L", n->sym->name, &n->where); else if (n->expr) { gfc_expr *expr = n->expr; @@ -3351,11 +3353,11 @@ resolve_omp_clauses (gfc_code *code, locus *where, || expr->rank != 0) gfc_error ("%qs in LINEAR clause at %L requires " "a scalar integer linear-step expression", - n->sym->name, where); + n->sym->name, &n->where); else if (!code && expr->expr_type != EXPR_CONSTANT) gfc_error ("%qs in LINEAR clause at %L requires " "a constant integer linear-step expression", - n->sym->name, where); + n->sym->name, &n->where); } break; /* Workaround for PR middle-end/26316, nothing really needs @@ -3368,22 +3370,22 @@ resolve_omp_clauses (gfc_code *code, locus *where, || (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym) && CLASS_DATA (n->sym)->attr.allocatable)) gfc_error ("ALLOCATABLE object %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); if (n->sym->attr.pointer || (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym) && CLASS_DATA (n->sym)->attr.class_pointer)) gfc_error ("POINTER object %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); if (n->sym->attr.cray_pointer) gfc_error ("Cray pointer object %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); if (n->sym->attr.cray_pointee) gfc_error ("Cray pointee object %qs in %s clause at %L", - n->sym->name, name, where); + n->sym->name, name, &n->where); /* FALLTHRU */ case OMP_LIST_DEVICE_RESIDENT: - check_symbol_not_pointer (n->sym, *where, name); - check_array_not_assumed (n->sym, *where, name); + check_symbol_not_pointer (n->sym, n->where, name); + check_array_not_assumed (n->sym, n->where, name); break; default: break; @@ -4149,7 +4151,7 @@ resolve_omp_do (gfc_code *code) } if (code->ext.omp_clauses) - resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL); + resolve_omp_clauses (code, code->ext.omp_clauses, NULL); do_code = code->block->next; collapse = code->ext.omp_clauses->collapse; @@ -4587,7 +4589,7 @@ resolve_oacc_loop (gfc_code *code) int collapse; if (code->ext.omp_clauses) - resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL, true); + resolve_omp_clauses (code, code->ext.omp_clauses, NULL, true); do_code = code->block->next; collapse = code->ext.omp_clauses->collapse; @@ -4652,8 +4654,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) case EXEC_OACC_EXIT_DATA: case EXEC_OACC_WAIT: case EXEC_OACC_CACHE: - resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL, - true); + resolve_omp_clauses (code, code->ext.omp_clauses, NULL, true); break; case EXEC_OACC_PARALLEL_LOOP: case EXEC_OACC_KERNELS_LOOP: @@ -4711,11 +4712,11 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) case EXEC_OMP_TEAMS: case EXEC_OMP_WORKSHARE: if (code->ext.omp_clauses) - resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL); + resolve_omp_clauses (code, code->ext.omp_clauses, NULL); break; case EXEC_OMP_TARGET_UPDATE: if (code->ext.omp_clauses) - resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL); + resolve_omp_clauses (code, code->ext.omp_clauses, NULL); if (code->ext.omp_clauses == NULL || (code->ext.omp_clauses->lists[OMP_LIST_TO] == NULL && code->ext.omp_clauses->lists[OMP_LIST_FROM] == NULL)) @@ -4743,7 +4744,7 @@ gfc_resolve_omp_declare_simd (gfc_namespace *ns) gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure " "%qs at %L", ns->proc_name->name, &ods->where); if (ods->clauses) - resolve_omp_clauses (NULL, &ods->where, ods->clauses, ns); + resolve_omp_clauses (NULL, ods->clauses, ns); } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a82f4cb2f5e..2ec795cda2a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2015-10-30 Cesar Philippidis + + * gfortran.dg/gomp/intentin1.f90: Adjust copyprivate warning. + 2015-10-30 Steven G. Kargl PR fortran/46588 diff --git a/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 b/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 index f2a2e98fd76..8bd53aaf562 100644 --- a/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 @@ -11,6 +11,6 @@ subroutine foo (x) !$omp simd linear (x) ! { dg-error "INTENT.IN. POINTER" } do i = 1, 10 end do -!$omp single ! { dg-error "INTENT.IN. POINTER" } -!$omp end single copyprivate (x) +!$omp single +!$omp end single copyprivate (x) ! { dg-error "INTENT.IN. POINTER" } end -- 2.30.2