[flang][OpenACC] Accept ROUTINE directive within an interface block (#206863)

An `!$acc routine` directive placed directly within an interface block (as an
interface-specification, e.g. preceding the interface body it names) failed to
parse and produced a misleading cascade of errors.

Accept the OpenACC ROUTINE directive as an additional interface-specification
alternative, mirroring the existing extension that allows a ROUTINE directive in
a module subprogram part / at the top level. The grammar is widened narrowly to
the ROUTINE construct only (not the whole OpenACC declarative construct). A named
directive applies to the interface body it names; name resolution already runs in
a separate pass after the interface-body symbols are created, so the 
directive-before-body ordering resolves correctly and the ROUTINE information is
attached to the named procedure's symbol.

This is documented as a Flang extension in OpenACC-extensions.md.

Assisted-by: AI

flang/docs/OpenACC-extensions.md

@@ -34,6 +34,13 @@ These extensions require no flag.
 * The `if` clause accepts scalar integer expressions in addition to scalar
   logical expressions.
 * `!$acc routine` directives can be placed at the top level.
+* `!$acc routine` directives can be placed directly within an interface block
+  (i.e. as an interface-specification, such as preceding the interface body they
+  name). The OpenACC specification only permits the named `routine` directive in
+  the specification part of a subroutine, function, or module, and the unnamed
+  form within an interface body; Flang additionally accepts a `routine`
+  directive between the `INTERFACE` statement and the interface bodies, applying
+  a named directive to the interface body it names.
 * `!$acc cache` directives accept scalar variables.
 * `!$acc cache` directives are accepted outside of a loop construct.
 * The `!$acc declare` directive accepts assumed-size array arguments for

flang/include/flang/Parser/parse-tree.h

@@ -3237,10 +3237,14 @@ struct ProcedureStmt {
 
 // R1502 interface-specification ->
 //         interface-body | procedure-stmt | compiler-directive
+// Flang extension: an OpenACC ROUTINE directive is also accepted directly
+// within an interface block, e.g. a named directive preceding the interface
+// body it applies to.
 struct InterfaceSpecification {
   UNION_CLASS_BOILERPLATE(InterfaceSpecification);
   std::variant<InterfaceBody, Statement<ProcedureStmt>,
-      common::Indirection<CompilerDirective>>
+      common::Indirection<CompilerDirective>,
+      common::Indirection<OpenACCRoutineConstruct>>
       u;
 };
 

flang/lib/Parser/program-parsers.cpp

@@ -377,8 +377,12 @@ TYPE_PARSER(construct<InterfaceBlock>(statement(Parser<InterfaceStmt>{}),
 
 // R1502 interface-specification ->
 //         interface-body | procedure-stmt | compiler-directive
+// Flang extension: an OpenACC ROUTINE directive is also accepted directly
+// within an interface block (e.g. preceding the interface body it names).
 TYPE_PARSER(construct<InterfaceSpecification>(Parser<InterfaceBody>{}) ||
     construct<InterfaceSpecification>(statement(Parser<ProcedureStmt>{})) ||
+    construct<InterfaceSpecification>(indirect(skipStuffBeforeStatement >>
+        "!$ACC "_sptok >> Parser<OpenACCRoutineConstruct>{} / endOfLine)) ||
     construct<InterfaceSpecification>(indirect(compilerDirective)))
 
 // R1503 interface-stmt -> INTERFACE [generic-spec] | ABSTRACT INTERFACE

flang/test/Parser/acc-routine-in-interface.f90

@@ -0,0 +1,26 @@
+! RUN: %flang_fc1 -fopenacc -fdebug-unparse %s | FileCheck %s
+! RUN: %flang_fc1 -fopenacc -fdebug-dump-parse-tree %s | FileCheck %s --check-prefix=TREE
+
+! Flang extension: an !$acc routine directive is accepted directly within an
+! interface block (as an interface-specification), e.g. preceding the named
+! interface body it applies to.  The OpenACC specification only permits the
+! named routine directive in the specification part of a subroutine, function,
+! or module.
+
+program p
+  implicit none
+  interface
+  !$acc routine (foo) seq
+  subroutine foo() bind(c, name="foo")
+  end subroutine foo
+  end interface
+end program p
+
+! CHECK: INTERFACE
+! CHECK: !$ACC ROUTINE(foo) SEQ
+! CHECK: SUBROUTINE foo () BIND(C, NAME="foo")
+! CHECK: END SUBROUTINE foo
+! CHECK: END INTERFACE
+
+! TREE: InterfaceSpecification -> OpenACCRoutineConstruct
+! TREE: InterfaceSpecification -> InterfaceBody -> Subroutine

flang/test/Semantics/OpenACC/acc-routine-in-interface-name-mismatch.f90

@@ -0,0 +1,35 @@
+! RUN: %flang_fc1 -fopenacc -fdebug-dump-symbols %s 2>&1 | FileCheck %s --implicit-check-not=openACCRoutineInfos
+
+! When the name on an !$acc routine directive in an interface block matches no
+! interface body, flang resolves it the same lenient way it does in every other
+! position: the name is bound to an (implicit) external procedure rather than
+! diagnosed, the directive is accepted without a crash, and the interface body
+! receives no ROUTINE information.  Both placements of the directive are covered:
+!   - 'm_in_block': the directive sits directly in the interface block.
+!   - 'm_in_body': the directive sits inside the subroutine interface body.
+
+module m_in_block
+  implicit none
+  interface
+  !$acc routine (no_block) seq
+  subroutine sub_block() bind(c, name="sub_block")
+  end subroutine sub_block
+  end interface
+end module m_in_block
+
+module m_in_body
+  implicit none
+  interface
+  subroutine sub_body() bind(c, name="sub_body")
+  !$acc routine (no_body) seq
+  end subroutine sub_body
+  end interface
+end module m_in_body
+
+! Each mismatched name resolves to an implicit external procedure ...
+! CHECK-DAG: no_block: ProcEntity
+! CHECK-DAG: no_body: ProcEntity
+! ... and neither interface body receives the ROUTINE information (asserted by
+! --implicit-check-not=openACCRoutineInfos on the RUN line).
+! CHECK-DAG: sub_block, BIND(C), EXTERNAL, PUBLIC (Subroutine): Subprogram isInterface
+! CHECK-DAG: sub_body, BIND(C), EXTERNAL, PUBLIC (Subroutine): Subprogram isInterface

flang/test/Semantics/OpenACC/acc-routine-in-interface.f90

@@ -0,0 +1,17 @@
+! RUN: %flang_fc1 -fopenacc -fdebug-dump-symbols %s 2>&1 | FileCheck %s
+
+! Flang extension: a named !$acc routine directive placed directly within an
+! interface block applies to the interface body it names.  Verify that the
+! ROUTINE information is attached to the named procedure's symbol and that no
+! diagnostic is produced.
+
+program p
+  implicit none
+  interface
+  !$acc routine (foo) seq
+  subroutine foo() bind(c, name="foo")
+  end subroutine foo
+  end interface
+end program p
+
+! CHECK: foo, BIND(C), EXTERNAL (Subroutine){{.*}}openACCRoutineInfos: seq