OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Cesar Philippidis 2015-10-30 15:16:52 -07:00 committed by Cesar Philippidis
parent 2631d4eb87
commit 2ac33bca8a
5 changed files with 77 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View File

@ -1,3 +1,16 @@
2015-10-30 Cesar Philippidis <cesar@codesourcery.com>
* 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 <kargl@gcc.gnu.org>
PR fortran/51993

1
gcc/fortran/gfortran.h
View File

@ -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;

113
gcc/fortran/openmp.c
View File

@ -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);
}
}

4
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
2015-10-30 Cesar Philippidis <cesar@codesourcery.com>
* gfortran.dg/gomp/intentin1.f90: Adjust copyprivate warning.
2015-10-30 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/46588

4
gcc/testsuite/gfortran.dg/gomp/intentin1.f90
View File

@ -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