[gomp4] check for sufficient parallelism when calling acc routines in fortran

classic Classic list List threaded Threaded
3 messages Options
Reply | Threaded
Open this post in threaded view
|

[gomp4] check for sufficient parallelism when calling acc routines in fortran

Cesar Philippidis
This patch teaches the fortran FE how to verify that there is sufficient
parallelism when calling acc routines inside acc loop. E.g. the fortran
FE will now error if you call a gang routine from a vector loop, because
there's no way for vector partitioned code to spawn new gangs with the
OpenACC current execution model.

While working on this, I noticed that the fortran FE wasn't permitting
named functions inside acc routine directives. E.g.

  integer :: foo
  !$acc routine(foo) gang

  ... = foo ()

This patch also fixes this issue. But to do that, I had to add a
gfc_resolve_oacc_routines pass in order to identify if a variable is a
function or variable because that information isn't available during
matching.

I've applied this patch to gomp-4_0-branch.

Cesar

gomp4-named_function_routines.diff (28K) Download Attachment
Reply | Threaded
Open this post in threaded view
|

[PATCH] [PR89773] Fortran OpenACC 'routine' directive refuses procedures with implicit EXTERNAL attribute

Thomas Schwinge-8
Hi!

On Fri, 26 Aug 2016 08:16:43 -0700, Cesar Philippidis <[hidden email]> wrote:
> While working on [...], I noticed

If only all such issues would end up in their own PRs, instead of mixing
them with other changes...

> that the fortran FE wasn't permitting
> named functions inside acc routine directives. E.g.
>
>   integer :: foo
>   !$acc routine(foo) gang
>
>   ... = foo ()

ACK.  Perhaps not the most pretty style, but gfortran does accept this.

Do I understand right that there exists no equivalent syntax in Fortran
to declare a subroutine (instead of a function) with implicit EXTERNAL
attribute?  (See also the new 'gfortran.dg/goacc/pr89773.f90' test case
I'm adding.)

> This patch also fixes this issue. But to do that, I had to add a
> gfc_resolve_oacc_routines pass in order to identify if a variable is a
> function or variable because that information isn't available during
> matching.

OK to fix this as in the attached patch?  If approving this patch, please
respond with "Reviewed-by: NAME <EMAIL>" so that your effort will be
recorded in the commit log, see <https://gcc.gnu.org/wiki/Reviewed-by>.


Grüße
 Thomas



From 38d953f51280e6fc327af6b8e35e10ef5d70d589 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <[hidden email]>
Date: Wed, 20 Mar 2019 10:58:58 +0100
Subject: [PATCH] [PR89773] Fortran OpenACC 'routine' directive refuses
 procedures with implicit EXTERNAL attribute

        gcc/fortran/
        PR fortran/89773
        * gfortran.h (gfc_oacc_routine_name): Add loc member.
        (gfc_resolve_oacc_routines): Declare.
        * openmp.c (gfc_match_oacc_routine): Move some error checking
        into...
        (gfc_resolve_oacc_routines): ... this new function.
        * resolve.c (resolve_codes): Call it.
        gcc/testsuite/
        PR fortran/89773
        * gfortran.dg/goacc/pr89773.f90: New file.
        * gfortran.dg/goacc/pr77765.f90: Adjust.
        * gfortran.dg/goacc/routine-6.f90: Adjust, and extend.
---
 gcc/fortran/gfortran.h                        |  2 ++
 gcc/fortran/openmp.c                          | 30 +++++++++++-----
 gcc/fortran/resolve.c                         |  1 +
 gcc/testsuite/gfortran.dg/goacc/pr77765.f90   |  2 +-
 gcc/testsuite/gfortran.dg/goacc/pr89773.f90   | 36 +++++++++++++++++++
 gcc/testsuite/gfortran.dg/goacc/routine-6.f90 | 21 +++++++++--
 6 files changed, 80 insertions(+), 12 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/pr89773.f90

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2f55b9c387a6..caf5e528c7e0 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1739,6 +1739,7 @@ typedef struct gfc_oacc_routine_name
   struct gfc_symbol *sym;
   struct gfc_omp_clauses *clauses;
   struct gfc_oacc_routine_name *next;
+  locus loc;
 }
 gfc_oacc_routine_name;
 
