projects / platform / upstream / gcc.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: e5fd668)
[PR72741, PR89433] Repeated use of the Fortran OpenACC 'routine' directive
authorThomas Schwinge <thomas@codesourcery.com>
Thu, 28 Feb 2019 20:31:36 +0000 (21:31 +0100)
committerThomas Schwinge <tschwinge@gcc.gnu.org>
Thu, 28 Feb 2019 20:31:36 +0000 (21:31 +0100)
gcc/fortran/
PR fortran/72741
PR fortran/89433
* openmp.c (gfc_match_oacc_routine): Handle repeated use of the
Fortran OpenACC 'routine' directive.
gcc/testsuite/
PR fortran/72741
PR fortran/89433
* gfortran.dg/goacc/routine-multiple-directives-1.f90: New file.
* gfortran.dg/goacc/routine-multiple-directives-2.f90: Likewise.

Co-Authored-By: Cesar Philippidis <cesar@codesourcery.com>
From-SVN: r269287

gcc/fortran/ChangeLog patch | blob | history
gcc/fortran/openmp.c patch | blob | history
gcc/testsuite/ChangeLog patch | blob | history
gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-1.f90 [new file with mode: 0644] patch | blob
gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-2.f90 [new file with mode: 0644] patch | blob

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1c8f712..6adb90a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -2,6 +2,11 @@
            Cesar Philippidis  <cesar@codesourcery.com>
 
        PR fortran/72741
+       PR fortran/89433
+       * openmp.c (gfc_match_oacc_routine): Handle repeated use of the
+       Fortran OpenACC 'routine' directive.
+
+       PR fortran/72741
        * gfortran.h (enum oacc_routine_lop): Add OACC_ROUTINE_LOP_ERROR.
        * openmp.c (gfc_oacc_routine_lop, gfc_match_oacc_routine): Use it.
        * trans-decl.c (add_attributes_to_decl): Likewise.
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 50b91f2..7a06eb5 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2374,17 +2374,44 @@ gfc_match_oacc_routine (void)
     }
   else if (sym != NULL)
     {
-      n = gfc_get_oacc_routine_name ();
-      n->sym = sym;
-      n->clauses = NULL;
-      n->next = NULL;
-      if (gfc_current_ns->oacc_routine_names != NULL)
-       n->next = gfc_current_ns->oacc_routine_names;
-
-      gfc_current_ns->oacc_routine_names = n;
+      bool add = true;
+
+      /* For a repeated OpenACC 'routine' directive, diagnose if it doesn't
+        match the first one.  */
+      for (gfc_oacc_routine_name *n_p = gfc_current_ns->oacc_routine_names;
+          n_p;
+          n_p = n_p->next)
+       if (n_p->sym == sym)
+         {
+           add = false;
+           if (lop != gfc_oacc_routine_lop (n_p->clauses))
+             {
+               gfc_error ("!$ACC ROUTINE already applied at %C");
+               goto cleanup;
+             }
+         }
+
+      if (add)
+       {
+         n = gfc_get_oacc_routine_name ();
+         n->sym = sym;
+         n->clauses = c;
+         n->next = gfc_current_ns->oacc_routine_names;
+         gfc_current_ns->oacc_routine_names = n;
+       }
     }
   else if (gfc_current_ns->proc_name)
     {
+      /* For a repeated OpenACC 'routine' directive, diagnose if it doesn't
+        match the first one.  */
+      oacc_routine_lop lop_p = gfc_current_ns->proc_name->attr.oacc_routine_lop;
+      if (lop_p != OACC_ROUTINE_LOP_NONE
+         && lop != lop_p)
+       {
+         gfc_error ("!$ACC ROUTINE already applied at %C");
+         goto cleanup;
+       }
+
       if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
                                       gfc_current_ns->proc_name->name,
                                       &old_loc))
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9f4c598..8a36b1f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -2,6 +2,11 @@
            Cesar Philippidis  <cesar@codesourcery.com>
 
        PR fortran/72741
