On 08.12.20 13:30, Jakub Jelinek wrote:
On Tue, Dec 08, 2020 at 01:13:07PM +0100, Tobias Burnus wrote:
+ if (list == OMP_LIST_REDUCTION)
+ has_inscan = true;
This looks weird, I would have expected
if (list == OMP_LIST_REDUCTION_INSCAN)
That's not only weird, that was plainly wrong. Now fixed and committed
as r11-5856-g005cff4e2ecbd5c4e2ef978fe4842fa3c8c79f47; follow-up fix for
reduction4.f90 committed as
r11-5876-g1cb2d1d5ce178cb68f0bd475299d2e0b25a4a756 loc);
you initially accept !$omp scan everywhere and only later complain if it
is misplaced? I think e.g. for !$omp section I used to hardcode it in
parse_omp_structured_block - allow it only there and nowhere else:
Hmm, also a good method; I am not sure which one is better – hence, I
did not rewrite this patch. But good to know for the future.
+ case EXEC_OMP_SCAN:
+ /* Flag is only used to checking, hence, it is unset afterwards. */
+ if (!code->ext.omp_clauses->if_present)
Isn't if_present used also for OpenACC? Then can't it with -fopenmp
-fopenacc allow
!$acc ... if_present...
!$omp scan inclusive(...)
!$add end ...
?
!$acc ends up in a different ST_OMP_/EXEC_OMP_; additionally, due to the
tight restrictions imposed by 'inscan'/'omp scan' adding something
inbetween is difficult. (It can be added in 'block ... end block' but it
still does not make much sense for 'omp scan' and it still ends up in a
different statement.)
Otherwise LGTM.
Thanks for the review.
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander
Walter
commit 1cb2d1d5ce178cb68f0bd475299d2e0b25a4a756
Author: Tobias Burnus <tob...@codesourcery.com>
Date: Wed Dec 9 10:42:49 2020 +0100
gfortran.dg/gomp/reduction4.f90: Fix testcase
Fix to 'omp scan' commit 005cff4e2ecbd5c4e2ef978fe4842fa3c8c79f47
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/reduction4.f90: Update scan-trees, add
lost testcase; move test with FE error to ...
* gfortran.dg/gomp/reduction5.f90: ... here.
---
gcc/testsuite/gfortran.dg/gomp/reduction4.f90 | 23 +++++++----------------
gcc/testsuite/gfortran.dg/gomp/reduction5.f90 | 14 ++++++++++++++
2 files changed, 21 insertions(+), 16 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction4.f90
index 812be323b2e..2e8aaa2d54c 100644
--- a/gcc/testsuite/gfortran.dg/gomp/reduction4.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction4.f90
@@ -28,11 +28,6 @@ do i=1,10
end do
!$omp end parallel
-!$omp parallel reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
-do i=1,10
- a = a + 1
-end do
-!$omp end parallel
! ------------ simd ------------
!$omp simd reduction(+:a)
@@ -45,6 +40,11 @@ do i=1,10
a = a + 1
end do
+!$omp simd reduction(task,+:a) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do' or 'sections'" }
+do i=1,10
+ a = a + 1
+end do
+
! ------------ do ------------
!$omp parallel
!$omp do reduction(+:a)
@@ -89,13 +89,6 @@ end do
!$omp end sections
!$omp end parallel
-!$omp parallel
-!$omp sections reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
- !$omp section
- a = a + 1
-!$omp end sections
-!$omp end parallel
-
! ------------ task ------------
!$omp task in_reduction(+:a)
a = a + 1
@@ -136,13 +129,11 @@ end
! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(\\\+:a\\)" 2 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(task,\\\+:a\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\n\r\]" 7 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\n\r\]" 6 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(\\\+:a\\)" 2 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(task,\\\+:a\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp section\[\n\r\]" 4 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp section\[\n\r\]" 3 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(\\\+:a\\)" 2 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(inscan,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(task,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(\\\+:a\\)" 2 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(task,\\\+:a\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
index bfb847e9933..032703d3b81 100644
--- a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
@@ -42,4 +42,18 @@ end do
a = a + 1
!$omp end teams
+!$omp parallel reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+do i=1,10
+ a = a + 1
+end do
+!$omp end parallel
+
+!$omp parallel
+!$omp sections reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+ !$omp section
+ a = a + 1
+!$omp end sections
+!$omp end parallel
+
+
end
commit 005cff4e2ecbd5c4e2ef978fe4842fa3c8c79f47
Author: Tobias Burnus <tob...@codesourcery.com>
Date: Tue Dec 8 16:49:46 2020 +0100
Fortran: Add 'omp scan' support of OpenMP 5.0
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_omp_clauses, show_omp_node,
show_code_node): Handle OMP SCAN.
* gfortran.h (enum gfc_statement): Add ST_OMP_SCAN.
(enum): Add OMP_LIST_SCAN_IN and OMP_LIST_SCAN_EX.
(enum gfc_exec_op): Add EXEC_OMP_SCAN.
* match.h (gfc_match_omp_scan): New prototype.
* openmp.c (gfc_match_omp_scan): New.
(gfc_match_omp_taskgroup): Cleanup.
(resolve_omp_clauses, gfc_resolve_omp_do_blocks,
omp_code_to_statement, gfc_resolve_omp_directive): Handle 'omp scan'.
* parse.c (decode_omp_directive, next_statement,
gfc_ascii_statement): Likewise.
* resolve.c (gfc_resolve_code): Handle EXEC_OMP_SCAN.
* st.c (gfc_free_statement): Likewise.
* trans-openmp.c (gfc_trans_omp_clauses, gfc_trans_omp_do,
gfc_split_omp_clauses): Handle 'omp scan'.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/scan-1.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/reduction4.f90: Update; move FE some tests to ...
* gfortran.dg/gomp/reduction6.f90: ... this new test and ...
* gfortran.dg/gomp/reduction7.f90: ... this new test.
* gfortran.dg/gomp/reduction5.f90: Add dg-error.
* gfortran.dg/gomp/scan-1.f90: New test.
* gfortran.dg/gomp/scan-2.f90: New test.
* gfortran.dg/gomp/scan-3.f90: New test.
* gfortran.dg/gomp/scan-4.f90: New test.
* gfortran.dg/gomp/scan-5.f90: New test.
* gfortran.dg/gomp/scan-6.f90: New test.
* gfortran.dg/gomp/scan-7.f90: New test.
---
gcc/fortran/dump-parse-tree.c | 7 +-
gcc/fortran/gfortran.h | 6 +-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 102 ++++++++++--
gcc/fortran/parse.c | 6 +-
gcc/fortran/resolve.c | 1 +
gcc/fortran/st.c | 1 +
gcc/fortran/trans-openmp.c | 40 ++++-
gcc/testsuite/gfortran.dg/gomp/reduction4.f90 | 25 +--
gcc/testsuite/gfortran.dg/gomp/reduction5.f90 | 8 +-
gcc/testsuite/gfortran.dg/gomp/reduction6.f90 | 18 +++
gcc/testsuite/gfortran.dg/gomp/reduction7.f90 | 9 ++
gcc/testsuite/gfortran.dg/gomp/scan-1.f90 | 213 ++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/gomp/scan-2.f90 | 21 +++
gcc/testsuite/gfortran.dg/gomp/scan-3.f90 | 21 +++
gcc/testsuite/gfortran.dg/gomp/scan-4.f90 | 22 +++
gcc/testsuite/gfortran.dg/gomp/scan-5.f90 | 18 +++
gcc/testsuite/gfortran.dg/gomp/scan-6.f90 | 16 ++
gcc/testsuite/gfortran.dg/gomp/scan-7.f90 | 60 ++++++++
libgomp/testsuite/libgomp.fortran/scan-1.f90 | 115 ++++++++++++++
20 files changed, 669 insertions(+), 41 deletions(-)
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 1012b11fb98..b3fa1785b14 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1600,6 +1600,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break;
case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break;
case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break;
+ case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break;
+ case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break;
default:
gcc_unreachable ();
}
@@ -1803,6 +1805,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
+ case EXEC_OMP_SCAN: name = "SCAN"; break;
case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
case EXEC_OMP_SIMD: name = "SIMD"; break;
case EXEC_OMP_SINGLE: name = "SINGLE"; break;
@@ -1873,6 +1876,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL_DO_SIMD:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_SCAN:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:
@@ -1933,7 +1937,7 @@ show_omp_node (int level, gfc_code *c)
if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE
|| c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA
|| c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
- || c->op == EXEC_OMP_TARGET_EXIT_DATA
+ || c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
|| (c->op == EXEC_OMP_ORDERED && c->block == NULL))
return;
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
@@ -3073,6 +3077,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL_DO_SIMD:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_SCAN:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6467985ea7f..41fed15919f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -261,7 +261,7 @@ enum gfc_statement
ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD,
ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA,
ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD,
- ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP,
+ ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN,
ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
@@ -1277,6 +1277,8 @@ enum
OMP_LIST_MAP,
OMP_LIST_TO,
OMP_LIST_FROM,
+ OMP_LIST_SCAN_IN,
+ OMP_LIST_SCAN_EX,
OMP_LIST_REDUCTION,
OMP_LIST_REDUCTION_INSCAN,
OMP_LIST_REDUCTION_TASK,
@@ -2697,7 +2699,7 @@ enum gfc_exec_op
EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA,
EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO,
EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD,
- EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD
+ EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN
};
typedef struct gfc_code
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 4ccb5961d2b..c771448c184 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -176,6 +176,7 @@ match gfc_match_omp_parallel_do_simd (void);
match gfc_match_omp_parallel_sections (void);
match gfc_match_omp_parallel_workshare (void);
match gfc_match_omp_requires (void);
+match gfc_match_omp_scan (void);
match gfc_match_omp_sections (void);
match gfc_match_omp_simd (void);
match gfc_match_omp_single (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 68d0b65ff87..b1f009785e3 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -3882,6 +3882,42 @@ error:
}
+match
+gfc_match_omp_scan (void)
+{
+ bool incl;
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ gfc_gobble_whitespace ();
+ if ((incl = (gfc_match ("inclusive") == MATCH_YES))
+ || gfc_match ("exclusive") == MATCH_YES)
+ {
+ if (gfc_match_omp_variable_list (" (", &c->lists[incl ? OMP_LIST_SCAN_IN
+ : OMP_LIST_SCAN_EX],
+ false) != MATCH_YES)
+ {
+ gfc_free_omp_clauses (c);
+ return MATCH_ERROR;
+ }
+ }
+ else
+ {
+ gfc_error ("Expected INCLUSIVE or EXCLUSIVE clause at %C");
+ gfc_free_omp_clauses (c);
+ return MATCH_ERROR;
+ }
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_error ("Unexpected junk after !$OMP SCAN at %C");
+ gfc_free_omp_clauses (c);
+ return MATCH_ERROR;
+ }
+
+ new_st.op = EXEC_OMP_SCAN;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
match
gfc_match_omp_sections (void)
{
@@ -4296,13 +4332,7 @@ gfc_match_omp_barrier (void)
match
gfc_match_omp_taskgroup (void)
{
- gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OMP_CLAUSE_TASK_REDUCTION, true, true)
- != MATCH_YES)
- return MATCH_ERROR;
- new_st.op = EXEC_OMP_TASKGROUP;
- new_st.ext.omp_clauses = c;
- return MATCH_YES;
+ return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION);
}
@@ -4628,7 +4658,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
"COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
- "TO", "FROM", "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/,
+ "TO", "FROM", "INCLUSIVE", "EXCLUSIVE",
+ "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/,
"IN_REDUCTION", "TASK_REDUCTION",
"DEVICE_RESIDENT", "LINK", "USE_DEVICE",
"CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
@@ -4865,6 +4896,15 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_error ("Object %qs is not a variable at %L", n->sym->name,
&n->where);
}
+ if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]
+ && code->op != EXEC_OMP_DO
+ && code->op != EXEC_OMP_SIMD
+ && code->op != EXEC_OMP_DO_SIMD
+ && code->op != EXEC_OMP_PARALLEL_DO
+ && code->op != EXEC_OMP_PARALLEL_DO_SIMD)
+ gfc_error ("%<inscan%> REDUCTION clause on construct other than DO, SIMD, "
+ "DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L",
+ &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where);
for (list = 0; list < OMP_LIST_NUM; list++)
if (list != OMP_LIST_FIRSTPRIVATE
@@ -4982,6 +5022,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->mark = 1;
}
+ bool has_inscan = false, has_notinscan = false;
for (list = 0; list < OMP_LIST_NUM; list++)
if ((n = omp_clauses->lists[list]) != NULL)
{
@@ -5289,6 +5330,17 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
|| list == OMP_LIST_REDUCTION_TASK
|| list == OMP_LIST_IN_REDUCTION
|| list == OMP_LIST_TASK_REDUCTION);
+ if (list == OMP_LIST_REDUCTION_INSCAN)
+ has_inscan = true;
+ else if (is_reduction)
+ has_notinscan = true;
+ if (has_inscan && has_notinscan && is_reduction)
+ {
+ gfc_error ("%<inscan%> and non-%<inscan%> %<reduction%> "
+ "clauses on the same construct %L",
+ &n->where);
+ break;
+ }
if (n->sym->attr.threadprivate)
gfc_error ("THREADPRIVATE object %qs in %s clause at %L",
n->sym->name, name, &n->where);
@@ -6151,6 +6203,28 @@ gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
}
if (i < omp_current_do_collapse || omp_current_do_collapse <= 0)
omp_current_do_collapse = 1;
+ if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN])
+ {
+ locus *loc
+ = &code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where;
+ if (code->ext.omp_clauses->ordered)
+ gfc_error ("ORDERED clause specified together with %<inscan%> "
+ "REDUCTION clause at %L", loc);
+ if (code->ext.omp_clauses->sched_kind != OMP_SCHED_NONE)
+ gfc_error ("SCHEDULE clause specified together with %<inscan%> "
+ "REDUCTION clause at %L", loc);
+ if (!c->block
+ || !c->block->next
+ || !c->block->next->next
+ || c->block->next->next->op != EXEC_OMP_SCAN
+ || !c->block->next->next->next
+ || c->block->next->next->next->next)
+ gfc_error ("With INSCAN at %L, expected loop body with !$OMP SCAN "
+ "between two structured-block-sequences", loc);
+ else
+ /* Mark as checked; flag will be unset later. */
+ c->block->next->next->ext.omp_clauses->if_present = true;
+ }
}
gfc_resolve_blocks (code->block, ns);
omp_current_do_collapse = 0;
@@ -6534,6 +6608,8 @@ omp_code_to_statement (gfc_code *code)
return ST_OMP_DISTRIBUTE_SIMD;
case EXEC_OMP_DO_SIMD:
return ST_OMP_DO_SIMD;
+ case EXEC_OMP_SCAN:
+ return ST_OMP_SCAN;
case EXEC_OMP_SIMD:
return ST_OMP_SIMD;
case EXEC_OMP_TARGET:
@@ -6972,7 +7048,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
of each directive. */
void
-gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
+gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
{
resolve_omp_directive_inside_oacc_region (code);
@@ -7046,6 +7122,14 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
gfc_error ("OMP CRITICAL at %L with HINT clause requires a NAME, "
"except when omp_sync_hint_none is used", &code->loc);
break;
+ case EXEC_OMP_SCAN:
+ /* Flag is only used to checking, hence, it is unset afterwards. */
+ if (!code->ext.omp_clauses->if_present)
+ gfc_error ("Unexpected !$OMP SCAN at %L outside loop construct with "
+ "%<inscan%> REDUCTION clause", &code->loc);
+ code->ext.omp_clauses->if_present = false;
+ resolve_omp_clauses (code, code->ext.omp_clauses, ns);
+ break;
default:
break;
}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index ec7abc240d6..fe0fffd0d1a 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -999,6 +999,7 @@ decode_omp_directive (void)
matcho ("requires", gfc_match_omp_requires, ST_OMP_REQUIRES);
break;
case 's':
+ matcho ("scan", gfc_match_omp_scan, ST_OMP_SCAN);
matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION);
matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE);
@@ -1590,7 +1591,7 @@ next_statement (void)
case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \
case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
- case ST_ERROR_STOP: case ST_SYNC_ALL: \
+ case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
case ST_END_TEAM: case ST_SYNC_TEAM: \
@@ -2447,6 +2448,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_REQUIRES:
p = "!$OMP REQUIRES";
break;
+ case ST_OMP_SCAN:
+ p = "!$OMP SCAN";
+ break;
case ST_OMP_SECTIONS:
p = "!$OMP SECTIONS";
break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0a8f90775ab..327dffbebf2 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12184,6 +12184,7 @@ start:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_MASTER:
case EXEC_OMP_ORDERED:
+ case EXEC_OMP_SCAN:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index a3b0f12b171..d5bccb80f03 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -231,6 +231,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_PARALLEL_DO_SIMD:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_SCAN:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 6b4ad6a7050..ae290648b99 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2334,6 +2334,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_LIST_NONTEMPORAL:
clause_code = OMP_CLAUSE_NONTEMPORAL;
goto add_clause;
+ case OMP_LIST_SCAN_IN:
+ clause_code = OMP_CLAUSE_INCLUSIVE;
+ goto add_clause;
+ case OMP_LIST_SCAN_EX:
+ clause_code = OMP_CLAUSE_EXCLUSIVE;
+ goto add_clause;
add_clause:
omp_clauses
@@ -4707,7 +4713,31 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
code->exit_label = NULL_TREE;
/* Main loop body. */
- tmp = gfc_trans_omp_code (code->block->next, true);
+ if (clauses->lists[OMP_LIST_REDUCTION_INSCAN])
+ {
+ gcc_assert (code->block->next->next->op == EXEC_OMP_SCAN);
+ gcc_assert (code->block->next->next->next->next == NULL);
+ locus *cloc = &code->block->next->next->loc;
+ location_t loc = gfc_get_location (cloc);
+
+ gfc_code code2 = *code->block->next;
+ code2.next = NULL;
+ tmp = gfc_trans_code (&code2);
+ tmp = build2 (OMP_SCAN, void_type_node, tmp, NULL_TREE);
+ SET_EXPR_LOCATION (tmp, loc);
+ gfc_add_expr_to_block (&body, tmp);
+ input_location = loc;
+ tree c = gfc_trans_omp_clauses (&body,
+ code->block->next->next->ext.omp_clauses,
+ *cloc);
+ code2 = *code->block->next->next->next;
+ code2.next = NULL;
+ tmp = gfc_trans_code (&code2);
+ tmp = build2 (OMP_SCAN, void_type_node, tmp, c);
+ SET_EXPR_LOCATION (tmp, loc);
+ }
+ else
+ tmp = gfc_trans_omp_code (code->block->next, true);
gfc_add_expr_to_block (&body, tmp);
/* Label for cycle statements (if needed). */
@@ -5234,13 +5264,15 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
/* Reduction is allowed on simd, do, parallel and teams.
Duplicate it on all of them, but omit on do if
- parallel is present. */
+ parallel is present; additionally, inscan applies to do/simd only. */
for (int i = OMP_LIST_REDUCTION; i <= OMP_LIST_REDUCTION_TASK; i++)
{
- if (mask & GFC_OMP_MASK_TEAMS)
+ if (mask & GFC_OMP_MASK_TEAMS
+ && i != OMP_LIST_REDUCTION_INSCAN)
clausesa[GFC_OMP_SPLIT_TEAMS].lists[i]
= code->ext.omp_clauses->lists[i];
- if (mask & GFC_OMP_MASK_PARALLEL)
+ if (mask & GFC_OMP_MASK_PARALLEL
+ && i != OMP_LIST_REDUCTION_INSCAN)
clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i]
= code->ext.omp_clauses->lists[i];
else if (mask & GFC_OMP_MASK_DO)
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction4.f90
index af8c91b2a87..812be323b2e 100644
--- a/gcc/testsuite/gfortran.dg/gomp/reduction4.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction4.f90
@@ -28,7 +28,7 @@ do i=1,10
end do
!$omp end parallel
-!$omp parallel reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause on 'parallel' construct" }
+!$omp parallel reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
do i=1,10
a = a + 1
end do
@@ -45,16 +45,6 @@ do i=1,10
a = a + 1
end do
-!$omp simd reduction(task,+:a) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do' or 'sections'" }
-do i=1,10
- a = a + 1
-end do
-
-!$omp simd reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause but not in 'scan' directive clause" }
-do i=1,10
- a = a + 1
-end do
-
! ------------ do ------------
!$omp parallel
!$omp do reduction(+:a)
@@ -77,13 +67,6 @@ do i=1,10
end do
!$omp end parallel
-!$omp parallel
-!$omp do reduction(inscan,+:a) ! { dg-error "'a' specified in 'inscan' 'reduction' clause but not in 'scan' directive clause" }
-do i=1,10
- a = a + 1
-end do
-!$omp end parallel
-
! ------------ section ------------
!$omp parallel
!$omp sections reduction(+:a)
@@ -107,7 +90,7 @@ end do
!$omp end parallel
!$omp parallel
-!$omp sections reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause on 'sections' construct" }
+!$omp sections reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
!$omp section
a = a + 1
!$omp end sections
@@ -152,9 +135,8 @@ end do
end
! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(\\\+:a\\)" 2 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(task,\\\+:a\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\n\r\]" 8 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\n\r\]" 7 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(\\\+:a\\)" 2 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(task,\\\+:a\\)" 1 "original" } }
@@ -163,7 +145,6 @@ end
! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(inscan,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(task,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(\\\+:a\\)" 2 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(task,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp target in_reduction\\(\\\+:b\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp task in_reduction\\(\\\+:a\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
index df915f1cad4..bfb847e9933 100644
--- a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
@@ -20,7 +20,10 @@ end do
a = a + 1
!$omp end task ! { dg-error "Unexpected !.OMP END TASK statement" }
-!$omp taskloop reduction(inscan,+:a) in_reduction(+:b) ! { dg-error "34: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
+!$omp taskloop reduction(inscan,+:a) in_reduction(+:b) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+ ! { dg-error "34: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 }
+ ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" "" { target *-*-* } .-2 }
+ ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" "" { target *-*-* } .-3 }
do i=1,10
a = a + 1
end do
@@ -30,7 +33,8 @@ do i=1,10
a = a + 1
end do
-!$omp teams reduction(inscan,+:b) ! { dg-error "31: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
+!$omp teams reduction(inscan,+:b) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+ ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" "" { target *-*-* } .-1 }
a = a + 1
!$omp end teams
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90
new file mode 100644
index 00000000000..6bf685130ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+
+implicit none
+integer :: a, b, i
+a = 0
+
+!$omp simd reduction(inscan,+:a) ! { dg-error "30: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" }
+do i=1,10
+ a = a + 1
+end do
+
+!$omp parallel
+!$omp do reduction(inscan,+:a) ! { dg-error "28: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" }
+do i=1,10
+ a = a + 1
+end do
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction7.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction7.f90
new file mode 100644
index 00000000000..7dc50e1ac69
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction7.f90
@@ -0,0 +1,9 @@
+implicit none
+integer :: a, b, i
+a = 0
+
+!$omp simd reduction(task,+:a) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do' or 'sections'" }
+do i=1,10
+ a = a + 1
+end do
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90
new file mode 100644
index 00000000000..8c879fd98b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90
@@ -0,0 +1,213 @@
+module m
+ integer a, b
+end module m
+
+subroutine f1
+ use m
+ !$omp scan inclusive (a) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" }
+ !$omp scan exclusive (b) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" }
+end
+
+subroutine f2 (c, d, e, f)
+ use m
+ implicit none
+ integer i, l, c(*), d(*), e(64), f(64)
+ l = 1
+
+ !$omp do reduction (inscan, +: a) reduction (+: b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" }
+ do i = 1, 64
+ block
+ b = b + 1
+ a = a + c(i)
+ end block
+ !$omp scan inclusive (a)
+ d(i) = a
+ end do
+
+ !$omp do reduction (+: a) reduction (inscan, +: b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" }
+ do i = 1, 64
+ block
+ a = a + 1
+ b = b + c(i)
+ end block
+ !$omp scan inclusive (b)
+ d(i) = b
+ end do
+
+ !$omp do reduction (inscan, +: e)
+ do i = 1, 64
+ block
+ e(1) = e(1) + c(i)
+ e(2) = e(2) + c(i)
+ end block
+ !$omp scan inclusive (a, e)
+ block
+ d(1) = e(1)
+ f(2) = e(2)
+ end block
+ end do
+
+ !$omp do reduction (inscan, +: e(:2)) ! { dg-error "Syntax error in OpenMP variable list" }
+ do i = 1, 64
+ block
+ e(1) = e(1) + c(i)
+ e(2) = e(2) + c(i)
+ end block
+ !$omp scan inclusive (a, e) ! { dg-error "outside loop construct with 'inscan' REDUCTION clause" }
+ block
+ d(1) = e(1)
+ f(2) = e(2)
+ end block
+ end do
+
+ !$omp do reduction (inscan, +: a) ordered ! { dg-error "ORDERED clause specified together with 'inscan' REDUCTION clause" }
+ do i = 1, 64
+ a = a + c(i)
+ !$omp scan inclusive (a)
+ d(i) = a
+ end do
+
+ !$omp do reduction (inscan, +: a) ordered(1) ! { dg-error "ORDERED clause specified together with 'inscan' REDUCTION clause" }
+ do i = 1, 64
+ a = a + c(i)
+ !$omp scan inclusive (a)
+ d(i) = a
+ end do
+
+ !$omp do reduction (inscan, +: a) schedule(static) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" }
+ do i = 1, 64
+ a = a + c(i)
+ !$omp scan inclusive (a)
+ d(i) = a
+ end do
+
+ !$omp do reduction (inscan, +: a) schedule(static, 2) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" }
+ do i = 1, 64
+ a = a + c(i)
+ !$omp scan inclusive (a)
+ d(i) = a
+ end do
+
+ !$omp do reduction (inscan, +: a) schedule(nonmonotonic: dynamic, 2) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" }
+ do i = 1, 64
+ a = a + c(i)
+ !$omp scan inclusive (a)
+ d(i) = a
+ end do
+end
+
+subroutine f3 (c, d)
+ use m
+ implicit none
+ integer i, c(64), d(64)
+ !$omp teams reduction (inscan, +: a) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause at" }
+ ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
+ ! ...
+ !$omp end teams
+
+ !$omp target parallel do reduction (inscan, +: a) map (c, d)
+ ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
+ do i = 1, 64
+ d(i) = a
+ !$omp scan exclusive (a)
+ a = a + c(i)
+ end do
+ !$omp teams
+ !$omp distribute parallel do reduction (inscan, +: a)
+ ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
+ do i = 1, 64
+ d(i) = a
+ !$omp scan exclusive (a)
+ a = a + c(i)
+ end do
+ !$omp end teams
+
+ !$omp distribute parallel do simd reduction (inscan, +: a)
+ ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
+ do i = 1, 64
+ d(i) = a
+ !$omp scan exclusive (a)
+ a = a + c(i)
+ end do
+end
+
+subroutine f4 (c, d)
+ use m
+ implicit none
+ integer i, c(64), d(64)
+ !$omp taskloop reduction (inscan, +: a) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
+ ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
+ do i = 1, 64
+ d(i) = a
+ !$omp scan exclusive (a)
+ a = a + c(i)
+ end do
+end
+
+subroutine f7
+ use m
+ implicit none
+ integer i
+ !$omp simd reduction (inscan, +: a)
+ do i = 1, 64
+ if (i == 23) then ! { dg-error "invalid exit from OpenMP structured block" "" { target c++ } .+1 }
+ cycle ! { dg-error "invalid branch to/from OpenMP structured block" "" { target c } }
+ elseif (i == 27) then
+ goto 123 ! Diagnostic by ME, see scan-7.f90
+ ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 }
+ endif
+ !$omp scan exclusive (a)
+ block
+123 a = 0 ! { dg-error "jump to label 'l1'" "" { target c++ } }
+ ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 }
+ if (i == 33) then ! { dg-error "invalid exit from OpenMP structured block" "" { target c++ } .+1 }
+ cycle ! { dg-error "invalid branch to/from OpenMP structured block" "" { target c } }
+ end if
+ end block
+ end do
+end
+
+subroutine f8 (c, d, e, f)
+ use m
+ implicit none
+ integer i, c(64), d(64), e(64), f(64)
+ !$omp do reduction (inscan, +: a, b) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" }
+ do i = 1, 64
+ block
+ a = a + c(i)
+ b = b + d(i)
+ end block
+ !$omp scan inclusive (a) inclusive (b) ! { dg-error "Unexpected junk after ..OMP SCAN" }
+ block
+ e(i) = a
+ f(i) = b
+ end block
+ end do
+
+ !$omp do reduction (inscan, +: a, b) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" }
+ do i = 1, 64
+ block
+ a = a + c(i)
+ b = b + d(i)
+ end block
+ !$omp scan ! { dg-error "Expected INCLUSIVE or EXCLUSIVE clause" }
+ block
+ e(i) = a
+ f(i) = b
+ end block
+ end do
+end
+
+subroutine f9
+ use m
+ implicit none
+ integer i
+! The first error (exit) causes two follow-up errors:
+ !$omp simd reduction (inscan, +: a) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" }
+ do i = 1, 64
+ if (i == 23) &
+ exit ! { dg-error "EXIT statement at .1. terminating ..OMP DO loop" } */
+ !$omp scan exclusive (a) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" }
+ a = a + 1
+ end do
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-2.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-2.f90
new file mode 100644
index 00000000000..c0572321e51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/scan-2.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+module m
+ integer :: a, b
+end module m
+
+subroutine f1 (c, d)
+ use m
+ implicit none
+ integer i, c(*), d(*)
+ !$omp simd reduction (inscan, +: a)
+ do i = 1, 64
+ d(i) = a
+ !$omp scan exclusive (a)
+ a = a + c(i)
+ end do
+end
+
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp scan exclusive\\(a\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-3.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-3.f90
new file mode 100644
index 00000000000..83181666462
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/scan-3.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+module m
+ integer :: a, b
+end module m
+
+subroutine f1 (c, d)
+ use m
+ implicit none
+ integer i, c(*), d(*)
+ !$omp do reduction (inscan, +: a)
+ do i = 1, 64
+ d(i) = a
+ !$omp scan inclusive (a)
+ a = a + c(i)
+ end do
+end
+
+! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp scan inclusive\\(a\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-4.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-4.f90
new file mode 100644
index 00000000000..c9e9d7e57c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/scan-4.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+module m
+ integer a, b
+end module m
+
+subroutine f1 (c, d)
+ use m
+ implicit none
+ integer c(*), d(*), i
+ !$omp do simd reduction (inscan, +: a)
+ do i = 1, 64
+ d(i) = a
+ !$omp scan exclusive (a)
+ a = a + c(i)
+ end do
+end
+
+! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp scan exclusive\\(a\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-5.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-5.f90
new file mode 100644
index 00000000000..a3789a5868a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/scan-5.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+integer function foo(a,b, n) result(r)
+ implicit none
+ integer :: a(n), b(n), n, i
+ r = 0
+ !$omp parallel do reduction (inscan, +:r) default(none) firstprivate (a, b)
+ do i = 1, n
+ r = r + a(i)
+ !$omp scan inclusive (r)
+ b(i) = r
+ end do
+end
+
+! { dg-final { scan-tree-dump-times "#pragma omp parallel firstprivate\\(a\\) firstprivate\\(b\\) default\\(none\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:r\\) nowait" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp scan inclusive\\(r\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-6.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-6.f90
new file mode 100644
index 00000000000..35d5869ac1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/scan-6.f90
@@ -0,0 +1,16 @@
+module m
+ integer a, b
+end module m
+
+subroutine f3 (c, d)
+ use m
+ implicit none
+ integer i, c(64), d(64)
+ !$omp parallel reduction (inscan, +: a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+ ! ...
+ !$omp end parallel
+ !$omp sections reduction (inscan, +: a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+ !$omp section
+ ! ...
+ !$omp end sections
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-7.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-7.f90
new file mode 100644
index 00000000000..0446c5eee2b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/scan-7.f90
@@ -0,0 +1,60 @@
+module m
+ integer a, b
+end module m
+
+subroutine f2 (c, d, e, f)
+ use m
+ implicit none
+ integer i, l, c(*), d(*), e(64), f(64)
+ l = 1
+
+ !$omp do reduction (inscan, +: a) linear (l) ! { dg-error "'inscan' 'reduction' clause used together with 'linear' clause for a variable other than loop iterator" }
+ do i = 1, 64
+ block
+ a = a + c(i)
+ l = l + 1
+ end block
+ !$omp scan inclusive (a)
+ d(i) = a
+ end do
+end
+
+subroutine f5 (c, d)
+ use m
+ implicit none
+ integer i, c(64), d(64)
+ !$omp simd reduction (inscan, +: a)
+ do i = 1, 64
+ d(i) = a
+ !$omp scan exclusive (a, b) ! { dg-error "'b' specified in 'exclusive' clause but not in 'inscan' 'reduction' clause on the containing construct" }
+ a = a + c(i)
+ end do
+end
+
+subroutine f6 (c, d)
+ use m
+ implicit none
+ integer i, c(64), d(64)
+ !$omp simd reduction (inscan, +: a, b) ! { dg-error "'b' specified in 'inscan' 'reduction' clause but not in 'scan' directive clause" }
+ do i = 1, 64
+ d(i) = a
+ !$omp scan exclusive (a)
+ a = a + c(i)
+ end do
+end
+
+subroutine f7
+ use m
+ implicit none
+ integer i
+ !$omp simd reduction (inscan, +: a)
+ do i = 1, 64
+ if (i == 27) goto 123 ! { dg-error "invalid branch to/from OpenMP structured block" }
+ ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 }
+ !$omp scan exclusive (a)
+ block
+123 a = 0 ! { dg-error "jump to label 'l1'" "" { target c++ } }
+ ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 }
+ end block
+ end do
+end
diff --git a/libgomp/testsuite/libgomp.fortran/scan-1.f90 b/libgomp/testsuite/libgomp.fortran/scan-1.f90
new file mode 100644
index 00000000000..a6f8ef7ea76
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/scan-1.f90
@@ -0,0 +1,115 @@
+! { dg-require-effective-target size32plus }
+
+module m
+ implicit none
+ integer r, a(1024), b(1024)
+contains
+subroutine foo (a, b)
+ integer, contiguous :: a(:), b(:)
+ integer :: i
+ !$omp do reduction (inscan, +:r)
+ do i = 1, 1024
+ r = r + a(i)
+ !$omp scan inclusive(r)
+ b(i) = r
+ end do
+end
+
+integer function bar ()
+ integer s, i
+ s = 0
+ !$omp parallel
+ !$omp do reduction (inscan, +:s)
+ do i = 1, 1024
+ s = s + 2 * a(i)
+ !$omp scan inclusive(s)
+ b(i) = s
+ end do
+ !$omp end parallel
+ bar = s
+end
+
+subroutine baz (a, b)
+ integer, contiguous :: a(:), b(:)
+ integer :: i
+ !$omp parallel do reduction (inscan, +:r)
+ do i = 1, 1024
+ r = r + a(i)
+ !$omp scan inclusive(r)
+ b(i) = r
+ end do
+end
+
+integer function qux ()
+ integer s, i
+ s = 0
+ !$omp parallel do reduction (inscan, +:s)
+ do i = 1, 1024
+ s = s + 2 * a(i)
+ !$omp scan inclusive(s)
+ b(i) = s
+ end do
+ qux = s
+end
+end module m
+
+program main
+ use m
+ implicit none
+
+ integer s, i
+ s = 0
+ do i = 1, 1024
+ a(i) = i-1
+ b(i) = -1
+ end do
+
+ !$omp parallel
+ call foo (a, b)
+ !$omp end parallel
+ if (r /= 1024 * 1023 / 2) &
+ stop 1
+ do i = 1, 1024
+ s = s + i-1
+ if (b(i) /= s) then
+ stop 2
+ else
+ b(i) = 25
+ endif
+ end do
+
+ if (bar () /= 1024 * 1023) &
+ stop 3
+ s = 0
+ do i = 1, 1024
+ s = s + 2 * (i-1)
+ if (b(i) /= s) then
+ stop 4
+ else
+ b(i) = -1
+ end if
+ end do
+
+ r = 0
+ call baz (a, b)
+ if (r /= 1024 * 1023 / 2) &
+ stop 5
+ s = 0
+ do i = 1, 1024
+ s = s + i-1
+ if (b(i) /= s) then
+ stop 6
+ else
+ b(i) = -25
+ endif
+ end do
+
+ if (qux () /= 1024 * 1023) &
+ stop 6
+ s = 0
+ do i = 1, 1024
+ s = s + 2 * (i-1)
+ if (b(i) /= s) &
+ stop 7
+ end do
+end program
