From 35e99d5d3bd98eb2e2cee5d94ba09b6166dbeab2 Mon Sep 17 00:00:00 2001 From: tschwinge Date: Thu, 28 Feb 2019 20:31:36 +0000 Subject: [PATCH 3/3] [PR72741, PR89433] Repeated use of the Fortran OpenACC 'routine' directive 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@269287 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 ++ gcc/fortran/openmp.c | 43 ++++++++-- gcc/testsuite/ChangeLog | 5 ++ .../goacc/routine-multiple-directives-1.f90 | 58 +++++++++++++ .../goacc/routine-multiple-directives-2.f90 | 82 +++++++++++++++++++ 5 files changed, 185 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1c8f71252980..6adb90aa4c01 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,6 +1,11 @@ 2019-02-28 Thomas Schwinge Cesar Philippidis + 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. diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 50b91f2150ab..7a06eb58f5cf 100644 --- 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 9f4c598951c3..8a36b1f802e1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,6 +1,11 @@ 2019-02-28 Thomas Schwinge Cesar Philippidis + 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. 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 index 000000000000..6e12ee92155c --- /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 index 000000000000..54365ae3f4eb --- /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 -- 2.17.1