+       PR fortran/89433
+       * gfortran.dg/goacc/routine-multiple-directives-1.f90: New file.
+       * gfortran.dg/goacc/routine-multiple-directives-2.f90: Likewise.
+
+       PR fortran/72741
        * gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90: New file.
 
        PR fortran/72741
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-1.f90
new file mode 100644 (file)
index 0000000..6e12ee9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-1.f90
@@ -0,0 +1,58 @@
+! Check for valid cases of multiple OpenACC 'routine' directives.
+
+      SUBROUTINE s_1
+!$ACC ROUTINE(s_1)
+!$ACC ROUTINE(s_1) SEQ
+!$ACC ROUTINE SEQ
+      END SUBROUTINE s_1
+
+      SUBROUTINE s_2
+!$ACC ROUTINE
+!$ACC ROUTINE SEQ
+!$ACC ROUTINE(s_2)
+      END SUBROUTINE s_2
+
+      SUBROUTINE v_1
+!$ACC ROUTINE VECTOR
+!$ACC ROUTINE VECTOR
+!$ACC ROUTINE(v_1) VECTOR
+!$ACC ROUTINE VECTOR
+      END SUBROUTINE v_1
+
+      SUBROUTINE v_2
+!$ACC ROUTINE(v_2) VECTOR
+!$ACC ROUTINE VECTOR
+!$ACC ROUTINE(v_2) VECTOR
+      END SUBROUTINE v_2
+
+      SUBROUTINE sub_1
+      IMPLICIT NONE
+      EXTERNAL :: g_1
+!$ACC ROUTINE (g_1) GANG
+!$ACC ROUTINE (g_1) GANG
+!$ACC ROUTINE (g_1) GANG
+
+      CALL s_1
+      CALL s_2
+      CALL v_1
+      CALL v_2
+      CALL g_1
+      CALL ABORT
+      END SUBROUTINE sub_1
+
+      MODULE m_w_1
+      IMPLICIT NONE
+      EXTERNAL :: w_1
+!$ACC ROUTINE (w_1) WORKER
+!$ACC ROUTINE (w_1) WORKER
+
+      CONTAINS
+      SUBROUTINE sub_2
+      CALL s_1
+      CALL s_2
+      CALL v_1
+      CALL v_2
+      CALL w_1
+      CALL ABORT
+      END SUBROUTINE sub_2
+      END MODULE m_w_1
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-2.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-2.f90
new file mode 100644 (file)
index 0000000..54365ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-2.f90
@@ -0,0 +1,82 @@
+! Check for invalid (and some valid) cases of multiple OpenACC 'routine'
+! directives.
+
+      SUBROUTINE s_1
+!$ACC ROUTINE VECTOR WORKER ! { dg-error "Multiple loop axes specified for routine" }
+!$ACC ROUTINE(s_1)
+!$ACC ROUTINE GANG ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE(s_1) SEQ
+!$ACC ROUTINE
+!$ACC ROUTINE(s_1) WORKER ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE GANG VECTOR ! { dg-error "Multiple loop axes specified for routine" }
+      END SUBROUTINE s_1
+
+      SUBROUTINE s_2
+!$ACC ROUTINE(s_2) VECTOR WORKER ! { dg-error "Multiple loop axes specified for routine" }
+!$ACC ROUTINE
+!$ACC ROUTINE(s_2) GANG ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE SEQ
+!$ACC ROUTINE(s_2)
+!$ACC ROUTINE WORKER ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE(s_2) GANG VECTOR ! { dg-error "Multiple loop axes specified for routine" }
+      END SUBROUTINE s_2
+
+      SUBROUTINE v_1
+!$ACC ROUTINE VECTOR WORKER ! { dg-error "Multiple loop axes specified for routine" }
+!$ACC ROUTINE VECTOR
+!$ACC ROUTINE GANG ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE SEQ ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE(v_1) VECTOR
+!$ACC ROUTINE WORKER ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE GANG VECTOR ! { dg-error "Multiple loop axes specified for routine" }
+      END SUBROUTINE v_1
+
+      SUBROUTINE v_2
+!$ACC ROUTINE(v_2) VECTOR
+!$ACC ROUTINE(v_2) VECTOR WORKER ! { dg-error "Multiple loop axes specified for routine" }
+!$ACC ROUTINE(v_2) ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE VECTOR
+!$ACC ROUTINE(v_2) GANG VECTOR ! { dg-error "Multiple loop axes specified for routine" }
+      END SUBROUTINE v_2
+
+      SUBROUTINE sub_1
+      IMPLICIT NONE
+      EXTERNAL :: g_1
+!$ACC ROUTINE (g_1) GANG
+!$ACC ROUTINE (g_1) GANG WORKER ! { dg-error "Multiple loop axes specified for routine" }
+!$ACC ROUTINE (g_1) VECTOR ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE (g_1) SEQ ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE (g_1) ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE (g_1) GANG
+!$ACC ROUTINE (g_1) ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+
+      CALL s_1
+      CALL s_2
+      CALL v_1
+      CALL v_2
+      CALL g_1
+      CALL ABORT
+      END SUBROUTINE sub_1
+
+      MODULE m_w_1
+      IMPLICIT NONE
+      EXTERNAL :: w_1
+!$ACC ROUTINE (w_1) WORKER
+!$ACC ROUTINE (w_1) WORKER SEQ ! { dg-error "Multiple loop axes specified for routine" }
+!$ACC ROUTINE (w_1) ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE (w_1) WORKER
+!$ACC ROUTINE (w_1) SEQ ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE (w_1) ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE (w_1) VECTOR ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+
+      CONTAINS
+      SUBROUTINE sub_2
+      CALL s_1
+      CALL s_2
+      CALL v_1
+      CALL v_2
+      CALL w_1
+      CALL ABORT
+      END SUBROUTINE sub_2
+      END MODULE m_w_1
Domain: System / Toolchain;