From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 127857 invoked by alias); 30 Oct 2015 17:03:31 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 127820 invoked by uid 89); 30 Oct 2015 17:03:31 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.1 required=5.0 tests=AWL,BAYES_00,RCVD_IN_DNSWL_LOW,SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: relay1.mentorg.com Received: from relay1.mentorg.com (HELO relay1.mentorg.com) (192.94.38.131) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 30 Oct 2015 17:03:28 +0000 Received: from svr-orw-fem-06.mgc.mentorg.com ([147.34.97.120]) by relay1.mentorg.com with esmtp id 1ZsD5I-0001xq-N2 from Cesar_Philippidis@mentor.com ; Fri, 30 Oct 2015 10:03:24 -0700 Received: from [127.0.0.1] (147.34.91.1) by SVR-ORW-FEM-06.mgc.mentorg.com (147.34.97.120) with Microsoft SMTP Server id 14.3.224.2; Fri, 30 Oct 2015 10:03:24 -0700 Subject: Re: more accurate omp in fortran To: Jakub Jelinek References: <5628FEFF.50809@codesourcery.com> <20151030144727.GC478@tucnak.redhat.com> <56338674.3060608@codesourcery.com> <20151030165822.GD478@tucnak.redhat.com> CC: Fortran List , "gcc-patches@gcc.gnu.org" From: Cesar Philippidis Message-ID: <5633A2DB.5000402@codesourcery.com> Date: Fri, 30 Oct 2015 17:06:00 -0000 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101 Thunderbird/38.3.0 MIME-Version: 1.0 In-Reply-To: <20151030165822.GD478@tucnak.redhat.com> Content-Type: multipart/mixed; boundary="------------000106030707040009090501" X-SW-Source: 2015-10/txt/msg03430.txt.bz2 --------------000106030707040009090501 Content-Type: text/plain; charset="windows-1252" Content-Transfer-Encoding: 7bit Content-length: 579 On 10/30/2015 09:58 AM, Jakub Jelinek wrote: > What I meant not just the above changes, but also all changes that > replace where with &n->where and the like, so pretty much everything > except for the oacc_compatible_clauses removal and addition of > resolve_omp_duplicate_list. That is kind of unrelated change. Yeah, I was post the patch before I applied it anyway. Here's what I'm testing now. I just into some fallout with Andrew MacLeod's header file reduction patch when building offloading compilers. Seems like some files are not including context.h anymore. Cesar --------------000106030707040009090501 Content-Type: text/x-patch; name="gfc_warnings.diff" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="gfc_warnings.diff" Content-length: 15787 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 90f63cf..13e730f 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 6c78c97..197b6d6 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/gfortran.dg/gomp/intentin1.f90 b/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 index f2a2e98..8bd53aa 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 --------------000106030707040009090501--