Hi!
Let me actually break this out of the other pending patches; this should
be uncontroversial. Originally by Cesar, extended by me. OK for trunk?
commit a0fee96c0f204814e87ddf6635f9cbec2afc6887
Author: Thomas Schwinge <tho...@codesourcery.com>
Date: Fri Aug 12 17:19:05 2016 +0200
[PR fortran/72741] Handle intrinsic functions specified in !$ACC ROUTINE (
NAME )
gcc/fortran/
* openmp.c (gfc_match_oacc_routine): Handle intrinsic functions.
gcc/testsuite/
* gfortran.dg/goacc/pr72741-intrinsic-1.f: New file.
* gfortran.dg/goacc/pr72741-intrinsic-2.f: Likewise.
---
gcc/fortran/openmp.c | 26 ++++++++++++++++----
.../gfortran.dg/goacc/pr72741-intrinsic-1.f | 20 +++++++++++++++
.../gfortran.dg/goacc/pr72741-intrinsic-2.f | 22 +++++++++++++++++
3 files changed, 63 insertions(+), 5 deletions(-)
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 9fff994..dc8197e 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -1748,8 +1748,9 @@ match
gfc_match_oacc_routine (void)
{
locus old_loc;
+ match m;
+ gfc_intrinsic_sym *isym = NULL;
gfc_symbol *sym = NULL;
- match m;
gfc_omp_clauses *c = NULL;
gfc_oacc_routine_name *n = NULL;
@@ -1769,12 +1770,14 @@ gfc_match_oacc_routine (void)
if (m == MATCH_YES)
{
char buffer[GFC_MAX_SYMBOL_LEN + 1];
- gfc_symtree *st;
+ gfc_symtree *st = NULL;
m = gfc_match_name (buffer);
if (m == MATCH_YES)
{
- st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
+ if ((isym = gfc_find_function (buffer)) == NULL
+ && (isym = gfc_find_subroutine (buffer)) == NULL)
+ st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
if (st)
{
sym = st->n.sym;
@@ -1782,7 +1785,7 @@ gfc_match_oacc_routine (void)
sym = NULL;
}
- if (st == NULL
+ if ((isym == NULL && st == NULL)
|| (sym
&& !sym->attr.external
&& !sym->attr.function
@@ -1816,7 +1819,18 @@ gfc_match_oacc_routine (void)
!= MATCH_YES))
return MATCH_ERROR;
- if (sym != NULL)
+ if (isym != NULL)
+ {
+ if (c && (c->gang || c->worker || c->vector))
+ {
+ gfc_error ("Intrinsic function specified in !$ACC ROUTINE ( NAME )"
+ " at %C, with incompatible GANG, WORKER, or VECTOR
clause");
+ goto cleanup;
+ }
+ /* The intrinsic symbol has been marked with a SEQ, or with no clause at
+ all, which is OK. */
+ }
+ else if (sym != NULL)
{
n = gfc_get_oacc_routine_name ();
n->sym = sym;
@@ -1836,6 +1850,8 @@ gfc_match_oacc_routine (void)
gfc_current_ns->proc_name->attr.oacc_function
= gfc_oacc_routine_dims (c) + 1;
}
+ else
+ gcc_unreachable ();
if (n)
n->clauses = c;
diff --git gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
new file mode 100644
index 0000000..4bff3e3
--- /dev/null
+++ gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
@@ -0,0 +1,20 @@
+! Check for valid clauses with intrinsic function specified in !$ACC ROUTINE (
NAME ).
+
+ SUBROUTINE sub_1
+ IMPLICIT NONE
+!$ACC ROUTINE (ABORT)
+!$ACC ROUTINE (ABORT) SEQ
+
+ CALL ABORT
+ END SUBROUTINE sub_1
+
+ MODULE m_w_1
+ IMPLICIT NONE
+!$ACC ROUTINE (ABORT) SEQ
+!$ACC ROUTINE (ABORT)
+
+ CONTAINS
+ SUBROUTINE sub_2
+ CALL ABORT
+ END SUBROUTINE sub_2
+ END MODULE m_w_1
diff --git gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
new file mode 100644
index 0000000..fed8e76
--- /dev/null
+++ gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
@@ -0,0 +1,22 @@
+! Check for invalid clauses with intrinsic function specified in !$ACC ROUTINE
( NAME ).
+
+ SUBROUTINE sub_1
+ IMPLICIT NONE
+!$ACC ROUTINE (ABORT) WORKER ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+!$ACC ROUTINE (ABORT) VECTOR ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+
+ CALL ABORT
+ END SUBROUTINE sub_1
+
+ MODULE m_w_1
+ IMPLICIT NONE
+!$ACC ROUTINE (ABORT) VECTOR ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+!$ACC ROUTINE (ABORT) WORKER ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+
+ CONTAINS
+ SUBROUTINE sub_2
+ CALL ABORT
+ END SUBROUTINE sub_2
+ END MODULE m_w_1
Already committed to gomp-4_0-branch in r239422:
commit 490d6fe982666a873ed30d1b2a011090980324e4
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Fri Aug 12 16:12:33 2016 +0000
[PR fortran/72741] Check clauses with intrinsic function specified in !$ACC
ROUTINE ( NAME )
gcc/fortran/
* openmp.c (gfc_match_oacc_routine): Check clauses of intrinsic
functions.
gcc/testsuite/
* gfortran.dg/goacc/pr72741-intrinsic-1.f: New file.
* gfortran.dg/goacc/pr72741-intrinsic-2.f: Likewise.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@239422
138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/fortran/ChangeLog.gomp | 7 ++++++
gcc/fortran/openmp.c | 25 +++++++++++++-------
gcc/testsuite/ChangeLog.gomp | 7 ++++++
.../gfortran.dg/goacc/pr72741-intrinsic-1.f | 20 ++++++++++++++++
.../gfortran.dg/goacc/pr72741-intrinsic-2.f | 22 +++++++++++++++++
5 files changed, 73 insertions(+), 8 deletions(-)
diff --git gcc/fortran/ChangeLog.gomp gcc/fortran/ChangeLog.gomp
index 8744607..8b4ffc9 100644
--- gcc/fortran/ChangeLog.gomp
+++ gcc/fortran/ChangeLog.gomp
@@ -1,3 +1,10 @@
+2016-08-12 Cesar Philippidis <ce...@codesourcery.com>
+ Thomas Schwinge <tho...@codesourcery.com>
+
+ PR fortran/72741
+ * openmp.c (gfc_match_oacc_routine): Check clauses of intrinsic
+ functions.
+
2016-07-29 Chung-Lin Tang <clt...@codesourcery.com>
PR fortran/70598
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index e463df7..80f46c0 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -1919,11 +1919,11 @@ match
gfc_match_oacc_routine (void)
{
locus old_loc;
+ match m;
+ gfc_intrinsic_sym *isym = NULL;
gfc_symbol *sym = NULL;
- match m;
gfc_omp_clauses *c = NULL;
gfc_oacc_routine_name *n = NULL;
- gfc_intrinsic_sym *isym = NULL;
oacc_function dims = OACC_FUNCTION_NONE;
old_loc = gfc_current_locus;
@@ -1957,7 +1957,7 @@ gfc_match_oacc_routine (void)
sym = NULL;
}
- if ((st == NULL && isym == NULL)
+ if ((isym == NULL && st == NULL)
|| (sym
&& !sym->attr.external
&& !sym->attr.function
@@ -1996,14 +1996,21 @@ gfc_match_oacc_routine (void)
dims = gfc_oacc_routine_dims (c);
if (dims == OACC_FUNCTION_NONE)
{
- gfc_error ("Multiple loop axes specified for routine %C");
- gfc_current_locus = old_loc;
- return MATCH_ERROR;
+ gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at %C");
+ goto cleanup;
}
if (isym != NULL)
- /* There is nothing to do for intrinsic procedures. */
- ;
+ {
+ if (c && (c->gang || c->worker || c->vector))
+ {
+ gfc_error ("Intrinsic function specified in !$ACC ROUTINE ( NAME )"
+ " at %C, with incompatible GANG, WORKER, or VECTOR
clause");
+ goto cleanup;
+ }
+ /* The intrinsic symbol has been marked with a SEQ, or with no clause at
+ all, which is OK. */
+ }
else if (sym != NULL)
{
n = gfc_get_oacc_routine_name ();
@@ -2025,6 +2032,8 @@ gfc_match_oacc_routine (void)
gfc_current_ns->proc_name->attr.oacc_function_nohost
= c ? c->nohost : false;
}
+ else
+ gcc_unreachable ();
if (n)
n->clauses = c;
diff --git gcc/testsuite/ChangeLog.gomp gcc/testsuite/ChangeLog.gomp
index 0b96504..8de44b6 100644
--- gcc/testsuite/ChangeLog.gomp
+++ gcc/testsuite/ChangeLog.gomp
@@ -1,3 +1,10 @@
+2016-08-12 Cesar Philippidis <ce...@codesourcery.com>
+ Thomas Schwinge <tho...@codesourcery.com>
+
+ PR fortran/72741
+ * gfortran.dg/goacc/pr72741-intrinsic-1.f: New file.
+ * gfortran.dg/goacc/pr72741-intrinsic-2.f: Likewise.
+
2016-08-04 Thomas Schwinge <tho...@codesourcery.com>
* g++.dg/goacc/routine-2.C: Update.
diff --git gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
new file mode 100644
index 0000000..4bff3e3
--- /dev/null
+++ gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
@@ -0,0 +1,20 @@
+! Check for valid clauses with intrinsic function specified in !$ACC ROUTINE (
NAME ).
+
+ SUBROUTINE sub_1
+ IMPLICIT NONE
+!$ACC ROUTINE (ABORT)
+!$ACC ROUTINE (ABORT) SEQ
+
+ CALL ABORT
+ END SUBROUTINE sub_1
+
+ MODULE m_w_1
+ IMPLICIT NONE
+!$ACC ROUTINE (ABORT) SEQ
+!$ACC ROUTINE (ABORT)
+
+ CONTAINS
+ SUBROUTINE sub_2
+ CALL ABORT
+ END SUBROUTINE sub_2
+ END MODULE m_w_1
diff --git gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
new file mode 100644
index 0000000..fed8e76
--- /dev/null
+++ gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
@@ -0,0 +1,22 @@
+! Check for invalid clauses with intrinsic function specified in !$ACC ROUTINE
( NAME ).
+
+ SUBROUTINE sub_1
+ IMPLICIT NONE
+!$ACC ROUTINE (ABORT) WORKER ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+!$ACC ROUTINE (ABORT) VECTOR ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+
+ CALL ABORT
+ END SUBROUTINE sub_1
+
+ MODULE m_w_1
+ IMPLICIT NONE
+!$ACC ROUTINE (ABORT) VECTOR ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+!$ACC ROUTINE (ABORT) WORKER ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic function specified in
\\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or
VECTOR clause" }
+
+ CONTAINS
+ SUBROUTINE sub_2
+ CALL ABORT
+ END SUBROUTINE sub_2
+ END MODULE m_w_1
Grüße
Thomas
