[flang] Support intent-stmt and resolve subprogram prefixes and suffixes.

Recognize `IntentStmt` and use `HandleAttributeStmt()` to implement it
as is done with other attribute statements. Add `Attr::INTENT_INOUT` as
a separate attribute for `INTENT(INOUT)`.

Collect attributes from the prefix and suffix of `FunctionStmt` and
`SubroutineStmt` (including `BIND(C)`) and set them on the subprogram
symbol.

Create a test for this using `test_symbol.sh`. It compiles with
`-funparse-with-symbols` and compares the output with the symbols in
comments in the input.

Change `test_errors.sh` to be similar to `test_symbol.sh`: check usage
and allow `F18` environment variable to override the path to the
compiler.

Original-commit: flang-compiler/f18@384828a22f53d828a3140640ca89f5819ada394d
Reviewed-on: https://github.com/flang-compiler/f18/pull/120
Tree-same-pre-rewrite: false

diff --git a/flang/lib/semantics/attr.h b/flang/lib/semantics/attr.h
index b948ee6..a294d1b 100644 (file)
--- a/flang/lib/semantics/attr.h
+++ b/flang/lib/semantics/attr.h
@@ -25,10 +25,10 @@ namespace Fortran::semantics {
 
 // All available attributes.
 ENUM_CLASS(Attr, ABSTRACT, ALLOCATABLE, ASYNCHRONOUS, BIND_C, CONTIGUOUS,
-    DEFERRED, ELEMENTAL, EXTERNAL, IMPURE, INTENT_IN, INTENT_OUT, INTRINSIC,
-    MODULE, NON_OVERRIDABLE, NON_RECURSIVE, NOPASS, OPTIONAL, PARAMETER, PASS,
-    POINTER, PRIVATE, PROTECTED, PUBLIC, PURE, RECURSIVE, SAVE, TARGET, VALUE,
-    VOLATILE)
+    DEFERRED, ELEMENTAL, EXTERNAL, IMPURE, INTENT_IN, INTENT_OUT, INTENT_INOUT,
+    INTRINSIC, MODULE, NON_OVERRIDABLE, NON_RECURSIVE, NOPASS, OPTIONAL,
+    PARAMETER, PASS, POINTER, PRIVATE, PROTECTED, PUBLIC, PURE, RECURSIVE, SAVE,
+    TARGET, VALUE, VOLATILE)
 
 // Set of attributes
 class Attrs : public common::EnumSet<Attr, Attr_enumSize> {

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 12634ac..3bda51c 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -114,8 +114,15 @@ protected:
     case parser::AccessSpec::Kind::Public: return Attr::PUBLIC;
     case parser::AccessSpec::Kind::Private: return Attr::PRIVATE;
     }
-    // unnecessary but g++ warns "control reaches end of non-void function"
-    common::die("unreachable");
+    common::die("unreachable");  // suppress g++ warning
+  }
+  Attr IntentSpecToAttr(const parser::IntentSpec &x) {
+    switch (x.v) {
+    case parser::IntentSpec::Intent::In: return Attr::INTENT_IN;
+    case parser::IntentSpec::Intent::Out: return Attr::INTENT_OUT;
+    case parser::IntentSpec::Intent::InOut: return Attr::INTENT_INOUT;
+    }
+    common::die("unreachable");  // suppress g++ warning
   }
 };
 
@@ -430,6 +437,7 @@ class SubprogramVisitor : public InterfaceVisitor {
 public:
   bool Pre(const parser::StmtFunctionStmt &);
   void Post(const parser::StmtFunctionStmt &);
+  bool Pre(const parser::SubroutineStmt &);
   void Post(const parser::SubroutineStmt &);
   bool Pre(const parser::FunctionStmt &);
   void Post(const parser::FunctionStmt &);
@@ -470,6 +478,7 @@ public:
   bool Pre(const parser::AsynchronousStmt &);
   bool Pre(const parser::ContiguousStmt &);
   bool Pre(const parser::ExternalStmt &);
+  bool Pre(const parser::IntentStmt &);
   bool Pre(const parser::IntrinsicStmt &);
   bool Pre(const parser::OptionalStmt &);
   bool Pre(const parser::ProtectedStmt &);
@@ -751,14 +760,8 @@ bool AttrsVisitor::Pre(const parser::AccessSpec &x) {
   return false;
 }
 bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
-  switch (x.v) {
-  case parser::IntentSpec::Intent::In: attrs_->set(Attr::INTENT_IN); break;
-  case parser::IntentSpec::Intent::Out: attrs_->set(Attr::INTENT_OUT); break;
-  case parser::IntentSpec::Intent::InOut:
-    attrs_->set(Attr::INTENT_IN);
-    attrs_->set(Attr::INTENT_OUT);
-    break;
-  }
+  CHECK(attrs_);
+  attrs_->set(IntentSpecToAttr(x));
   return false;
 }
 
