2019-02-28 Thomas Schwinge <thomas@codesourcery.com>
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.
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
}
if (n_lop_clauses > 1)
- gfc_error ("Multiple loop axes specified for routine");
+ ret = OACC_ROUTINE_LOP_ERROR;
}
return ret;
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;
!= 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
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. */
code = OMP_CLAUSE_SEQ;
break;
case OACC_ROUTINE_LOP_NONE:
+ case OACC_ROUTINE_LOP_ERROR:
default:
gcc_unreachable ();
}
2019-02-28 Thomas Schwinge <thomas@codesourcery.com>
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
--- /dev/null
+! 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