/* OpenMP directive matching and resolving.
- Copyright (C) 2005, 2006, 2007, 2008
+ Copyright (C) 2005, 2006, 2007, 2008, 2010
Free Software Foundation, Inc.
Contributed by Jakub Jelinek
#include "match.h"
#include "parse.h"
#include "pointer-set.h"
-#include "target.h"
-#include "toplev.h"
/* Match an end of OpenMP directive. End of OpenMP directive is optional
whitespace, followed by '\n' or comment '!'. */
const char *p = gfc_extract_int (cexpr, &collapse);
if (p)
{
- gfc_error (p);
+ gfc_error_now (p);
collapse = 1;
}
else if (collapse <= 0)
{
- gfc_error ("COLLAPSE clause argument not constant positive integer at %C");
+ gfc_error_now ("COLLAPSE clause argument not"
+ " constant positive integer at %C");
collapse = 1;
}
c->collapse = collapse;
gfc_match_omp_taskwait (void)
{
if (gfc_match_omp_eos () != MATCH_YES)
- return MATCH_ERROR;
+ {
+ gfc_error ("Unexpected junk after TASKWAIT clause at %C");
+ return MATCH_ERROR;
+ }
new_st.op = EXEC_OMP_TASKWAIT;
new_st.ext.omp_clauses = NULL;
return MATCH_YES;
if (gfc_match (" ( %n )", n) != MATCH_YES)
n[0] = '\0';
if (gfc_match_omp_eos () != MATCH_YES)
- return MATCH_ERROR;
+ {
+ gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C");
+ return MATCH_ERROR;
+ }
new_st.op = EXEC_OMP_CRITICAL;
new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL;
return MATCH_YES;
gfc_match_omp_variable_list (" (", &list, true);
if (gfc_match_omp_eos () != MATCH_YES)
{
+ gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
gfc_free_namelist (list);
return MATCH_ERROR;
}
gfc_match_omp_workshare (void)
{
if (gfc_match_omp_eos () != MATCH_YES)
- return MATCH_ERROR;
+ {
+ gfc_error ("Unexpected junk after $OMP WORKSHARE statement at %C");
+ return MATCH_ERROR;
+ }
new_st.op = EXEC_OMP_WORKSHARE;
new_st.ext.omp_clauses = gfc_get_omp_clauses ();
return MATCH_YES;
gfc_match_omp_master (void)
{
if (gfc_match_omp_eos () != MATCH_YES)
- return MATCH_ERROR;
+ {
+ gfc_error ("Unexpected junk after $OMP MASTER statement at %C");
+ return MATCH_ERROR;
+ }
new_st.op = EXEC_OMP_MASTER;
new_st.ext.omp_clauses = NULL;
return MATCH_YES;
gfc_match_omp_ordered (void)
{
if (gfc_match_omp_eos () != MATCH_YES)
- return MATCH_ERROR;
+ {
+ gfc_error ("Unexpected junk after $OMP ORDERED statement at %C");
+ return MATCH_ERROR;
+ }
new_st.op = EXEC_OMP_ORDERED;
new_st.ext.omp_clauses = NULL;
return MATCH_YES;
gfc_match_omp_atomic (void)
{
if (gfc_match_omp_eos () != MATCH_YES)
- return MATCH_ERROR;
+ {
+ gfc_error ("Unexpected junk after $OMP ATOMIC statement at %C");
+ return MATCH_ERROR;
+ }
new_st.op = EXEC_OMP_ATOMIC;
new_st.ext.omp_clauses = NULL;
return MATCH_YES;
gfc_match_omp_barrier (void)
{
if (gfc_match_omp_eos () != MATCH_YES)
- return MATCH_ERROR;
+ {
+ gfc_error ("Unexpected junk after $OMP BARRIER statement at %C");
+ return MATCH_ERROR;
+ }
new_st.op = EXEC_OMP_BARRIER;
new_st.ext.omp_clauses = NULL;
return MATCH_YES;
if (gfc_match ("% nowait") == MATCH_YES)
nowait = true;
if (gfc_match_omp_eos () != MATCH_YES)
- return MATCH_ERROR;
+ {
+ gfc_error ("Unexpected junk after NOWAIT clause at %C");
+ return MATCH_ERROR;
+ }
new_st.op = EXEC_OMP_END_NOWAIT;
new_st.ext.omp_bool = nowait;
return MATCH_YES;
if (el)
continue;
}
+ if (n->sym->attr.proc_pointer)
+ continue;
}
gfc_error ("Object '%s' is not a variable at %L", n->sym->name,
&code->loc);
for (list = 0; list < OMP_LIST_NUM; list++)
if (list != OMP_LIST_FIRSTPRIVATE && list != OMP_LIST_LASTPRIVATE)
for (n = omp_clauses->lists[list]; n; n = n->next)
- if (n->sym->mark)
- gfc_error ("Symbol '%s' present on multiple clauses at %L",
- n->sym->name, &code->loc);
- else
- n->sym->mark = 1;
+ {
+ if (n->sym->mark)
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ n->sym->name, &code->loc);
+ else
+ n->sym->mark = 1;
+ }
gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1);
for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++)
}
for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next)
- if (n->sym->mark)
- gfc_error ("Symbol '%s' present on multiple clauses at %L",
- n->sym->name, &code->loc);
- else
- n->sym->mark = 1;
-
+ {
+ if (n->sym->mark)
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ n->sym->name, &code->loc);
+ else
+ n->sym->mark = 1;
+ }
for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
n->sym->mark = 0;
for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
- if (n->sym->mark)
- gfc_error ("Symbol '%s' present on multiple clauses at %L",
- n->sym->name, &code->loc);
- else
- n->sym->mark = 1;
-
+ {
+ if (n->sym->mark)
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ n->sym->name, &code->loc);
+ else
+ n->sym->mark = 1;
+ }
for (list = 0; list < OMP_LIST_NUM; list++)
if ((n = omp_clauses->lists[list]) != NULL)
{
if (!n->sym->attr.threadprivate)
gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause"
" at %L", n->sym->name, &code->loc);
- if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+ if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components",
n->sym->name, &code->loc);
}
if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
gfc_error ("Assumed size array '%s' in COPYPRIVATE clause "
"at %L", n->sym->name, &code->loc);
- if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+ if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components",
n->sym->name, &code->loc);
}
n->sym->name, name, &code->loc);
/* Variables in REDUCTION-clauses must be of intrinsic type (flagged below). */
if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) &&
- n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+ n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L",
name, n->sym->name, &code->loc);
if (n->sym->attr.cray_pointer)
void
gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
{
- struct omp_context *ctx;
int i = omp_current_do_collapse;
gfc_code *c = omp_current_do_code;
c = c->block->next;
}
- for (ctx = omp_current_ctx; ctx; ctx = ctx->previous)
- {
- if (pointer_set_contains (ctx->sharing_clauses, sym))
- continue;
+ if (omp_current_ctx == NULL)
+ return;
- if (! pointer_set_insert (ctx->private_iterators, sym))
- {
- gfc_omp_clauses *omp_clauses = ctx->code->ext.omp_clauses;
- gfc_namelist *p;
+ if (pointer_set_contains (omp_current_ctx->sharing_clauses, sym))
+ return;
- p = gfc_get_namelist ();
- p->sym = sym;
- p->next = omp_clauses->lists[OMP_LIST_PRIVATE];
- omp_clauses->lists[OMP_LIST_PRIVATE] = p;
- }
+ if (! pointer_set_insert (omp_current_ctx->private_iterators, sym))
+ {
+ gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses;
+ gfc_namelist *p;
+
+ p = gfc_get_namelist ();
+ p->sym = sym;
+ p->next = omp_clauses->lists[OMP_LIST_PRIVATE];
+ omp_clauses->lists[OMP_LIST_PRIVATE] = p;
}
}
break;
}
do_code = do_code->next;
- if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)
+ if (do_code == NULL
+ || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE))
{
gfc_error ("not enough DO loops for collapsed !$OMP DO at %L",
&code->loc);
OSDN Git Service
