OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

openmp: Fortran strictly-structured blocks support 

This implements strictly-structured blocks support for Fortran, as specified in
OpenMP 5.2. This now allows using a Fortran BLOCK construct as the body of most
OpenMP constructs, with a "!$omp end ..." ending directive optional for that
form.

gcc/fortran/ChangeLog:

	* decl.c (gfc_match_end): Add COMP_OMP_STRICTLY_STRUCTURED_BLOCK case
	together with COMP_BLOCK.
	* parse.c (parse_omp_structured_block): Change return type to
	'gfc_statement', add handling for strictly-structured block case, adjust
	recursive calls to parse_omp_structured_block.
	(parse_executable): Adjust calls to parse_omp_structured_block.
	* parse.h (enum gfc_compile_state): Add
	COMP_OMP_STRICTLY_STRUCTURED_BLOCK.
	* trans-openmp.c (gfc_trans_omp_workshare): Add EXEC_BLOCK case
	handling.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/cancel-1.f90: Adjust testcase.
	* gfortran.dg/gomp/nesting-3.f90: Adjust testcase.
	* gfortran.dg/gomp/strictly-structured-block-1.f90: New test.
	* gfortran.dg/gomp/strictly-structured-block-2.f90: New test.
	* gfortran.dg/gomp/strictly-structured-block-3.f90: New test.

libgomp/ChangeLog:

	* libgomp.texi (Support of strictly structured blocks in Fortran):
	Adjust to 'Y'.
	* testsuite/libgomp.fortran/task-reduction-16.f90: Adjust testcase.
This commit is contained in:
Chung-Lin Tang 2021-10-21 14:56:20 +08:00
parent 1af78e731f
commit 2e4659199e
11 changed files with 484 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
gcc/fortran/decl.c
View File

@ -8429,6 +8429,7 @@ gfc_match_end (gfc_statement *st)
break;
case COMP_BLOCK:
case COMP_OMP_STRICTLY_STRUCTURED_BLOCK:
*st = ST_END_BLOCK;
target = " block";
eos_ok = 0;

69
gcc/fortran/parse.c
View File

@ -5459,7 +5459,7 @@ parse_oacc_loop (gfc_statement acc_st)
/* Parse the statements of an OpenMP structured block. */
static void
static gfc_statement
parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
{
gfc_statement st, omp_end_st;
@ -5546,6 +5546,32 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
gcc_unreachable ();
}
bool block_construct = false;
gfc_namespace *my_ns = NULL;
gfc_namespace *my_parent = NULL;
st = next_statement ();
if (st == ST_BLOCK)
{
/* Adjust state to a strictly-structured block, now that we found that
the body starts with a BLOCK construct. */
s.state = COMP_OMP_STRICTLY_STRUCTURED_BLOCK;
block_construct = true;
gfc_notify_std (GFC_STD_F2008, "BLOCK construct at %C");
my_ns = gfc_build_block_ns (gfc_current_ns);
gfc_current_ns = my_ns;
my_parent = my_ns->parent;
new_st.op = EXEC_BLOCK;
new_st.ext.block.ns = my_ns;
new_st.ext.block.assoc = NULL;
accept_statement (ST_BLOCK);
st = parse_spec (ST_NONE);
}
do
{
if (workshare_stmts_only)
@ -5562,7 +5588,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
restrictions apply recursively. */
bool cycle = true;
st = next_statement ();
for (;;)
{
switch (st)
@ -5588,13 +5613,13 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
case ST_OMP_PARALLEL_MASKED:
case ST_OMP_PARALLEL_MASTER:
case ST_OMP_PARALLEL_SECTIONS:
parse_omp_structured_block (st, false);
break;
st = parse_omp_structured_block (st, false);
continue;
case ST_OMP_PARALLEL_WORKSHARE:
case ST_OMP_CRITICAL:
parse_omp_structured_block (st, true);
break;
st = parse_omp_structured_block (st, true);
continue;
case ST_OMP_PARALLEL_DO:
case ST_OMP_PARALLEL_DO_SIMD:
@ -5617,7 +5642,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
}
}
else
st = parse_executable (ST_NONE);
st = parse_executable (st);
if (st == ST_NONE)
unexpected_eof ();
else if (st == ST_OMP_SECTION
@ -5627,9 +5652,27 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
np = new_level (np);
np->op = cp->op;
np->block = NULL;
st = next_statement ();
}
else if (block_construct && st == ST_END_BLOCK)
{
accept_statement (st);
gfc_current_ns = my_parent;
pop_state ();
st = next_statement ();
if (st == omp_end_st)
{
accept_statement (st);
st = next_statement ();
}
return st;
}
else if (st != omp_end_st)
unexpected_statement (st);
{
unexpected_statement (st);
st = next_statement ();
}
}
while (st != omp_end_st);
@ -5665,6 +5708,8 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
gfc_commit_symbols ();
gfc_warning_check ();
pop_state ();
st = next_statement ();
return st;
}
@ -5805,13 +5850,13 @@ parse_executable (gfc_statement st)
case ST_OMP_TEAMS:
case ST_OMP_TASK:
case ST_OMP_TASKGROUP:
parse_omp_structured_block (st, false);
break;
st = parse_omp_structured_block (st, false);
continue;
case ST_OMP_WORKSHARE:
case ST_OMP_PARALLEL_WORKSHARE:
parse_omp_structured_block (st, true);
break;
st = parse_omp_structured_block (st, true);
continue;
case ST_OMP_DISTRIBUTE:
case ST_OMP_DISTRIBUTE_PARALLEL_DO:

2
gcc/fortran/parse.h
View File

@ -31,7 +31,7 @@ enum gfc_compile_state
COMP_STRUCTURE, COMP_UNION, COMP_MAP,
COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM,
COMP_SELECT_TYPE, COMP_SELECT_RANK, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL,
COMP_DO_CONCURRENT
COMP_DO_CONCURRENT, COMP_OMP_STRICTLY_STRUCTURED_BLOCK
};
/* Stack element for the current compilation state. These structures

6
gcc/fortran/trans-openmp.c
View File

@ -7000,7 +7000,11 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
res = gfc_trans_omp_directive (code);
ompws_flags = saved_ompws_flags;
break;
case EXEC_BLOCK:
res = gfc_trans_block_construct (code);
break;
default:
gfc_internal_error ("gfc_trans_omp_workshare(): Bad statement code");
}

3
gcc/testsuite/gfortran.dg/gomp/cancel-1.f90
View File

@ -265,6 +265,7 @@ subroutine f2
end do
!$omp end do
!$omp sections
!$omp section
block
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
@ -417,6 +418,7 @@ subroutine f2
!$omp end ordered
end do
!$omp sections
!$omp section
block
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
@ -515,6 +517,7 @@ subroutine f3
end do
!$omp end do nowait
!$omp sections
!$omp section
block
!$omp cancel sections ! { dg-warning "nowait" }
end block

20
gcc/testsuite/gfortran.dg/gomp/nesting-3.f90
View File

@ -7,7 +7,7 @@ subroutine f1
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
call do_work
!$omp section
block; end block
!$omp end sections
@ -33,7 +33,7 @@ subroutine f1
!$omp end sections
!$omp sections
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
call do_work
!$omp section
block; end block
!$omp end sections
@ -72,7 +72,7 @@ subroutine f1
!$omp sections
!$omp section
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
call do_work
!$omp section
block; end block
!$omp end sections
@ -105,7 +105,7 @@ subroutine f1
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
call do_work
!$omp section
block; end block
!$omp end sections
@ -129,7 +129,7 @@ subroutine f1
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
call do_work
!$omp section
block; end block
!$omp end sections
@ -150,7 +150,7 @@ subroutine f1
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
call do_work
!$omp section
block; end block
!$omp end sections
@ -171,7 +171,7 @@ subroutine f1
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
call do_work
!$omp section
block; end block
!$omp end sections
@ -195,7 +195,7 @@ subroutine f1
block; end block
end do
!$omp sections
block; end block
call do_work
!$omp section
block; end block
!$omp end sections
@ -224,7 +224,7 @@ subroutine f1
block; end block
end do
!$omp sections
block; end block
call do_work
!$omp section
block; end block
!$omp end sections
@ -257,7 +257,7 @@ subroutine f2
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
call do_work
!$omp section
block; end block
!$omp end sections

214
gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90 Normal file
View File

@ -0,0 +1,214 @@
! { dg-do compile }
! { dg-options "-fopenmp" }
program main
integer :: x, i, n
x = 0
n = 10
!$omp parallel
block
x = x + 1
end block
!$omp parallel
block
x = x + 1
end block
!$omp end parallel
!$omp teams
block
x = x + 1
end block
!$omp teams
block
x = x + 1
end block
!$omp end teams
!$omp masked
block
x = x + 1
end block
!$omp masked
block
x = x + 1
end block
!$omp end masked
!$omp scope
block
x = x + 1
end block
!$omp scope
block
x = x + 1
end block
!$omp end scope
!$omp single
block
x = x + 1
end block
!$omp single
block
x = x + 1
end block
!$omp end single
!$omp workshare
block
x = x + 1
end block
!$omp workshare
block
x = x + 1
end block
!$omp end workshare
!$omp task
block
x = x + 1
end block
!$omp task
block
x = x + 1
end block
!$omp end task
!$omp target data map(x)
block
x = x + 1
end block
!$omp target data map(x)
block
x = x + 1
end block
!$omp end target data
!$omp target
block
x = x + 1
end block
!$omp target
block
x = x + 1
end block
!$omp end target
!$omp parallel workshare
block
x = x + 1
end block
!$omp parallel workshare
block
x = x + 1
end block
!$omp end parallel workshare
!$omp parallel masked
block
x = x + 1
end block
!$omp parallel masked
block
x = x + 1
end block
!$omp end parallel masked
!$omp target parallel
block
x = x + 1
end block
!$omp target parallel
block
x = x + 1
end block
!$omp end target parallel
!$omp target teams
block
x = x + 1
end block
!$omp target teams
block
x = x + 1
end block
!$omp end target teams
!$omp critical
block
x = x + 1
end block
!$omp critical
block
x = x + 1
end block
!$omp end critical
!$omp taskgroup
block
x = x + 1
end block
!$omp taskgroup
block
x = x + 1
end block
!$omp end taskgroup
!$omp do ordered
do i = 1, n
!$omp ordered
block
x = x + 1
end block
end do
!$omp do ordered
do i = 1, n
!$omp ordered
block
x = x + 1
end block
!$omp end ordered
end do
!$omp master
block
x = x + 1
end block
!$omp master
block
x = x + 1
end block
!$omp end master
!$omp parallel master
block
x = x + 1
end block
!$omp parallel master
block
x = x + 1
end block
!$omp end parallel master
end program

139
gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-2.f90 Normal file
View File

@ -0,0 +1,139 @@
! { dg-do compile }
! { dg-options "-fopenmp" }
program main
integer :: x, i, n
x = 0
n = 10
!$omp parallel
block
x = x + 1
end block
x = x + 1
!$omp end parallel ! { dg-error "Unexpected !.OMP END PARALLEL statement" }
!$omp teams
block
x = x + 1
end block
x = x + 1
!$omp end teams ! { dg-error "Unexpected !.OMP END TEAMS statement" }
!$omp masked
block
x = x + 1
end block
x = x + 1
!$omp end masked ! { dg-error "Unexpected !.OMP END MASKED statement" }
!$omp scope
block
x = x + 1
end block
x = x + 1
!$omp end scope ! { dg-error "Unexpected !.OMP END SCOPE statement" }
!$omp single
block
x = x + 1
end block
x = x + 1
!$omp end single ! { dg-error "Unexpected !.OMP END SINGLE statement" }
!$omp workshare
block
x = x + 1
end block
x = x + 1
!$omp end workshare ! { dg-error "Unexpected !.OMP END WORKSHARE statement" }
!$omp task
block
x = x + 1
end block
x = x + 1
!$omp end task ! { dg-error "Unexpected !.OMP END TASK statement" }
!$omp target data map(x)
block
x = x + 1
end block
x = x + 1
!$omp end target data ! { dg-error "Unexpected !.OMP END TARGET DATA statement" }
!$omp target
block
x = x + 1
end block
x = x + 1
!$omp end target ! { dg-error "Unexpected !.OMP END TARGET statement" }
!$omp parallel workshare
block
x = x + 1
end block
x = x + 1
!$omp end parallel workshare ! { dg-error "Unexpected !.OMP END PARALLEL WORKSHARE statement" }
!$omp parallel masked
block
x = x + 1
end block
x = x + 1
!$omp end parallel masked ! { dg-error "Unexpected !.OMP END PARALLEL MASKED statement" }
!$omp target parallel
block
x = x + 1
end block
x = x + 1
!$omp end target parallel ! { dg-error "Unexpected !.OMP END TARGET PARALLEL statement" }
!$omp target teams
block
x = x + 1
end block
x = x + 1
!$omp end target teams ! { dg-error "Unexpected !.OMP END TARGET TEAMS statement" }
!$omp critical
block
x = x + 1
end block
x = x + 1
!$omp end critical ! { dg-error "Unexpected !.OMP END CRITICAL statement" }
!$omp taskgroup
block
x = x + 1
end block
x = x + 1
!$omp end taskgroup ! { dg-error "Unexpected !.OMP END TASKGROUP statement" }
!$omp do ordered
do i = 1, n
!$omp ordered
block
x = x + 1
end block
x = x + 1
!$omp end ordered ! { dg-error "Unexpected !.OMP END ORDERED statement" }
end do
!$omp master
block
x = x + 1
end block
x = x + 1
!$omp end master ! { dg-error "Unexpected !.OMP END MASTER statement" }
!$omp parallel master
block
x = x + 1
end block
x = x + 1
!$omp end parallel master ! { dg-error "Unexpected !.OMP END PARALLEL MASTER statement" }
end program

52
gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-3.f90 Normal file
View File

@ -0,0 +1,52 @@
! { dg-do compile }
! { dg-options "-fopenmp" }
program main
integer :: x, y
x = 0
y = 0
!$omp parallel
!$omp parallel
block
x = x + 1
end block
!$omp end parallel
!$omp end parallel
!$omp workshare
block
x = 1
!$omp critical
block
y = 3
end block
end block
!$omp sections
block
!$omp section
block
x = 1
end block
x = x + 2
!$omp section
x = x + 4
end block
!$omp sections
!$omp section
block
end block
x = 1
!$omp end sections
!$omp sections
block
block
end block
x = 1
end block
end program main

2
libgomp/libgomp.texi
View File

@ -337,7 +337,7 @@ The OpenMP 4.5 specification is fully supported.
@multitable @columnfractions .60 .10 .25
@headitem Description @tab Status @tab Comments
@item Support of strictly structured blocks in Fortran @tab N @tab
@item Support of strictly structured blocks in Fortran @tab Y @tab
@item Support of structured block sequences in C/C++ @tab Y @tab
@item @code{unconstrained} and @code{reproducible} modifiers on @code{order}
clause @tab Y @tab

1
libgomp/testsuite/libgomp.fortran/task-reduction-16.f90
View File

@ -20,6 +20,7 @@ contains
!$omp scope reduction (task, iand: c)
!$omp barrier
!$omp sections
!$omp section
block
a = a + 1; b(0) = b(0) * 2; call bar (2); b(2) = b(2) * 3
c(1) = iand(c(1), not(ishft(1_8, 2)))