[PR72741] For all Fortran OpenACC 'routine' directive variants check for multiple...

	gcc/fortran/
	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.
	gcc/testsuite/
	PR fortran/72741
	* gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90: New file.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 78c6324..1c8f712 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -2,6 +2,11 @@
            Cesar Philippidis  <cesar@codesourcery.com>
 
        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.
+
+       PR fortran/72741
        PR fortran/89433
        * openmp.c (gfc_match_oacc_routine): Accept intrinsic symbols.
 

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f0258b3..3e0f634 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -323,7 +323,8 @@ enum oacc_routine_lop
   OACC_ROUTINE_LOP_GANG,
   OACC_ROUTINE_LOP_WORKER,
   OACC_ROUTINE_LOP_VECTOR,
-  OACC_ROUTINE_LOP_SEQ
+  OACC_ROUTINE_LOP_SEQ,
+  OACC_ROUTINE_LOP_ERROR
 };
 
 /* Strings for all symbol attributes.  We use these for dumping the

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 6999ac3..50b91f2 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2265,7 +2265,7 @@ gfc_oacc_routine_lop (gfc_omp_clauses *clauses)
        }
 
       if (n_lop_clauses > 1)
-       gfc_error ("Multiple loop axes specified for routine");
+       ret = OACC_ROUTINE_LOP_ERROR;
     }
 
   return ret;
@@ -2280,6 +2280,7 @@ gfc_match_oacc_routine (void)
   gfc_symbol *sym = NULL;
   gfc_omp_clauses *c = NULL;
   gfc_oacc_routine_name *n = NULL;
+  oacc_routine_lop lop = OACC_ROUTINE_LOP_NONE;
 
   old_loc = gfc_current_locus;
 
@@ -2352,6 +2353,13 @@ gfc_match_oacc_routine (void)
          != MATCH_YES))
     return MATCH_ERROR;
 
+  lop = gfc_oacc_routine_lop (c);
+  if (lop == OACC_ROUTINE_LOP_ERROR)
+    {
+      gfc_error ("Multiple loop axes specified for routine at %C");
+      goto cleanup;
+    }
+
   if (isym != NULL)
     {
       /* Diagnose any OpenACC 'routine' directive that doesn't match the
@@ -2381,8 +2389,7 @@ gfc_match_oacc_routine (void)
                                       gfc_current_ns->proc_name->name,
                                       &old_loc))
        goto cleanup;
-      gfc_current_ns->proc_name->attr.oacc_routine_lop
-       = gfc_oacc_routine_lop (c);
+      gfc_current_ns->proc_name->attr.oacc_routine_lop = lop;
     }
   else
     /* Something has gone wrong, possibly a syntax error.  */

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 20d4530..36b7fdd 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1425,6 +1425,7 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
          code = OMP_CLAUSE_SEQ;
          break;
        case OACC_ROUTINE_LOP_NONE:
+       case OACC_ROUTINE_LOP_ERROR:
        default:
          gcc_unreachable ();
        }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c45e7b7..9f4c598 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -2,6 +2,9 @@
            Cesar Philippidis  <cesar@codesourcery.com>
 
        PR fortran/72741
+       * gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90: New file.
+
+       PR fortran/72741
        PR fortran/89433
        * gfortran.dg/goacc/routine-6.f90: Update
        * gfortran.dg/goacc/routine-intrinsic-1.f: New file.

diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90
new file mode 100644 (file)
index 0000000..8ca9be8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90
@@ -0,0 +1,32 @@
+! Check for multiple clauses specifying the level of parallelism.
+
+SUBROUTINE v_1
+  !$ACC ROUTINE VECTOR WORKER ! { dg-error "Multiple loop axes specified for routine" }
+END SUBROUTINE v_1
+
+SUBROUTINE sub_1
+  IMPLICIT NONE
+  EXTERNAL :: g_1
+  !$ACC ROUTINE (g_1) GANG WORKER ! { dg-error "Multiple loop axes specified for routine" }
+  !$ACC ROUTINE (ABORT) SEQ WORKER GANG VECTOR ! { dg-error "Multiple loop axes specified for routine" }
+  !$ACC ROUTINE WORKER SEQ ! { dg-error "Multiple loop axes specified for routine" }
+
+  CALL v_1
+  CALL g_1
+  CALL ABORT
+END SUBROUTINE sub_1
+
+MODULE m_w_1
+  IMPLICIT NONE
+  EXTERNAL :: w_1
+  !$ACC ROUTINE VECTOR GANG SEQ ! { dg-error "Multiple loop axes specified for routine" }
+  !$ACC ROUTINE (w_1) GANG WORKER SEQ ! { dg-error "Multiple loop axes specified for routine" }
+  !$ACC ROUTINE (ABORT) VECTOR GANG ! { dg-error "Multiple loop axes specified for routine" }
+
+CONTAINS
+  SUBROUTINE sub_2
+    CALL v_1
+    CALL w_1
+    CALL ABORT
+  END SUBROUTINE sub_2
+END MODULE m_w_1