/* 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);
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)
gcc_assert (code->op == EXEC_ASSIGN);
gcc_assert (code->next == NULL);
- if (code->expr->expr_type != EXPR_VARIABLE
- || code->expr->symtree == NULL
- || code->expr->rank != 0
- || (code->expr->ts.type != BT_INTEGER
- && code->expr->ts.type != BT_REAL
- && code->expr->ts.type != BT_COMPLEX
- && code->expr->ts.type != BT_LOGICAL))
+ if (code->expr1->expr_type != EXPR_VARIABLE
+ || code->expr1->symtree == NULL
+ || code->expr1->rank != 0
+ || (code->expr1->ts.type != BT_INTEGER
+ && code->expr1->ts.type != BT_REAL
+ && code->expr1->ts.type != BT_COMPLEX
+ && code->expr1->ts.type != BT_LOGICAL))
{
gfc_error ("!$OMP ATOMIC statement must set a scalar variable of "
"intrinsic type at %L", &code->loc);
return;
}
- var = code->expr->symtree->n.sym;
+ var = code->expr1->symtree->n.sym;
expr2 = is_conversion (code->expr2, false);
if (expr2 == NULL)
expr2 = code->expr2;
if (expr2->expr_type == EXPR_OP)
{
gfc_expr *v = NULL, *e, *c;
- gfc_intrinsic_op op = expr2->value.op.operator;
+ gfc_intrinsic_op op = expr2->value.op.op;
gfc_intrinsic_op alt_op = INTRINSIC_NONE;
switch (op)
else if ((c = is_conversion (e, true)) != NULL)
q = &e->value.function.actual->expr;
else if (e->expr_type != EXPR_OP
- || (e->value.op.operator != op
- && e->value.op.operator != alt_op)
+ || (e->value.op.op != op
+ && e->value.op.op != alt_op)
|| e->rank != 0)
break;
else
if (p != NULL)
{
e = *p;
- switch (e->value.op.operator)
+ switch (e->value.op.op)
{
case INTRINSIC_MINUS:
case INTRINSIC_DIVIDE:
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;
}
}
void
gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
{
+ if (code->op != EXEC_OMP_ATOMIC)
+ gfc_maybe_initialize_eh ();
+
switch (code->op)
{
case EXEC_OMP_DO:
OSDN Git Service
