[flang] Add lowering C interoperability test

This patch adds a lowering test for the C
interoperability.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D122307

Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>

diff --git a/flang/test/Lower/c-interoperability.f90 b/flang/test/Lower/c-interoperability.f90
new file mode 100644 (file)
index 0000000..39db2d2
--- /dev/null
+++ b/flang/test/Lower/c-interoperability.f90
@@ -0,0 +1,35 @@
+! RUN: bbc %s -o - | FileCheck %s
+
+! CHECK-LABEL: fir.global @_QMc_interoperability_testEthis_thing : !fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}> {
+! CHECK:         %[[VAL_0:.*]] = arith.constant 0 : i64
+! CHECK:         %[[VAL_1:.*]] = fir.undefined !fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>
+! CHECK:         %[[VAL_2:.*]] = fir.undefined !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_3:.*]] = fir.insert_value %[[VAL_2]], %[[VAL_0]], ["__address", !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>] : (!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>, i64) -> !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_4:.*]] = fir.insert_value %[[VAL_1]], %[[VAL_3]], ["cptr", !fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>] : (!fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>) -> !fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>
+! CHECK:         fir.has_value %[[VAL_4]] : !fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>
+! CHECK:       }
+
+! CHECK-LABEL: func @_QMc_interoperability_testPget_a_thing() -> !fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}> {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.box<!fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>
+! CHECK:         %[[VAL_3:.*]] = fir.address_of(@_QMc_interoperability_testEthis_thing) : !fir.ref<!fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>
+! CHECK:         %[[VAL_4:.*]] = fir.alloca !fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}> {bindc_name = "get_a_thing", uniq_name = "_QMc_interoperability_testFget_a_thingEget_a_thing"}
+! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ref<!fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>) -> !fir.box<!fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>
+! CHECK:         %[[VAL_10:.*]] = fir.embox %[[VAL_3]] : (!fir.ref<!fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>) -> !fir.box<!fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>
+! CHECK:         return %{{.*}} : !fir.type<_QMc_interoperability_testTthing_with_pointer{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>
+! CHECK:       }
+
+module c_interoperability_test
+  use iso_c_binding, only: c_ptr, c_null_ptr
+
+  type thing_with_pointer
+     type(c_ptr) :: cptr = c_null_ptr
+  end type thing_with_pointer
+
+  type(thing_with_pointer) :: this_thing
+  
+contains
+  function get_a_thing()
+    type(thing_with_pointer) :: get_a_thing
+    get_a_thing = this_thing
+  end function get_a_thing
+end module c_interoperability_test

diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp
index 81ab7895c4a4ac5cbb90dec094d9c7b1bb14a79d..f8a8b3a7e0dcc33796a8778f3b91da54ce69cdcf 100644 (file)
--- a/flang/tools/bbc/bbc.cpp
+++ b/flang/tools/bbc/bbc.cpp
@@ -70,11 +70,42 @@ static llvm::cl::opt<std::string>
     outputFilename("o", llvm::cl::desc("Specify the output filename"),
                    llvm::cl::value_desc("filename"));
 
+static llvm::cl::list<std::string>
+    includeDirs("I", llvm::cl::desc("include module search paths"));
+
+static llvm::cl::alias includeAlias("module-directory",
+                                    llvm::cl::desc("module search directory"),
+                                    llvm::cl::aliasopt(includeDirs));
+
+static llvm::cl::list<std::string>
+    intrinsicIncludeDirs("J", llvm::cl::desc("intrinsic module search paths"));
+
+static llvm::cl::alias
+    intrinsicIncludeAlias("intrinsic-module-directory",
+                          llvm::cl::desc("intrinsic module directory"),
+                          llvm::cl::aliasopt(intrinsicIncludeDirs));
+
+static llvm::cl::opt<std::string>
+    moduleDir("module", llvm::cl::desc("module output directory (default .)"),
+              llvm::cl::init("."));
+
+static llvm::cl::opt<std::string>
+    moduleSuffix("module-suffix", llvm::cl::desc("module file suffix override"),
+                 llvm::cl::init(".mod"));
+
 static llvm::cl::opt<bool>
     emitFIR("emit-fir",
             llvm::cl::desc("Dump the FIR created by lowering and exit"),
             llvm::cl::init(false));
 
+static llvm::cl::opt<bool> warnStdViolation("Mstandard",
+                                            llvm::cl::desc("emit warnings"),
+                                            llvm::cl::init(false));
+
+static llvm::cl::opt<bool> warnIsError("Werror",
+                                       llvm::cl::desc("warnings are errors"),
+                                       llvm::cl::init(false));
+
 static llvm::cl::opt<bool> pftDumpTest(
     "pft-test",
     llvm::cl::desc("parse the input, create a PFT, dump it, and exit"),
@@ -240,6 +271,18 @@ int main(int argc, char **argv) {
   ProgramName programPrefix;
   programPrefix = argv[0] + ": "s;
 
+  if (includeDirs.size() == 0) {
+    includeDirs.push_back(".");
+    // Default Fortran modules should be installed in include/flang (a sibling
+    // to the bin) directory.
+    intrinsicIncludeDirs.push_back(
+        llvm::sys::path::parent_path(
+            llvm::sys::path::parent_path(
+                llvm::sys::fs::getMainExecutable(argv[0], nullptr)))
+            .str() +
+        "/include/flang");
+  }
+
   Fortran::parser::Options options;
   options.predefinitions.emplace_back("__flang__"s, "1"s);
   options.predefinitions.emplace_back("__flang_major__"s,
@@ -266,6 +309,12 @@ int main(int argc, char **argv) {
   Fortran::parser::AllCookedSources allCookedSources(allSources);
   Fortran::semantics::SemanticsContext semanticsContext{
       defaultKinds, options.features, allCookedSources};
+  semanticsContext.set_moduleDirectory(moduleDir)
+      .set_moduleFileSuffix(moduleSuffix)
+      .set_searchDirectories(includeDirs)
+      .set_intrinsicModuleDirectories(intrinsicIncludeDirs)
+      .set_warnOnNonstandardUsage(warnStdViolation)
+      .set_warningsAreErrors(warnIsError);
 
   return mlir::failed(convertFortranSourceToMLIR(
       inputFilename, options, programPrefix, semanticsContext, passPipe));