[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. Co-Authored-By: Cesar Philippidis <cesar@codesourcery.com> From-SVN: r269287
This commit is contained in:
Thomas Schwinge
Thomas Schwinge
parent
e5fd6684b9
commit
80d6ca0184
@ -1,6 +1,11 @@
|
||||
2019-02-28 Thomas Schwinge <thomas@codesourcery.com>
|
||||
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.
|
||||
|
||||
@ -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;
|
||||
bool add = true;
|
||||
|
||||
gfc_current_ns->oacc_routine_names = n;
|
||||
/* 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))
|
||||
|
||||
@ -1,6 +1,11 @@
|
||||
2019-02-28 Thomas Schwinge <thomas@codesourcery.com>
|
||||
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.
|
||||
|
||||
|
||||
@ -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
|
||||
@ -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
|
||||
Loading…
Reference in New Issue
Block a user