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

[PR72741] For all Fortran OpenACC 'routine' directive variants check for multiple clauses specifying the level of parallelism

	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

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.
 

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

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.  */

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 ();
 	}

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.

gcc/testsuite/gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90

+! 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