Fix openmp global state fortran regression
authorMikael Morin <mikael@gcc.gnu.org>
Fri, 19 Jun 2015 12:50:00 +0000 (12:50 +0000)
committerMikael Morin <mikael@gcc.gnu.org>
Fri, 19 Jun 2015 12:50:00 +0000 (12:50 +0000)
PR fortran/66549
gcc/fortran/
* resolve.c (resolve_global_procedure): Don't save and restore
OpenMP state around the call to gfc_resolve.
(gfc_resolve): Save OpenMP state on entry and restore it on return.
gcc/testsuite/
* gfortran.dg/gomp/omp_parallel_1.f90: New file.

From-SVN: r224648

gcc/fortran/ChangeLog
gcc/fortran/resolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/gomp/omp_parallel_1.f90 [new file with mode: 0644]

index ee6b190c9c5798055050c18185b49bc14a78a607..148bc80cb1369d44fd8f719985d8fc69a2e95351 100644 (file)
@@ -1,3 +1,10 @@
+2015-06-19  Mikael Morin  <mikael@gcc.gnu.org>
+
+       PR fortran/66549
+       * resolve.c (resolve_global_procedure): Don't save and restore
+       OpenMP state around the call to gfc_resolve.
+       (gfc_resolve): Save OpenMP state on entry and restore it on return.
+
 2015-06-17  Andrew MacLeod  <amacleod@redhat.com>
 
        * convert.c: Do not include input.h, line-map.h or is-a.h.
index f365e8ff75c40a4152e77351d891cda8245294fd..e332095ea9d6b9a1462ed49125b69d3c53a9b7a1 100644 (file)
@@ -2384,14 +2384,11 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
       if (!gsym->ns->resolved)
        {
          gfc_dt_list *old_dt_list;
-         struct gfc_omp_saved_state old_omp_state;
 
          /* Stash away derived types so that the backend_decls do not
             get mixed up.  */
          old_dt_list = gfc_derived_types;
          gfc_derived_types = NULL;
-         /* And stash away openmp state.  */
-         gfc_omp_save_and_clear_state (&old_omp_state);
 
          gfc_resolve (gsym->ns);
 
@@ -2401,8 +2398,6 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 
          /* Restore the derived types of this namespace.  */
          gfc_derived_types = old_dt_list;
-         /* And openmp state.  */
-         gfc_omp_restore_state (&old_omp_state);
        }
 
       /* Make sure that translation for the gsymbol occurs before
@@ -15091,6 +15086,7 @@ gfc_resolve (gfc_namespace *ns)
 {
   gfc_namespace *old_ns;
   code_stack *old_cs_base;
+  struct gfc_omp_saved_state old_omp_state;
 
   if (ns->resolved)
     return;
@@ -15099,6 +15095,11 @@ gfc_resolve (gfc_namespace *ns)
   old_ns = gfc_current_ns;
   old_cs_base = cs_base;
 
+  /* As gfc_resolve can be called during resolution of an OpenMP construct
+     body, we should clear any state associated to it, so that say NS's
+     DO loops are not interpreted as OpenMP loops.  */
+  gfc_omp_save_and_clear_state (&old_omp_state);
+
   resolve_types (ns);
   component_assignment_level = 0;
   resolve_codes (ns);
@@ -15108,4 +15109,6 @@ gfc_resolve (gfc_namespace *ns)
   ns->resolved = 1;
 
   gfc_run_passes (ns);
+
+  gfc_omp_restore_state (&old_omp_state);
 }
index 1ca4b686ddccc348f5804bbad1f18ddf9fef92c6..3b3962a1584cf7421f80f2791c1d63c77511b9b4 100644 (file)
@@ -1,3 +1,8 @@
+2015-06-19  Mikael Morin  <mikael@gcc.gnu.org>
+
+       PR fortran/66549
+       * gfortran.dg/gomp/omp_parallel_1.f90: New file.
+
 2015-06-19  Ilya Enkovich  <enkovich.gnu@gmail.com>
 
        * gcc.target/i386/mpx/pr66581.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_parallel_1.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_parallel_1.f90
new file mode 100644 (file)
index 0000000..4bcb563
--- /dev/null
@@ -0,0 +1,37 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/66549
+! The resolution of CVN in the middle CLWF's OpenMP construct was
+! making the DO loop (wrongly) interpreted as an OpenMP-managed loop, leading
+! to an ICE.
+!
+! Contributed by Andrew Benson <abensonca@gmail.com>.
+
+module smfa
+  type :: sgc
+   contains
+     procedure :: sla => sa
+  end type sgc
+  class(sgc), pointer :: sg_
+  double precision, allocatable, dimension(:) :: vni 
+contains
+  double precision function sa(self,i)
+    class(sgc), intent(in   ) :: self
+  end function sa
+  subroutine cvn(sg_,vn)
+    class(sgc), intent(inout) :: sg_
+    double precision, intent(  out), dimension(:) :: vn
+    integer :: i
+    do i=1,2
+       vn(i)= sg_%sla(i)
+    end do
+  end subroutine cvn
+  subroutine clwf()
+    !$omp parallel
+    call cvn(sg_,vni)
+    !$omp end parallel
+  end subroutine clwf
+end module smfa
+
+! { dg-final { scan-tree-dump-times "#pragma\\s+omp\\s+parallel\\n" 1 "original" } }