--- /dev/null
+! 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
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"),
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,
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));