@@ -1524,7 +1527,6 @@ void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
   generic.set(isFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
 }
 
-
 // SubprogramVisitor implementation
 
 bool SubprogramVisitor::Pre(const parser::StmtFunctionStmt &x) {
@@ -1629,11 +1631,16 @@ void SubprogramVisitor::Post(const parser::InterfaceBody::Function &) {
   EndSubprogram();
 }
 
+bool SubprogramVisitor::Pre(const parser::SubroutineStmt &stmt) {
+  BeginAttrs();
+  return true;
+}
 bool SubprogramVisitor::Pre(const parser::FunctionStmt &stmt) {
   if (!subpNamesOnly_) {
     BeginDeclTypeSpec();
     CHECK(!funcResultName_);
   }
+  BeginAttrs();
   return true;
 }
 
@@ -1641,6 +1648,7 @@ void SubprogramVisitor::Post(const parser::SubroutineStmt &stmt) {
   const auto &name = std::get<parser::Name>(stmt.t);
   Symbol &symbol{*CurrScope().symbol()};
   CHECK(name.source == symbol.name());
+  symbol.attrs() |= EndAttrs();
   auto &details = symbol.details<SubprogramDetails>();
   for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
     const parser::Name *dummyName = std::get_if<parser::Name>(&dummyArg.u);
@@ -1654,6 +1662,7 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
   const auto &name = std::get<parser::Name>(stmt.t);
   Symbol &symbol{*CurrScope().symbol()};
   CHECK(name.source == symbol.name());
+  symbol.attrs() |= EndAttrs();
   auto &details = symbol.details<SubprogramDetails>();
   for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) {
     Symbol &dummy{MakeSymbol(dummyName, EntityDetails(true))};
@@ -1807,6 +1816,11 @@ bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) {
   }
   return false;
 }
+bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {
+  auto &intentSpec{std::get<parser::IntentSpec>(x.t)};
+  auto &names{std::get<std::list<parser::Name>>(x.t)};
+  return HandleAttributeStmt(IntentSpecToAttr(intentSpec), names);
+}
 bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
   return HandleAttributeStmt(Attr::INTRINSIC, x.v);
 }

diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt
index 897e0ef..f19d964 100644 (file)
--- a/flang/test/semantics/CMakeLists.txt
+++ b/flang/test/semantics/CMakeLists.txt
@@ -15,7 +15,8 @@
 # Run tests with test_errors.sh. It compiles the test with f18 and compares
 # actual errors produced with expected ones listed in the source.
 
