This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[gomp] Assorted Fortran fixes and incomplete Cray pointer handling
- From: Jakub Jelinek <jakub at redhat dot com>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Wed, 26 Oct 2005 11:25:35 -0400
- Subject: [gomp] Assorted Fortran fixes and incomplete Cray pointer handling
- Reply-to: Jakub Jelinek <jakub at redhat dot com>
Hi!
Sorry for sending 3 changes in one patch, but I have committed all
3 changes together.
1) Initial OpenMP Cray pointer stuff - simple tests work, but their
remapping isn't right ATM. What should happen is that a Cray pointee when
seen in an omp construct is immediately gimplified into it's
DECL_VALUE_EXPR, plus predetermined private so that default (none) doesn't
warn and default (shared) doesn't make it shared. This could be done
already via the lang_hooks.decls.omp_predetermined_sharing langhook,
except that we don't mark pointees any special way at the tree level.
Even if we find a bit for it, the question is how to arrange for it to
be copied over in omp_copy_decl*, so that it works even in nested contexts.
The immediate gimplification goes against the need not to gimplify
COMMON/EQUIVALENCE refs, so I guess a langhook will be really needed for
that. Another thing that should be done is to arrange for DECL_VALUE_EXPR
being set on the private Cray pointee var, which will be dereference
of the remapped Cray pointer (so that debugging works).
2) diagnostics for user defined non-ELEMENTAL functions in
WORKSHARE/PARALLEL WORKSHARE
3) addition of quotes around symbol var names (and adjustements of testcases
that cared about that)
2005-10-26 Jakub Jelinek <jakub@redhat.com>
fortran/
* symbol.c (check_conflict): Add conflict between cray_pointee and
threadprivate.
* openmp.c (gfc_match_omp_threadprivate): Fail if
gfc_add_threadprivate returned FAILURE.
(resolve_omp_clauses): Diagnose Cray pointees in SHARED,
{,FIRST,LAST}PRIVATE and REDUCTION clauses and Cray pointers in
{FIRST,LAST}PRIVATE and REDUCTION clauses.
testsuite/
* gfortran.dg/gomp/crayptr1.f90: New test.
* gfortran.dg/gomp/crayptr2.f90: New test.
* gfortran.dg/gomp/crayptr3.f90: New test.
libgomp/
* testsuite/libgomp.fortran/crayptr1.f90: New test.
fortran/
* resolve.c (omp_workshare_flag): New variable.
(resolve_function): Diagnose use of non-ELEMENTAL user defined
function in WORKSHARE construct.
(resolve_code): Cleanup forall_save use. Make sure omp_workshare_flag
is set to correct value in different contexts.
testsuite/
* gfortran.dg/gomp/workshare1.f90: New test.
libgomp/
* testsuite/libgomp.fortran/workshare1.f90: New test.
fortran/
* openmp.c (resolve_omp_clauses): Replace %s with '%s' when printing
variable name.
(resolve_omp_atomic): Likewise.
testsuite/
* gfortran.dg/gomp/appendix-a/a.23.4.f90: Adjust for addition of
quotes around variable names in error messages.
* gfortran.dg/gomp/appendix-a/a.23.5.f90: Likewise.
* gfortran.dg/gomp/appendix-a/a.33.4.f90: Likewise.
* gfortran.dg/gomp/omp_atomic.f90: Likewise.
* gfortran.dg/gomp/omp_clauses1.f90: Likewise.
libgomp/
* libgomp.fortran/appendix-a/a.28.5.f90: Change into compile
only test.
* libgomp.fortran/sharing1.f90: New test.
--- gcc/fortran/symbol.c.jj 2005-10-25 22:36:10.000000000 +0200
+++ gcc/fortran/symbol.c 2005-10-26 16:10:55.000000000 +0200
@@ -373,6 +373,7 @@ check_conflict (symbol_attribute * attr,
conf (cray_pointee, entry);
conf (cray_pointee, in_common);
conf (cray_pointee, in_equivalence);
+ conf (cray_pointee, threadprivate);
a1 = gfc_code2string (flavors, attr->flavor);
--- gcc/fortran/openmp.c.jj 2005-10-19 18:53:21.000000000 +0200
+++ gcc/fortran/openmp.c 2005-10-26 16:50:12.000000000 +0200
@@ -438,8 +438,9 @@ gfc_match_omp_threadprivate (void)
if (sym->attr.in_common)
gfc_error_now ("Threadprivate variable at %C is an element of"
" a COMMON block");
- else
- gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at);
+ else if (gfc_add_threadprivate (&sym->attr, sym->name,
+ &sym->declared_at) == FAILURE)
+ goto cleanup;
goto next_item;
case MATCH_NO:
break;
@@ -461,7 +462,9 @@ gfc_match_omp_threadprivate (void)
}
st->n.common->threadprivate = 1;
for (sym = st->n.common->head; sym; sym = sym->common_next)
- gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at);
+ if (gfc_add_threadprivate (&sym->attr, sym->name,
+ &sym->declared_at) == FAILURE)
+ goto cleanup;
next_item:
if (gfc_match_char (')') == MATCH_YES)
@@ -668,7 +671,7 @@ resolve_omp_clauses (gfc_code *code)
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",
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
n->sym->name, &code->loc);
else
n->sym->mark = 1;
@@ -678,14 +681,14 @@ resolve_omp_clauses (gfc_code *code)
for (n = omp_clauses->lists[list]; n; n = n->next)
if (n->sym->mark)
{
- gfc_error ("Symbol %s present on multiple clauses at %L",
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
n->sym->name, &code->loc);
n->sym->mark = 0;
}
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",
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
n->sym->name, &code->loc);
else
n->sym->mark = 1;
@@ -695,7 +698,7 @@ resolve_omp_clauses (gfc_code *code)
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",
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
n->sym->name, &code->loc);
else
n->sym->mark = 1;
@@ -718,10 +721,10 @@ resolve_omp_clauses (gfc_code *code)
for (; n != NULL; n = n->next)
{
if (!n->sym->attr.threadprivate)
- gfc_error ("Non-THREADPRIVATE object %s in COPYIN clause"
+ gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause"
" at %L", n->sym->name, &code->loc);
if (n->sym->attr.allocatable)
- gfc_error ("COPYIN clause object %s is ALLOCATABLE at %L",
+ gfc_error ("COPYIN clause object '%s' is ALLOCATABLE at %L",
n->sym->name, &code->loc);
}
break;
@@ -729,41 +732,52 @@ resolve_omp_clauses (gfc_code *code)
for (; n != NULL; n = n->next)
{
if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
- gfc_error ("Assumed size array %s in COPYPRIVATE clause"
+ gfc_error ("Assumed size array '%s' in COPYPRIVATE clause"
" at %L", n->sym->name, &code->loc);
if (n->sym->attr.allocatable)
- gfc_error ("COPYPRIVATE clause object %s is ALLOCATABLE"
+ gfc_error ("COPYPRIVATE clause object '%s' is ALLOCATABLE"
" at %L", n->sym->name, &code->loc);
}
break;
case OMP_LIST_SHARED:
for (; n != NULL; n = n->next)
- if (n->sym->attr.threadprivate)
- gfc_error ("THREADPRIVATE object %s in SHARED clause at %L",
- n->sym->name, &code->loc);
+ {
+ if (n->sym->attr.threadprivate)
+ gfc_error ("THREADPRIVATE object '%s' in SHARED clause at",
+ " %L", n->sym->name, &code->loc);
+ if (n->sym->attr.cray_pointee)
+ gfc_error ("Cray pointee '%s' in SHARED clause at %L",
+ n->sym->name, &code->loc);
+ }
break;
default:
for (; n != NULL; n = n->next)
{
if (n->sym->attr.threadprivate)
- gfc_error ("THREADPRIVATE object %s in %s clause at %L",
+ gfc_error ("THREADPRIVATE object '%s' in %s clause at %L",
n->sym->name, name, &code->loc);
+ if (n->sym->attr.cray_pointee)
+ gfc_error ("Cray pointee '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
if (list != OMP_LIST_PRIVATE)
{
if (n->sym->attr.pointer)
- gfc_error ("POINTER object %s in %s clause at %L",
+ gfc_error ("POINTER object '%s' in %s clause at %L",
n->sym->name, name, &code->loc);
if (n->sym->attr.allocatable)
- gfc_error ("%s clause object %s is ALLOCATABLE at %L",
+ gfc_error ("%s clause object '%s' is ALLOCATABLE 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);
}
if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
- gfc_error ("Assumed size array %s in %s clause at %L",
+ gfc_error ("Assumed size array '%s' in %s clause at %L",
n->sym->name, name, &code->loc);
if (n->sym->attr.in_namelist
&& (list < OMP_LIST_REDUCTION_FIRST
|| list > OMP_LIST_REDUCTION_LAST))
- gfc_error ("Variable %s in %s clause is used in"
+ gfc_error ("Variable '%s' in %s clause is used in"
" NAMELIST statement at %L",
n->sym->name, name, &code->loc);
switch (list)
@@ -772,7 +786,7 @@ 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' is %s at %L",
list == OMP_LIST_PLUS ? '+'
: list == OMP_LIST_MULT ? '*' : '-',
n->sym->name, gfc_typename (&n->sym->ts),
@@ -783,7 +797,7 @@ resolve_omp_clauses (gfc_code *code)
case OMP_LIST_EQV:
case OMP_LIST_NEQV:
if (n->sym->ts.type != BT_LOGICAL)
- gfc_error ("%s REDUCTION variable %s must be LOGICAL"
+ gfc_error ("%s REDUCTION variable '%s' must be LOGICAL"
" at %L",
list == OMP_LIST_AND ? ".AND."
: list == OMP_LIST_OR ? ".OR."
@@ -794,7 +808,7 @@ resolve_omp_clauses (gfc_code *code)
case OMP_LIST_MIN:
if (n->sym->ts.type != BT_INTEGER
&& n->sym->ts.type != BT_REAL)
- gfc_error ("%s REDUCTION variable %s must be"
+ gfc_error ("%s REDUCTION variable '%s' must be"
" INTEGER or REAL at %L",
list == OMP_LIST_MAX ? "MAX" : "MIN",
n->sym->name, &code->loc);
@@ -803,7 +817,7 @@ resolve_omp_clauses (gfc_code *code)
case OMP_LIST_IOR:
case OMP_LIST_IEOR:
if (n->sym->ts.type != BT_INTEGER)
- gfc_error ("%s REDUCTION variable %s must be INTEGER"
+ gfc_error ("%s REDUCTION variable '%s' must be INTEGER"
" at %L",
list == OMP_LIST_IAND ? "IAND"
: list == OMP_LIST_MULT ? "IOR" : "IEOR",
@@ -1090,7 +1104,7 @@ resolve_omp_atomic (gfc_code *code)
var_arg = arg;
else if (expr_references_sym (arg->expr, var, NULL))
gfc_error ("!$OMP ATOMIC intrinsic arguments except one must not"
- " reference %s at %L", var->name, &arg->expr->where);
+ " reference '%s' at %L", var->name, &arg->expr->where);
if (arg->expr->rank != 0)
gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar"
" at %L", &arg->expr->where);
@@ -1099,7 +1113,7 @@ resolve_omp_atomic (gfc_code *code)
if (var_arg == NULL)
{
gfc_error ("First or last !$OMP ATOMIC intrinsic argument must"
- " be %s at %L", var->name, &expr2->where);
+ " be '%s' at %L", var->name, &expr2->where);
return;
}
--- gcc/fortran/resolve.c.jj 2005-10-25 22:36:10.000000000 +0200
+++ gcc/fortran/resolve.c 2005-10-26 14:43:28.000000000 +0200
@@ -46,10 +46,14 @@ code_stack;
static code_stack *cs_base = NULL;
-/* Nonzero if we're inside a FORALL block */
+/* Nonzero if we're inside a FORALL block. */
static int forall_flag;
+/* Nonzero if we're inside a OpenMP WORKSHARE or PARALLEL WORKSHARE block. */
+
+static int omp_workshare_flag;
+
/* Nonzero if we are processing a formal arglist. The corresponding function
resets the flag each time that it is read. */
static int formal_arg_flag = 0;
@@ -1120,6 +1124,16 @@ resolve_function (gfc_expr * expr)
}
}
+ if (omp_workshare_flag
+ && expr->value.function.esym
+ && ! gfc_elemental (expr->value.function.esym))
+ {
+ gfc_error ("User defined non-ELEMENTAL function '%s' at %L not allowed"
+ " in WORKSHARE construct", expr->value.function.esym->name,
+ &expr->where);
+ t = FAILURE;
+ }
+
if (!pure_function (expr, &name))
{
if (forall_flag)
@@ -3911,7 +3925,7 @@ gfc_resolve_blocks (gfc_code * b, gfc_na
static void
resolve_code (gfc_code * code, gfc_namespace * ns)
{
- int forall_save = 0;
+ int omp_workshare_save;
code_stack frame;
gfc_alloc *a;
try t;
@@ -3926,28 +3940,41 @@ resolve_code (gfc_code * code, gfc_names
if (code->op == EXEC_FORALL)
{
- forall_save = forall_flag;
+ int forall_save = forall_flag;
+
forall_flag = 1;
- gfc_resolve_forall (code, ns, forall_save);
- }
+ gfc_resolve_forall (code, ns, forall_save);
+ forall_flag = forall_save;
+ }
else if (code->block)
{
+ omp_workshare_save = -1;
switch (code->op)
{
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ omp_workshare_save = omp_workshare_flag;
+ omp_workshare_flag = 1;
+ gfc_resolve_omp_parallel_blocks (code, ns);
+ break;
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_SECTIONS:
- case EXEC_OMP_PARALLEL_WORKSHARE:
+ omp_workshare_save = omp_workshare_flag;
+ omp_workshare_flag = 0;
gfc_resolve_omp_parallel_blocks (code, ns);
break;
+ case EXEC_OMP_WORKSHARE:
+ omp_workshare_save = omp_workshare_flag;
+ omp_workshare_flag = 1;
+ /* FALLTHROUGH */
default:
gfc_resolve_blocks (code->block, ns);
break;
}
- }
- if (code->op == EXEC_FORALL)
- forall_flag = forall_save;
+ if (omp_workshare_save != -1)
+ omp_workshare_flag = omp_workshare_save;
+ }
t = gfc_resolve_expr (code->expr);
if (gfc_resolve_expr (code->expr2) == FAILURE)
@@ -4184,14 +4211,20 @@ resolve_code (gfc_code * code, gfc_names
case EXEC_OMP_DO:
case EXEC_OMP_MASTER:
case EXEC_OMP_ORDERED:
+ case EXEC_OMP_SECTIONS:
+ case EXEC_OMP_SINGLE:
+ case EXEC_OMP_WORKSHARE:
+ gfc_resolve_omp_directive (code, ns);
+ break;
+
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
- case EXEC_OMP_SECTIONS:
- case EXEC_OMP_SINGLE:
- case EXEC_OMP_WORKSHARE:
+ omp_workshare_save = omp_workshare_flag;
+ omp_workshare_flag = 0;
gfc_resolve_omp_directive (code, ns);
+ omp_workshare_flag = omp_workshare_save;
break;
default:
--- gcc/testsuite/gfortran.dg/gomp/workshare1.f90.jj 2005-10-26 14:18:47.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/workshare1.f90 2005-10-26 15:02:48.000000000 +0200
@@ -0,0 +1,42 @@
+! { dg-do compile }
+
+interface
+ subroutine foo
+ end subroutine
+ function bar ()
+ integer :: bar
+ end function bar
+ elemental function baz ()
+ integer :: baz
+ end function baz
+end interface
+
+ integer :: i, j
+ real :: a, b (10), c
+ a = 0.5
+ b = 0.25
+!$omp parallel workshare
+ a = sin (a)
+ b = sin (b)
+ forall (i = 1:10) b(i) = cos (b(i)) - 0.5
+ j = baz ()
+!$omp parallel if (bar () .gt. 2) &
+!$omp & num_threads (bar () + 1)
+ i = bar ()
+!$omp end parallel
+!$omp parallel do schedule (static, bar () + 4)
+ do j = 1, 10
+ i = bar ()
+ end do
+!$omp end parallel do
+!$omp end parallel workshare
+!$omp parallel workshare
+ call foo ! { dg-error "CALL statement" }
+ i = bar () ! { dg-error "non-ELEMENTAL" }
+!$omp critical
+ i = bar () ! { dg-error "non-ELEMENTAL" }
+!$omp end critical
+!$omp atomic
+ j = j + bar () ! { dg-error "non-ELEMENTAL" }
+!$omp end parallel workshare
+end
--- gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.5.f90.jj 2005-10-18 01:10:59.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.5.f90 2005-10-26 10:13:24.000000000 +0200
@@ -5,8 +5,8 @@
! Incorrect: common block C cannot be declared both
! shared and private
!$OMP PARALLEL PRIVATE (/C/), SHARED(/C/)
- ! { dg-error "Symbol y present" "" { target *-*-* } 7 }
- ! { dg-error "Symbol x present" "" { target *-*-* } 7 }
+ ! { dg-error "Symbol 'y' present" "" { target *-*-* } 7 }
+ ! { dg-error "Symbol 'x' present" "" { target *-*-* } 7 }
! do work here
!$OMP END PARALLEL
END SUBROUTINE A23_5_WRONG
--- gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.4.f90.jj 2005-10-18 01:10:59.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.4.f90 2005-10-26 10:14:01.000000000 +0200
@@ -4,7 +4,7 @@
REAL, DIMENSION(:), ALLOCATABLE :: A
REAL, DIMENSION(:), POINTER :: B
ALLOCATE (A(N))
-!$OMP SINGLE ! { dg-error "COPYPRIVATE clause object a" }
+!$OMP SINGLE ! { dg-error "COPYPRIVATE clause object 'a'" }
ALLOCATE (B(N))
READ (11) A,B
!$OMP END SINGLE COPYPRIVATE(A,B)
--- gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.4.f90.jj 2005-10-18 01:10:59.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.4.f90 2005-10-26 10:13:07.000000000 +0200
@@ -3,7 +3,7 @@
SUBROUTINE A23_4_WRONG()
COMMON /C/ X,Y
! Incorrect because X is a constituent element of C
-!$OMP PARALLEL PRIVATE(/C/), SHARED(X) ! { dg-error "Symbol x present" }
+!$OMP PARALLEL PRIVATE(/C/), SHARED(X) ! { dg-error "Symbol 'x' present" }
! do work here
!$OMP END PARALLEL
END SUBROUTINE A23_4_WRONG
--- gcc/testsuite/gfortran.dg/gomp/omp_atomic1.f90.jj 2005-09-22 18:20:15.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/omp_atomic1.f90 2005-10-26 10:14:23.000000000 +0200
@@ -32,7 +32,7 @@ subroutine test_atomic
!$omp atomic
c = min (c, 2.1, c) ! { dg-error "intrinsic arguments except one" }
!$omp atomic
- a = max (b, e(1)) ! { dg-error "intrinsic argument must be a" }
+ a = max (b, e(1)) ! { dg-error "intrinsic argument must be 'a'" }
!$omp atomic
d = 12 ! { dg-error "assignment must have an operator" }
end subroutine test_atomic
--- gcc/testsuite/gfortran.dg/gomp/crayptr1.f90.jj 2005-10-26 15:40:22.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/crayptr1.f90 2005-10-26 16:11:50.000000000 +0200
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+ integer :: a, b, c, d, i
+ pointer (ip1, a)
+ pointer (ip2, b)
+ pointer (ip3, c)
+ pointer (ip4, d)
+
+!$omp parallel shared (a) ! { dg-error "Cray pointee 'a' in SHARED clause" }
+!$omp end parallel
+
+!$omp parallel private (b) ! { dg-error "Cray pointee 'b' in PRIVATE clause" }
+!$omp end parallel
+
+!$omp parallel firstprivate (c) ! { dg-error "Cray pointee 'c' in FIRSTPRIVATE clause" }
+!$omp end parallel
+
+!$omp parallel do lastprivate (d) ! { dg-error "Cray pointee 'd' in LASTPRIVATE clause" }
+ do i = 1, 10
+ if (i .eq. 10) d = 1
+ end do
+!$omp end parallel do
+
+!$omp parallel reduction (+: a) ! { dg-error "Cray pointee 'a' in REDUCTION clause" }
+!$omp end parallel
+
+ ip1 = loc (i)
+!$omp parallel shared (ip1)
+ a = 2
+!$omp end parallel
+
+!$omp parallel private (ip2, i)
+ ip2 = loc (i)
+ b = 1
+!$omp end parallel
+
+ ip3 = loc (i)
+!$omp parallel firstprivate (ip3) ! { dg-error "Cray pointer 'ip3' in FIRSTPRIVATE clause" }
+!$omp end parallel
+
+!$omp parallel do lastprivate (ip4) ! { dg-error "Cray pointer 'ip4' in LASTPRIVATE clause" }
+ do i = 1, 10
+ if (i .eq. 10) ip4 = loc (i)
+ end do
+!$omp end parallel do
+
+!$omp parallel reduction (+: ip1) ! { dg-error "Cray pointer 'ip1' in REDUCTION clause" }
+!$omp end parallel
+
+end
--- gcc/testsuite/gfortran.dg/gomp/crayptr3.f90.jj 2005-10-26 16:25:40.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/crayptr3.f90 2005-10-26 16:27:55.000000000 +0200
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+ integer :: a, b
+ pointer (ip, a)
+
+ b = 2
+ ip = loc (b)
+!$omp parallel default (none) shared (ip)
+ a = 1
+!$omp end parallel
+
+!$omp parallel default (none) private (ip, b)
+ b = 3
+ ip = loc (b)
+ a = 1
+!$omp end parallel
+
+!$omp parallel default (none) ! { dg-error "enclosing parallel" }
+ a = 1 ! { dg-error "'ip' not specified in enclosing parallel" }
+!$omp end parallel
+end
--- gcc/testsuite/gfortran.dg/gomp/omp_clauses1.f90.jj 2005-09-27 16:04:47.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/omp_clauses1.f90 2005-10-26 10:15:01.000000000 +0200
@@ -8,17 +8,17 @@
do l = 1, 10
end do
!$omp end parallel do
-!$omp parallel shared (j) private (/b/) ! { dg-error "j present on multiple clauses" }
+!$omp parallel shared (j) private (/b/) ! { dg-error "'j' present on multiple clauses" }
!$omp end parallel
-!$omp parallel shared (j, j) private (i) ! { dg-error "j present on multiple clauses" }
+!$omp parallel shared (j, j) private (i) ! { dg-error "'j' present on multiple clauses" }
!$omp end parallel
-!$omp parallel firstprivate (i, j, i) ! { dg-error "i present on multiple clauses" }
+!$omp parallel firstprivate (i, j, i) ! { dg-error "'i' present on multiple clauses" }
!$omp end parallel
-!$omp parallel shared (i) private (/b/, /b/) ! { dg-error "\[jk\] present on multiple clauses" }
+!$omp parallel shared (i) private (/b/, /b/) ! { dg-error "'\[jk\]' present on multiple clauses" }
!$omp end parallel
-!$omp parallel shared (i) reduction (+ : i, j) ! { dg-error "i present on multiple clauses" }
+!$omp parallel shared (i) reduction (+ : i, j) ! { dg-error "'i' present on multiple clauses" }
!$omp end parallel
-!$omp parallel do shared (/b/), firstprivate (/b/), lastprivate (i) ! { dg-error "\[jk\] present on multiple clauses" }
+!$omp parallel do shared (/b/), firstprivate (/b/), lastprivate (i) ! { dg-error "'\[jk\]' present on multiple clauses" }
do l = 1, 10
end do
!$omp end parallel do
--- gcc/testsuite/gfortran.dg/gomp/crayptr2.f90.jj 2005-10-26 16:11:54.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/crayptr2.f90 2005-10-26 16:13:17.000000000 +0200
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+module crayptr2
+ integer :: e ! { dg-error "CRAY POINTEE attribute conflicts with THREADPRIVATE" }
+ pointer (ip5, e)
+
+! The standard is not very clear about this.
+! Certainly, Cray pointees can't be SAVEd, nor they can be
+! in COMMON, so the only way to make threadprivate Cray pointees would
+! be if they are module variables. But threadprivate pointees don't
+! make any sense anyway.
+
+!$omp threadprivate (e)
+
+end module crayptr2
--- libgomp/testsuite/libgomp.fortran/workshare1.f90.jj 2005-10-26 15:17:40.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/workshare1.f90 2005-10-26 15:22:06.000000000 +0200
@@ -0,0 +1,30 @@
+function foo ()
+ integer :: foo
+ logical :: foo_seen
+ common /foo_seen/ foo_seen
+ foo_seen = .true.
+ foo = 3
+end
+function bar ()
+ integer :: bar
+ logical :: bar_seen
+ common /bar_seen/ bar_seen
+ bar_seen = .true.
+ bar = 3
+end
+ integer :: a (10), b (10), foo, bar
+ logical :: foo_seen, bar_seen
+ common /foo_seen/ foo_seen
+ common /bar_seen/ bar_seen
+
+ foo_seen = .false.
+ bar_seen = .false.
+!$omp parallel workshare if (foo () .gt. 2) num_threads (bar () + 1)
+ a = 10
+ b = 20
+ a(1:5) = max (a(1:5), b(1:5))
+!$omp end parallel workshare
+ if (any (a(1:5) .ne. 20)) call abort
+ if (any (a(6:10) .ne. 10)) call abort
+ if (.not. foo_seen .or. .not. bar_seen) call abort
+end
--- libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90.jj 2005-10-18 01:10:59.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90 2005-10-24 12:01:33.000000000 +0200
@@ -1,4 +1,4 @@
-! { dg-do run }
+! { dg-do compile }
SUBROUTINE SUB1(X)
DIMENSION X(10)
--- libgomp/testsuite/libgomp.fortran/crayptr1.f90.jj 2005-10-26 16:45:08.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/crayptr1.f90 2005-10-26 16:45:49.000000000 +0200
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+ use omp_lib
+ integer :: a, b, c, p
+ logical :: l
+ pointer (ip, p)
+ a = 1
+ b = 2
+ c = 3
+ l = .false.
+ ip = loc (a)
+
+!$omp parallel num_threads (2) reduction (.or.:l)
+ l = p .ne. 1
+!$omp barrier
+!$omp master
+ ip = loc (b)
+!$omp end master
+!$omp barrier
+ l = l .or. p .ne. 2
+!$omp barrier
+ if (omp_get_thread_num () .eq. 1 .or. omp_get_num_threads () .lt. 2) &
+ ip = loc (c)
+!$omp barrier
+ l = l .or. p .ne. 3
+!$omp end parallel
+
+ if (l) call abort
+
+ l = .false.
+!$omp parallel num_threads (2) reduction (.or.:l) default (private)
+ ip = loc (a)
+ a = 3 * omp_get_thread_num () + 4
+ b = a + 1
+ c = a + 2
+ l = p .ne. 3 * omp_get_thread_num () + 4
+ ip = loc (c)
+ l = l .or. p .ne. 3 * omp_get_thread_num () + 6
+ ip = loc (b)
+ l = l .or. p .ne. 3 * omp_get_thread_num () + 5
+!$omp end parallel
+
+ if (l) call abort
+
+end
--- libgomp/testsuite/libgomp.fortran/sharing1.f90.jj 2005-10-24 11:31:31.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/sharing1.f90 2005-10-24 11:31:26.000000000 +0200
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+ use omp_lib
+ integer :: i, j, k
+ logical :: l
+ common /b/ i, j
+ i = 4
+ j = 8
+ l = .false.
+!$omp parallel private (k) firstprivate (i) shared (j) num_threads (2) &
+!$omp& reduction (.or.:l)
+ if (i .ne. 4 .or. j .ne. 8) l = .true.
+!$omp barrier
+ k = omp_get_thread_num ()
+ if (k .eq. 0) then
+ i = 14
+ j = 15
+ end if
+!$omp barrier
+ if (k .eq. 1) then
+ if (i .ne. 4 .or. j .ne. 15) l = .true.
+ i = 24
+ j = 25
+ end if
+!$omp barrier
+ if (j .ne. 25 .or. i .ne. (k * 10 + 14)) l = .true.
+!$omp end parallel
+ if (l .or. j .ne. 25) call abort
+end
Jakub