https://gcc.gnu.org/g:9bfe96472733b935dc71017dbb880fd8f704f88e

commit 9bfe96472733b935dc71017dbb880fd8f704f88e
Author: Tobias Burnus <[email protected]>
Date:   Wed Nov 5 12:51:37 2025 +0100

    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.

Diff:
---
 gcc/fortran/openmp.cc                     | 13 +++++++++----
 gcc/testsuite/gfortran.dg/gomp/pr122570.f | 29 +++++++++++++++++++++++++++++
 2 files changed, 38 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index c603d3784fd0..0088e705caf2 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -12871,6 +12871,7 @@ static void
 resolve_omp_metadirective (gfc_code *code, gfc_namespace *ns)
 {
   gfc_omp_variant *variant = code->ext.omp_variants;
+  gfc_omp_variant *prev_variant = variant;
 
   while (variant)
     {
@@ -12884,15 +12885,19 @@ resolve_omp_metadirective (gfc_code *code, 
gfc_namespace *ns)
             as the 'otherwise' clause should always match.  */
          if (variant == code->ext.omp_variants && !variant->next)
            break;
-         if (variant == code->ext.omp_variants)
-           code->ext.omp_variants = variant->next;
          gfc_omp_variant *tmp = variant;
-         variant = variant->next;
+         if (variant == code->ext.omp_variants)
+           variant = prev_variant = code->ext.omp_variants = variant->next;
+         else
+           variant = prev_variant->next = variant->next;
          gfc_free_omp_set_selector_list (tmp->selectors);
          free (tmp);
        }
       else
-       variant = variant->next;
+       {
+         prev_variant = variant;
+         variant = variant->next;
+       }
     }
   /* Replace metadirective by its body if only 'nothing' remains.  */
   if (!code->ext.omp_variants->next && code->ext.omp_variants->stmt == ST_NONE)
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122570.f 
b/gcc/testsuite/gfortran.dg/gomp/pr122570.f
new file mode 100644
index 000000000000..9897cc672394
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr122570.f
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-additional-options "-Wall" }
+
+! PR fortran/122570
+
+      SUBROUTINE INITAL
+      implicit none (type, external)
+      integer :: j, n
+      n = 5
+!$omp  metadirective                                                           
 &
+!$omp&    when(user={condition(.true.)}: target teams                          
 &
+!$omp&        distribute parallel do)                                          
 &
+!$omp&    when(user={condition(.false.)}: target teams                         
 &
+!$omp&        distribute parallel do) 
+      DO J=1,N
+      END DO
+      END SUBROUTINE
+
+      SUBROUTINE CALC3
+       implicit none (type, external)
+       integer :: i, m
+       m = 99
+!$omp  metadirective 
+!$omp& when(user={condition(.false.)}:
+!$omp&      simd)               
+      DO 301 I=1,M
+  301 CONTINUE
+  300 CONTINUE ! { dg-warning "Label 300 at .1. defined but not used 
\\\[-Wunused-label\\\]" }
+      END SUBROUTINE

Reply via email to