@@ -3210,6 +3211,7 @@ void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *);
 void gfc_resolve_oacc_declare (gfc_namespace *);
 void gfc_resolve_oacc_parallel_loop_blocks (gfc_code *, gfc_namespace *);
 void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_routines (gfc_namespace *);
 
 /* expr.c */
 void gfc_free_actual_arglist (gfc_actual_arglist *);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 7a06eb58f5cf..69b05084dc06 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2319,15 +2319,10 @@ gfc_match_oacc_routine (void)
         sym = NULL;
     }
 
-  if ((isym == NULL && st == NULL)
-      || (sym
-  && !sym->attr.external
-  && !sym->attr.function
-  && !sym->attr.subroutine))
+  if (isym == NULL && st == NULL)
     {
-      gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, "
- "invalid function name %s",
- (sym) ? sym->name : buffer);
+      gfc_error ("Invalid NAME %qs in !$ACC ROUTINE ( NAME ) at %C",
+ buffer);
       gfc_current_locus = old_loc;
       return MATCH_ERROR;
     }
@@ -2397,6 +2392,7 @@ gfc_match_oacc_routine (void)
   n->sym = sym;
   n->clauses = c;
   n->next = gfc_current_ns->oacc_routine_names;
+  n->loc = old_loc;
   gfc_current_ns->oacc_routine_names = n;
  }
     }
@@ -6069,6 +6065,24 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
     }
 }
 
