From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 89013 invoked by alias); 30 Oct 2015 17:07:46 -0000 Mailing-List: contact fortran-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Post: List-Help: , Sender: fortran-owner@gcc.gnu.org Received: (qmail 88992 invoked by uid 89); 30 Oct 2015 17:07:46 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.3 required=5.0 tests=AWL,BAYES_00,RP_MATCHES_RCVD,SPF_HELO_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mx1.redhat.com Received: from mx1.redhat.com (HELO mx1.redhat.com) (209.132.183.28) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Fri, 30 Oct 2015 17:07:42 +0000 Received: from int-mx10.intmail.prod.int.phx2.redhat.com (int-mx10.intmail.prod.int.phx2.redhat.com [10.5.11.23]) by mx1.redhat.com (Postfix) with ESMTPS id 47C9E356C0F; Fri, 30 Oct 2015 17:07:41 +0000 (UTC) Received: from tucnak.zalov.cz (ovpn-116-121.ams2.redhat.com [10.36.116.121]) by int-mx10.intmail.prod.int.phx2.redhat.com (8.14.4/8.14.4) with ESMTP id t9UH7dmo014518 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Fri, 30 Oct 2015 13:07:40 -0400 Received: from tucnak.zalov.cz (localhost [127.0.0.1]) by tucnak.zalov.cz (8.15.2/8.15.2) with ESMTP id t9UH7cCG023663; Fri, 30 Oct 2015 18:07:38 +0100 Received: (from jakub@localhost) by tucnak.zalov.cz (8.15.2/8.15.2/Submit) id t9UH7ba2023662; Fri, 30 Oct 2015 18:07:37 +0100 Date: Fri, 30 Oct 2015 17:07:00 -0000 From: Jakub Jelinek To: Cesar Philippidis Cc: Fortran List , "gcc-patches@gcc.gnu.org" Subject: Re: more accurate omp in fortran Message-ID: <20151030170737.GF478@tucnak.redhat.com> Reply-To: Jakub Jelinek References: <5628FEFF.50809@codesourcery.com> <20151030144727.GC478@tucnak.redhat.com> <56338674.3060608@codesourcery.com> <20151030165822.GD478@tucnak.redhat.com> <5633A2DB.5000402@codesourcery.com> MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline In-Reply-To: <5633A2DB.5000402@codesourcery.com> User-Agent: Mutt/1.5.23 (2014-03-12) X-SW-Source: 2015-10/txt/msg00185.txt.bz2 Hi! On Fri, Oct 30, 2015 at 10:03:23AM -0700, Cesar Philippidis wrote: This looks good to me, iff you write ChangeLog entry for it. > 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 Jakub