-set(TESTS
+# These test files have expected errors in the source
+set(ERROR_TESTS
   implicit01.f90
   implicit02.f90
   implicit03.f90
@@ -49,6 +50,15 @@ set(TESTS
   resolve24.f90
 )
 
-foreach(test ${TESTS})
+# These test files have expected symbols in the source
+set(SYMBOL_TESTS
+  symbol01.f90
+)
+
+foreach(test ${ERROR_TESTS})
   add_test(NAME ${test} COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/test_errors.sh ${test})
 endforeach()
+
+foreach(test ${SYMBOL_TESTS})
+  add_test(NAME ${test} COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/test_symbols.sh ${test})
+endforeach()

diff --git a/flang/test/semantics/symbol01.f90 b/flang/test/semantics/symbol01.f90
new file mode 100644 (file)
index 0000000..446136d
--- /dev/null
+++ b/flang/test/semantics/symbol01.f90
@@ -0,0 +1,40 @@
+! Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! Test that intent-stmt and subprogram prefix and suffix are resolved.
+
+!DEF: /m Module
+module m
+ !DEF: /m/f PRIVATE, PURE, RECURSIVE Subprogram
+ private :: f
+contains
+ !DEF: /m/s BIND_C, PUBLIC, PURE Subprogram
+ !DEF: /m/s/x INTENT_IN Entity
+ !DEF: /m/s/y INTENT_INOUT Entity
+ pure subroutine s (x, y) bind(c)
+  intent(in) :: x
+  intent(inout) :: y
+ contains
+  !DEF: /m/s/ss PURE Subprogram
+  pure subroutine ss
+  end subroutine
+ end subroutine
+ !DEF: /m/f PRIVATE, PURE, RECURSIVE Subprogram
+ !DEF: /m/f/x ALLOCATABLE Entity REAL
+ recursive pure function f() result(x)
+  real, allocatable :: x
+  !REF: /m/f/x
+  x = 1.0
+ end function
+end module

diff --git a/flang/test/semantics/test_errors.sh b/flang/test/semantics/test_errors.sh
index 26d0796..ce48dc3 100755 (executable)
--- a/flang/test/semantics/test_errors.sh
+++ b/flang/test/semantics/test_errors.sh
@@ -14,11 +14,19 @@
 # limitations under the License.
 
 # Compile a source file and check errors against those listed in the file.
+# Change the compiler by setting the F18 environment variable.
 
 PATH=/usr/bin
 srcdir=$(dirname $0)
+CMD="${F18:-../../tools/f18/f18} -fdebug-resolve-names -fparse-only"
+
+if [[ $# != 1 ]]; then
+  echo "Usage: $0 <fortran-source>"
+  exit 1
+fi
 src=$srcdir/$1
 [[ ! -f $src ]] && echo "File not found: $src" && exit 1
+
 temp=$(mktemp --directory --tmpdir=.)
 trap "rm -rf $temp" EXIT
 log=$temp/log
@@ -26,7 +34,7 @@ actual=$temp/actual
 expect=$temp/expect
 diffs=$temp/diffs
 
-cmd="../../tools/f18/f18 -fdebug-resolve-names -fparse-only $src"
+cmd="$CMD $src"
 $cmd > $log 2>&1
 
 # $actual has errors from the compiler; $expect has them from !ERROR comments in source
@@ -39,7 +47,7 @@ if diff -U0 $actual $expect > $diffs; then
 else
   echo "$cmd"
   < $diffs \
-    sed -n -e 's/^-\([0-9]\)/expect at \1/p' -e 's/^+\([0-9]\)/actual at \1/p' \
+    sed -n -e 's/^-\([0-9]\)/actual at \1/p' -e 's/^+\([0-9]\)/expect at \1/p' \
     | sort -n -k 2
   echo FAIL
   exit 1

diff --git a/flang/test/semantics/test_symbols.sh b/flang/test/semantics/test_symbols.sh
new file mode 100755 (executable)
index 0000000..597d455
--- /dev/null
+++ b/flang/test/semantics/test_symbols.sh
@@ -0,0 +1,57 @@
+#!/usr/bin/bash
+# Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+#     http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+# Compile a source file with '-funparse-with-symbols' and verify
+# we get the right symbols in the output, i.e. the output should be
+# the same as the input, except for the copyright comment.
+# Change the compiler by setting the F18 environment variable.
+
+PATH=/usr/bin
+srcdir=$(dirname $0)
+CMD="${F18:-../../tools/f18/f18} -funparse-with-symbols"
+
+if [[ $# != 1 ]]; then
+  echo "Usage: $0 <fortran-source>"
+  exit 1
+fi
+src=$srcdir/$1
+[[ ! -f $src ]] && echo "File not found: $src" && exit 1
+
+if [[ $KEEP ]]; then
+  temp=.
+else
+  temp=$(mktemp --directory --tmpdir=.)
+  trap "rm -rf $temp" EXIT
+fi
+src1=$temp/1.f90
+src2=$temp/2.f90
+src3=$temp/3.f90
+diffs=$temp/diffs
+
+# Strip out blank lines and all comments except "!DEF:" and "!REF:"
+sed -e 's/!\([DR]EF:\)/KEEP \1/' \
+  -e 's/!.*//' -e 's/ *$//' -e '/^$/d' -e 's/KEEP \([DR]EF:\)/!\1/' \
+  $src > $src1
+egrep -v '^ *!' $src1 > $src2  # strip out meaningful comments
+$CMD $src2 > $src3  # compile, inserting comments for symbols
+
+if diff -U999999 $src1 $src3 > $diffs; then
+  echo PASS
+else
+  sed '1,/^\@\@/d' $diffs
+  echo
+  echo FAIL
+  exit 1
+fi