+
+void
+gfc_resolve_oacc_routines (gfc_namespace *ns)
+{
+  for (gfc_oacc_routine_name *orn = ns->oacc_routine_names;
+       orn;
+       orn = orn->next)
+    {
+      gfc_symbol *sym = orn->sym;
+      if (!sym->attr.external
+  && !sym->attr.function
+  && !sym->attr.subroutine)
+ gfc_error ("NAME %qs does not refer to a subroutine or function"
+   " in !$ACC ROUTINE ( NAME ) at %L", sym->name, &orn->loc);
+    }
+}
+
+
 void
 gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
 {
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7539aa7038c4..e1cd2007e59a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -16818,6 +16818,7 @@ resolve_codes (gfc_namespace *ns)
   bitmap_obstack_initialize (&labels_obstack);
 
   gfc_resolve_oacc_declare (ns);
+  gfc_resolve_oacc_routines (ns);
   gfc_resolve_omp_local_vars (ns);
   gfc_resolve_code (ns->code, ns);
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr77765.f90 b/gcc/testsuite/gfortran.dg/goacc/pr77765.f90
index afa0a56a6324..e0ea391b9a6d 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr77765.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr77765.f90
@@ -14,5 +14,5 @@ end module m
 
 ! { dg-error "Procedure 'f' at .1. is already defined" "" { target *-*-* } 8 }
 ! { dg-error ".1." "" { target *-*-* } 10 }
-! { dg-error "Syntax error in ..ACC ROUTINE . NAME . at .1., invalid function name f" "" { target *-*-* } 11 }
+! { dg-error "Invalid NAME 'f' in \\!\\\$ACC ROUTINE \\( NAME \\)" "" { target *-*-* } 11 }
 ! { dg-error "Expecting END MODULE statement" "" { target *-*-* } 12 }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr89773.f90 b/gcc/testsuite/gfortran.dg/goacc/pr89773.f90
new file mode 100644
index 000000000000..f709c033edd9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pr89773.f90
@@ -0,0 +1,36 @@
+! Valid usage of external procedures with OpenACC 'routine' directives.
+
+! { dg-additional-options "-fdump-tree-optimized-raw" }
+
+  subroutine test (x)
+    implicit none
+    integer, intent(inout) :: x
+    !$acc routine (test)
+
+    integer, external :: f_1
+    !$acc routine (f_1)
+
+    integer f_2 ! No explicit EXTERNAL attribute.
+    !$acc routine (f_2)
+
+    external s_1
+    !$acc routine (s_1)
+
+    ! 's_2' will be an external subroutine without explicit EXTERNAL
+    ! attribute, but we don't have a handle for it yet...
+    !!$acc routine (s_2) ..., so can't specify this, here.
+
+    if (x < 1) then
+       x = 1
+    else
+       x = x * x - 1 + f_1(f_2(x))
+       call s_1(x)
+       call s_2(x)
+    end if
+  end subroutine test
+
+! { dg-final { scan-tree-dump-times "gimple_call" 4 "optimized" } }
+! { dg-final { scan-tree-dump-times "gimple_call <f_1," 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "gimple_call <f_2," 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "gimple_call <s_1," 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "gimple_call <s_2," 1 "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
index 0201b8d1fee5..cdf643ff44ce 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
@@ -5,19 +5,30 @@ module m
 contains
   subroutine subr5 (x)
   implicit none
+  !$acc routine (m) ! { dg-error "Invalid NAME 'm' in \\!\\\$ACC ROUTINE \\( NAME \\)" }
   !$acc routine (subr5)
-  !$acc routine (m1int) ! { dg-error "invalid function name" }
+  !$acc routine (m1int) ! { dg-error "Invalid NAME 'm1int' in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  integer f_1 ! Referenced.
+  !$acc routine (f_1)
+  integer f_2 ! Not referenced.
+  !$acc routine (f_2) ! { dg-error "NAME 'f_2' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  integer v_1
+  !$acc routine (v_1) ! { dg-error "NAME 'v_1' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
   integer, intent(inout) :: x
+  !$acc routine (x) ! { dg-error "NAME 'x' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  v_1 = x
   if (x < 1) then
      x = 1
   else
      x = x * x - 1
+     x = f_1(x) + v_1
   end if
   end subroutine subr5
 end module m
 
 program main
   implicit none
+  !$acc routine (main) ! { dg-error "PROGRAM attribute conflicts with SUBROUTINE attribute in 'main'" }
   interface
     function subr6 (x)
     !$acc routine (subr6) ! { dg-error "without list is allowed in interface" }
@@ -27,7 +38,10 @@ program main
   end interface
   integer, parameter :: n = 10
   integer :: a(n), i
-  !$acc routine (subr1) ! { dg-error "invalid function name" }
+  !$acc routine (n) ! { dg-error "NAME 'n' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  !$acc routine (a) ! { dg-error "NAME 'a' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  !$acc routine (i) ! { dg-error "NAME 'i' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  !$acc routine (subr1) ! { dg-error "Invalid NAME 'subr1' in \\!\\\$ACC ROUTINE \\( NAME \\)" }
   external :: subr2
   !$acc routine (subr2)
 
@@ -63,8 +77,9 @@ subroutine subr1 (x)
 end subroutine subr1
 
 subroutine subr2 (x)
-  !$acc routine (subr1) ! { dg-error "invalid function name" }
+  !$acc routine (subr1) ! { dg-error "Invalid NAME 'subr1' in \\!\\\$ACC ROUTINE \\( NAME \\)" }
   integer, intent(inout) :: x
+  !$acc routine (x) ! { dg-error "NAME 'x' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
   if (x < 1) then
      x = 1
   else
--
2.17.1

Reply | Threaded
Open this post in threaded view
|

Re: [PATCH] [PR89773] Fortran OpenACC 'routine' directive refuses procedures with implicit EXTERNAL attribute

Thomas Schwinge-8
Hi!

On Wed, 20 Mar 2019 11:07:31 +0100, I wrote:

> On Fri, 26 Aug 2016 08:16:43 -0700, Cesar Philippidis <[hidden email]> wrote:
> > While working on [...], I noticed
>
> If only all such issues would end up in their own PRs, instead of mixing
> them with other changes...
>
> > that the fortran FE wasn't permitting
> > named functions inside acc routine directives. E.g.
> >
> >   integer :: foo
> >   !$acc routine(foo) gang
> >
> >   ... = foo ()
>
> ACK.  Perhaps not the most pretty style, but gfortran does accept this.
>
> Do I understand right that there exists no equivalent syntax in Fortran
> to declare a subroutine (instead of a function) with implicit EXTERNAL
> attribute?  (See also the new 'gfortran.dg/goacc/pr89773.f90' test case
> I'm adding.)
(Still interested if there's a way to do that.)

> > This patch also fixes this issue. But to do that, I had to add a
> > gfc_resolve_oacc_routines pass in order to identify if a variable is a
> > function or variable because that information isn't available during
> > matching.
>
> OK to fix this as in the attached patch?

I convinced myself that my proposed changes are the right thing to do,
and committed to trunk r269857 "[PR89773] Fortran OpenACC 'routine'
directive refuses procedures with implicit EXTERNAL attribute", see
attached.


Grüße
 Thomas



From cbfb10ec630fc5829bdfebbf59ba40d22874c9e2 Mon Sep 17 00:00:00 2001
From: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Thu, 21 Mar 2019 20:02:42 +0000
Subject: [PATCH] [PR89773] Fortran OpenACC 'routine' directive refuses
 procedures with implicit EXTERNAL attribute

        gcc/fortran/
        PR fortran/89773
        * gfortran.h (gfc_oacc_routine_name): Add loc member.
        (gfc_resolve_oacc_routines): Declare.
        * openmp.c (gfc_match_oacc_routine): Move some error checking
        into...
        (gfc_resolve_oacc_routines): ... this new function.
        * resolve.c (resolve_codes): Call it.
        gcc/testsuite/
        PR fortran/89773
        * gfortran.dg/goacc/pr89773.f90: New file.
        * gfortran.dg/goacc/pr77765.f90: Adjust.
        * gfortran.dg/goacc/routine-6.f90: Adjust, and extend.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@269857 138bc75d-0d04-0410-961f-82ee72b054a4
---
 gcc/fortran/ChangeLog                         |  8 +++++
 gcc/fortran/gfortran.h                        |  2 ++
 gcc/fortran/openmp.c                          | 33 ++++++++++++-----
 gcc/fortran/resolve.c                         |  1 +
 gcc/testsuite/ChangeLog                       |  5 +++
 gcc/testsuite/gfortran.dg/goacc/pr77765.f90   |  2 +-
 gcc/testsuite/gfortran.dg/goacc/pr89773.f90   | 36 +++++++++++++++++++
 gcc/testsuite/gfortran.dg/goacc/routine-6.f90 | 21 +++++++++--
 8 files changed, 96 insertions(+), 12 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/pr89773.f90

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 111e3a266e9b..7ce67eb46fe7 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,13 @@
 2019-03-21  Thomas Schwinge  <[hidden email]>
 
+ PR fortran/89773
+ * gfortran.h (gfc_oacc_routine_name): Add loc member.
+ (gfc_resolve_oacc_routines): Declare.
+ * openmp.c (gfc_match_oacc_routine): Move some error checking
+ into...
+ (gfc_resolve_oacc_routines): ... this new function.
+ * resolve.c (resolve_codes): Call it.
+
  PR fortran/72741
  * openmp.c (gfc_match_oacc_routine): Clarify.
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2f55b9c387a6..caf5e528c7e0 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1739,6 +1739,7 @@ typedef struct gfc_oacc_routine_name
   struct gfc_symbol *sym;
   struct gfc_omp_clauses *clauses;
   struct gfc_oacc_routine_name *next;
+  locus loc;
 }
 gfc_oacc_routine_name;
 
@@ -3210,6 +3211,7 @@ void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *);
 void gfc_resolve_oacc_declare (gfc_namespace *);
 void gfc_resolve_oacc_parallel_loop_blocks (gfc_code *, gfc_namespace *);
 void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_routines (gfc_namespace *);
 
 /* expr.c */
 void gfc_free_actual_arglist (gfc_actual_arglist *);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 1b1a0b4108fd..983b83db4a7b 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2322,15 +2322,10 @@ gfc_match_oacc_routine (void)
         sym = NULL;
     }
 
-  if ((isym == NULL && st == NULL)
-      || (sym
-  && !sym->attr.external
-  && !sym->attr.function
-  && !sym->attr.subroutine))
+  if (isym == NULL && st == NULL)
     {
-      gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, "
- "invalid function name %s",
- (sym) ? sym->name : buffer);
+      gfc_error ("Invalid NAME %qs in !$ACC ROUTINE ( NAME ) at %C",
+ buffer);
       gfc_current_locus = old_loc;
       return MATCH_ERROR;
     }
@@ -2400,6 +2395,7 @@ gfc_match_oacc_routine (void)
   n->sym = sym;
   n->clauses = c;
   n->next = gfc_current_ns->oacc_routine_names;
+  n->loc = old_loc;
   gfc_current_ns->oacc_routine_names = n;
  }
     }
@@ -6072,6 +6068,27 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
     }
 }
 
+
+void
+gfc_resolve_oacc_routines (gfc_namespace *ns)
+{
+  for (gfc_oacc_routine_name *orn = ns->oacc_routine_names;
+       orn;
+       orn = orn->next)
+    {
+      gfc_symbol *sym = orn->sym;
+      if (!sym->attr.external
+  && !sym->attr.function
+  && !sym->attr.subroutine)
+ {
+  gfc_error ("NAME %qs does not refer to a subroutine or function"
+     " in !$ACC ROUTINE ( NAME ) at %L", sym->name, &orn->loc);
+  continue;
+ }
+    }
+}
+
+
 void
 gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
 {
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7539aa7038c4..e1cd2007e59a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -16818,6 +16818,7 @@ resolve_codes (gfc_namespace *ns)
   bitmap_obstack_initialize (&labels_obstack);
 
   gfc_resolve_oacc_declare (ns);
+  gfc_resolve_oacc_routines (ns);
   gfc_resolve_omp_local_vars (ns);
   gfc_resolve_code (ns->code, ns);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0c94f6bcacf8..e771a8743194 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2019-03-21  Thomas Schwinge  <[hidden email]>
 
+ PR fortran/89773
+ * gfortran.dg/goacc/pr89773.f90: New file.
+ * gfortran.dg/goacc/pr77765.f90: Adjust.
+ * gfortran.dg/goacc/routine-6.f90: Adjust, and extend.
+
  PR fortran/72741
  * gfortran.dg/goacc/routine-module-mod-1.f90: Update.
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr77765.f90 b/gcc/testsuite/gfortran.dg/goacc/pr77765.f90
index afa0a56a6324..e0ea391b9a6d 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr77765.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr77765.f90
@@ -14,5 +14,5 @@ end module m
 
 ! { dg-error "Procedure 'f' at .1. is already defined" "" { target *-*-* } 8 }
 ! { dg-error ".1." "" { target *-*-* } 10 }
-! { dg-error "Syntax error in ..ACC ROUTINE . NAME . at .1., invalid function name f" "" { target *-*-* } 11 }
+! { dg-error "Invalid NAME 'f' in \\!\\\$ACC ROUTINE \\( NAME \\)" "" { target *-*-* } 11 }
 ! { dg-error "Expecting END MODULE statement" "" { target *-*-* } 12 }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr89773.f90 b/gcc/testsuite/gfortran.dg/goacc/pr89773.f90
new file mode 100644
index 000000000000..e0e5c4f6af5b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pr89773.f90
@@ -0,0 +1,36 @@
+! Valid usage of 'external' procedures with OpenACC 'routine' directives.
+
+! { dg-additional-options "-fdump-tree-optimized-raw" }
+
+  subroutine test (x)
+    implicit none
+    integer, intent(inout) :: x
+    !$acc routine (test)
+
+    integer, external :: f_1
+    !$acc routine (f_1)
+
+    integer f_2 ! No explicit EXTERNAL attribute.
+    !$acc routine (f_2)
+
+    external s_1
+    !$acc routine (s_1)
+
+    ! 's_2' will be an external subroutine without explicit EXTERNAL
+    ! attribute, but we don't have a handle for it yet...
+    !!$acc routine (s_2) ..., so can't specify this, here.
+
+    if (x < 1) then
+       x = 1
+    else
+       x = x * x - 1 + f_1(f_2(x))
+       call s_1(x)
+       call s_2(x)
+    end if
+  end subroutine test
+
+! { dg-final { scan-tree-dump-times "gimple_call" 4 "optimized" } }
+! { dg-final { scan-tree-dump-times "gimple_call <f_1," 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "gimple_call <f_2," 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "gimple_call <s_1," 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "gimple_call <s_2," 1 "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
index 0201b8d1fee5..cdf643ff44ce 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
@@ -5,19 +5,30 @@ module m
 contains
   subroutine subr5 (x)
   implicit none
+  !$acc routine (m) ! { dg-error "Invalid NAME 'm' in \\!\\\$ACC ROUTINE \\( NAME \\)" }
   !$acc routine (subr5)
-  !$acc routine (m1int) ! { dg-error "invalid function name" }
+  !$acc routine (m1int) ! { dg-error "Invalid NAME 'm1int' in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  integer f_1 ! Referenced.
+  !$acc routine (f_1)
+  integer f_2 ! Not referenced.
+  !$acc routine (f_2) ! { dg-error "NAME 'f_2' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  integer v_1
+  !$acc routine (v_1) ! { dg-error "NAME 'v_1' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
   integer, intent(inout) :: x
+  !$acc routine (x) ! { dg-error "NAME 'x' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  v_1 = x
   if (x < 1) then
      x = 1
   else
      x = x * x - 1
+     x = f_1(x) + v_1
   end if
   end subroutine subr5
 end module m
 
 program main
   implicit none
+  !$acc routine (main) ! { dg-error "PROGRAM attribute conflicts with SUBROUTINE attribute in 'main'" }
   interface
     function subr6 (x)
     !$acc routine (subr6) ! { dg-error "without list is allowed in interface" }
@@ -27,7 +38,10 @@ program main
   end interface
   integer, parameter :: n = 10
   integer :: a(n), i
-  !$acc routine (subr1) ! { dg-error "invalid function name" }
+  !$acc routine (n) ! { dg-error "NAME 'n' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  !$acc routine (a) ! { dg-error "NAME 'a' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  !$acc routine (i) ! { dg-error "NAME 'i' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
+  !$acc routine (subr1) ! { dg-error "Invalid NAME 'subr1' in \\!\\\$ACC ROUTINE \\( NAME \\)" }
   external :: subr2
   !$acc routine (subr2)
 
@@ -63,8 +77,9 @@ subroutine subr1 (x)
 end subroutine subr1
 
 subroutine subr2 (x)
-  !$acc routine (subr1) ! { dg-error "invalid function name" }
+  !$acc routine (subr1) ! { dg-error "Invalid NAME 'subr1' in \\!\\\$ACC ROUTINE \\( NAME \\)" }
   integer, intent(inout) :: x
+  !$acc routine (x) ! { dg-error "NAME 'x' does not refer to a subroutine or function in \\!\\\$ACC ROUTINE \\( NAME \\)" }
   if (x < 1) then
      x = 1
   else
--
2.17.1


signature.asc (671 bytes) Download Attachment