diff options
Diffstat (limited to 'gcc/fortran/openmp.c')
| -rw-r--r-- | gcc/fortran/openmp.c | 17 |
1 files changed, 14 insertions, 3 deletions
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 9c5c033..54981ef 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -779,6 +779,9 @@ resolve_omp_clauses (gfc_code *code) if (n->sym->attr.allocatable) gfc_error ("COPYIN clause object '%s' is ALLOCATABLE at %L", n->sym->name, &code->loc); + if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp) + gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components", + n->sym->name, &code->loc); } break; case OMP_LIST_COPYPRIVATE: @@ -790,6 +793,9 @@ resolve_omp_clauses (gfc_code *code) if (n->sym->attr.allocatable) gfc_error ("COPYPRIVATE clause object '%s' is ALLOCATABLE " "at %L", n->sym->name, &code->loc); + if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp) + gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components", + n->sym->name, &code->loc); } break; case OMP_LIST_SHARED: @@ -820,6 +826,11 @@ resolve_omp_clauses (gfc_code *code) if (n->sym->attr.allocatable) gfc_error ("%s clause object '%s' is ALLOCATABLE at %L", name, n->sym->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) + gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L", + name, n->sym->name, &code->loc); if (n->sym->attr.cray_pointer) gfc_error ("Cray pointer '%s' in %s clause at %L", n->sym->name, name, &code->loc); @@ -839,11 +850,11 @@ resolve_omp_clauses (gfc_code *code) case OMP_LIST_MULT: case OMP_LIST_SUB: if (!gfc_numeric_ts (&n->sym->ts)) - gfc_error ("%c REDUCTION variable '%s' is %s at %L", + gfc_error ("%c REDUCTION variable '%s' at %L must be of intrinsic type, got %s", list == OMP_LIST_PLUS ? '+' : list == OMP_LIST_MULT ? '*' : '-', - n->sym->name, gfc_typename (&n->sym->ts), - &code->loc); + n->sym->name, &code->loc, + gfc_typename (&n->sym->ts)); break; case OMP_LIST_AND: case OMP_LIST_OR: |