Skip to content

Commit dd62c97

Browse files
committed
OpenMP/Fortran: Fix skipping unmatchable metadirectives [PR122570]
Fix a bug in the removal code of always false variants in metadirectives. PR fortran/122570 gcc/fortran/ChangeLog: * openmp.cc (resolve_omp_metadirective): Fix 'skip' of never matchable metadirective variants. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr122570.f: New test.
1 parent 470411f commit dd62c97

File tree

2 files changed

+38
-4
lines changed

2 files changed

+38
-4
lines changed

gcc/fortran/openmp.cc

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -12320,6 +12320,7 @@ static void
1232012320
resolve_omp_metadirective (gfc_code *code, gfc_namespace *ns)
1232112321
{
1232212322
gfc_omp_variant *variant = code->ext.omp_variants;
12323+
gfc_omp_variant *prev_variant = variant;
1232312324

1232412325
while (variant)
1232512326
{
@@ -12333,15 +12334,19 @@ resolve_omp_metadirective (gfc_code *code, gfc_namespace *ns)
1233312334
as the 'otherwise' clause should always match. */
1233412335
if (variant == code->ext.omp_variants && !variant->next)
1233512336
break;
12336-
if (variant == code->ext.omp_variants)
12337-
code->ext.omp_variants = variant->next;
1233812337
gfc_omp_variant *tmp = variant;
12339-
variant = variant->next;
12338+
if (variant == code->ext.omp_variants)
12339+
variant = prev_variant = code->ext.omp_variants = variant->next;
12340+
else
12341+
variant = prev_variant->next = variant->next;
1234012342
gfc_free_omp_set_selector_list (tmp->selectors);
1234112343
free (tmp);
1234212344
}
1234312345
else
12344-
variant = variant->next;
12346+
{
12347+
prev_variant = variant;
12348+
variant = variant->next;
12349+
}
1234512350
}
1234612351
/* Replace metadirective by its body if only 'nothing' remains. */
1234712352
if (!code->ext.omp_variants->next && code->ext.omp_variants->stmt == ST_NONE)
Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
! { dg-do compile }
2+
! { dg-additional-options "-Wall" }
3+
4+
! PR fortran/122570
5+
6+
SUBROUTINE INITAL
7+
implicit none (type, external)
8+
integer :: j, n
9+
n = 5
10+
!$omp metadirective &
11+
!$omp& when(user={condition(.true.)}: target teams &
12+
!$omp& distribute parallel do) &
13+
!$omp& when(user={condition(.false.)}: target teams &
14+
!$omp& distribute parallel do)
15+
DO J=1,N
16+
END DO
17+
END SUBROUTINE
18+
19+
SUBROUTINE CALC3
20+
implicit none (type, external)
21+
integer :: i, m
22+
m = 99
23+
!$omp metadirective
24+
!$omp& when(user={condition(.false.)}:
25+
!$omp& simd)
26+
DO 301 I=1,M
27+
301 CONTINUE
28+
300 CONTINUE ! { dg-warning "Label 300 at .1. defined but not used \\\[-Wunused-label\\\]" }
29+
END SUBROUTINE

0 commit comments

Comments
 (0)