[PR89773] Fortran OpenACC 'routine' directive refuses procedures with implicit EXTERN...

	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.

From-SVN: r269857

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 111e3a266e9b0d3c62c0161c7edc6d4a0aa1c518..7ce67eb46fe759658a897dbdb6c3e5211bc20829 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,13 @@
 2019-03-21  Thomas Schwinge  <thomas@codesourcery.com>
 
+       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 2f55b9c387a6a9fe86374fbcd339f2e58f7807fb..caf5e528c7e01dc5db84008f2759a226e1972ca4 100644 (file)
--- 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 1b1a0b4108fd8f85f9c58c6a9fa2872467b1e8a3..983b83db4a7b059e4b8d5ed319666187c044cd87 100644 (file)
--- 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 7539aa7038c499694a4fb111ecff548c2c7d0744..e1cd2007e59a35aa90d4cf3fb975360d4fdbada2 100644 (file)
--- 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 0c94f6bcacf8c0af45fc8c2c8ecec53376d55a1d..e771a8743194e2b6d4226352903fdee9592875d7 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2019-03-21  Thomas Schwinge  <thomas@codesourcery.com>
 
+       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 afa0a56a6324edb4ecc533c0d1ad0ff5b0034f4b..e0ea391b9a6d91c1d9861ab118fd85f7756b2650 100644 (file)
--- 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 (file)
index 0000000..e0e5c4f
--- /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 0201b8d1fee5a48024084664a5e365f44f559409..cdf643ff44ce9f3937d3060736e2ff020d1635de 100644 (file)
--- 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