[flang] [llvm] [flang] Add HOSTNM runtime and lowering intrinsics implementation (PR #131910)
Eugene Epshteyn via llvm-commits
llvm-commits at lists.llvm.org
Tue Mar 18 14:05:41 PDT 2025
https://github.com/eugeneepshteyn updated https://github.com/llvm/llvm-project/pull/131910
>From 976009667e73b3548fb471519e6a842d6bc3268e Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 13 Mar 2025 11:42:15 -0400
Subject: [PATCH 1/6] Starting implementation of hostnm() non-standard
intrinsic.
modified: Intrinsics.md
---
flang/docs/Intrinsics.md | 44 ++++++++++++++++++++++++++++++++++------
1 file changed, 38 insertions(+), 6 deletions(-)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 5b671d1b2c740..99b1d327205c0 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1,9 +1,9 @@
-<!--===- docs/Intrinsics.md
-
+<!--===- docs/Intrinsics.md
+
Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
See https://llvm.org/LICENSE.txt for license information.
SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-
+
-->
# A categorization of standard (2018) and extended Fortran intrinsic procedures
@@ -703,7 +703,7 @@ CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, LOC
MALLOC, FREE
```
-### Library subroutine
+### Library subroutine
```
CALL BACKTRACE()
CALL FDATE(TIME)
@@ -961,7 +961,7 @@ program test_etime
call ETIME(tarray, result)
print *, result
print *, tarray(1)
- print *, tarray(2)
+ print *, tarray(2)
do i=1,100000000 ! Just a delay
j = i * i - i
end do
@@ -1003,6 +1003,38 @@ PROGRAM example_getcwd
END PROGRAM
```
+### Non-Standard Intrinsics: HOSTNM
+
+#### Description
+`HOSTNM(C, STATUS)` returns the host name of the system.
+
+This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit.
+
+*C* and *STATUS* are `INTENT(OUT)` and provide the following:
+
+| | |
+|------------|---------------------------------------------------------------------------------------------------|
+| `C` | The host name of the system. The type shall be `CHARACTER` and of default kind. |
+| `STATUS` | (Optional) Status flag. Returns 0 on success, a system specific and nonzero error code otherwise. The type shall be `INTEGER` and of a kind greater or equal to 4. |
+
+#### Usage and Info
+
+- **Standard:** GNU extension
+- **Class:** Subroutine, function
+- **Syntax:** `CALL HOSTNM(C, STATUS)`, `STATUS = HOSTNM(C)`
+
+#### Example
+```Fortran
+PROGRAM example_hostnm
+ CHARACTER(len=255) :: cwd
+ INTEGER :: status
+ CALL hostnm(cwd, status)
+ PRINT *, cwd
+ PRINT *, status
+END PROGRAM
+```
+
+
### Non-standard Intrinsics: RENAME
`RENAME(OLD, NEW[, STATUS])` renames/moves a file on the filesystem.
@@ -1088,7 +1120,7 @@ This intrinsic is provided in both subroutine and function forms; however, only
```Fortran
program chdir_func
character(len=) :: path
- integer :: status
+ integer :: status
call chdir("/tmp")
status = chdir("..")
>From 828cd76d104161c11f73b4a640b967910183d929 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 14 Mar 2025 06:24:53 -0400
Subject: [PATCH 2/6] In progress
---
.../flang/Optimizer/Builder/IntrinsicCall.h | 2 ++
.../flang/Optimizer/Builder/Runtime/Command.h | 5 +++
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 35 +++++++++++++++++++
.../lib/Optimizer/Builder/Runtime/Command.cpp | 13 +++++++
4 files changed, 55 insertions(+)
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 589a936f8b8c7..cdbb78224e3b4 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -277,6 +277,8 @@ struct IntrinsicLibrary {
llvm::ArrayRef<mlir::Value> args);
mlir::Value genGetUID(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args);
+ fir::ExtendedValue genHostnm(std::optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args);
fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genIany(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index 0d60a367d9998..299e1cef4af79 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -58,5 +58,10 @@ mlir::Value genGetEnvVariable(fir::FirOpBuilder &, mlir::Location,
mlir::Value genGetCwd(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value c);
+/// Generate a call to the Hostnm runtime function which implements
+/// the HOSTNM intrinsic.
+mlir::Value genHostnm(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value c);
+
} // namespace fir::runtime
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index f57ed41fd785d..ca2a4dd0d2eef 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -480,6 +480,10 @@ static constexpr IntrinsicHandler handlers[]{
{"getgid", &I::genGetGID},
{"getpid", &I::genGetPID},
{"getuid", &I::genGetUID},
+ {"hostnm",
+ &I::genGetCwd,
+ {{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}},
+ /*isElemental=*/false},
{"iachar", &I::genIchar},
{"iall",
&I::genIall,
@@ -4317,6 +4321,37 @@ void IntrinsicLibrary::genGetEnvironmentVariable(
}
}
+// HOSTNM
+fir::ExtendedValue
+IntrinsicLibrary::genHostnm(std::optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert((args.size() == 1 && resultType.has_value()) ||
+ (args.size() >= 1 && !resultType.has_value()));
+
+ mlir::Value cwd = fir::getBase(args[0]);
+ mlir::Value statusValue = fir::runtime::genHostnm(builder, loc, cwd);
+
+ if (resultType.has_value()) {
+ // Function form, return status.
+ return statusValue;
+ } else {
+ // Subroutine form, store status and return none.
+ const fir::ExtendedValue &status = args[1];
+ if (!isStaticallyAbsent(status)) {
+ mlir::Value statusAddr = fir::getBase(status);
+ mlir::Value statusIsPresentAtRuntime =
+ builder.genIsNotNullAddr(loc, statusAddr);
+ builder.genIfThen(loc, statusIsPresentAtRuntime)
+ .genThen([&]() {
+ builder.createStoreWithConvert(loc, statusValue, statusAddr);
+ })
+ .end();
+ }
+ }
+
+ return {};
+}
+
/// Process calls to Maxval, Minval, Product, Sum intrinsic functions that
/// take a DIM argument.
template <typename FD>
diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
index 8320d89493b33..8bf32c522a5f1 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
@@ -101,3 +101,16 @@ mlir::Value fir::runtime::genGetCwd(fir::FirOpBuilder &builder,
builder, loc, runtimeFuncTy, cwd, sourceFile, sourceLine);
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
}
+
+mlir::Value fir::runtime::genHostnm(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value cwd) {
+ mlir::func::FuncOp func =
+ fir::runtime::getRuntimeFunc<mkRTKey(Hostnm)>(loc, builder);
+ auto runtimeFuncTy = func.getFunctionType();
+ mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+ mlir::Value sourceLine =
+ fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(2));
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, runtimeFuncTy, cwd, sourceFile, sourceLine);
+ return builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
>From b0a8798a26b01f6efb036da63034cd8852fd2d13 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 18 Mar 2025 00:01:53 -0400
Subject: [PATCH 3/6] Continue Hostnm() implementation
---
flang-rt/lib/runtime/command.cpp | 35 ++++++++++++++++++++
flang/include/flang/Common/windows-include.h | 4 +++
2 files changed, 39 insertions(+)
diff --git a/flang-rt/lib/runtime/command.cpp b/flang-rt/lib/runtime/command.cpp
index 9ada5bd59c0b7..c0b13509a8fa3 100644
--- a/flang-rt/lib/runtime/command.cpp
+++ b/flang-rt/lib/runtime/command.cpp
@@ -263,4 +263,39 @@ std::int32_t RTNAME(GetCwd)(
return status;
}
+std::int32_t RTNAME(Hostnm)(
+ const Descriptor &hnam, const char *sourceFile, int line) {
+ Terminator terminator{sourceFile, line};
+
+ RUNTIME_CHECK(terminator, IsValidCharDescriptor(&hnam));
+
+ char buf[256];
+ std::int32_t status{0};
+
+#ifdef _WIN32
+
+ DWORD dwSize{sizeof(buf)};
+
+ // Note: Winsock has gethostname(), but use Win32 API GetComputerNameEx(),
+ // in order to avoid adding dependency on Winsock.
+ if (!GetComputerNameEx(ComputerNameDnsHostname, buf, &dwSize)) {
+ status = GetLastError();
+ }
+
+#else
+
+ if (gethostname(buf, sizeof(buf)) < 0) {
+ status = errno;
+ }
+
+#endif
+
+ if (status == 0) {
+ std::int64_t strLen{StringLength(buf)};
+ std::int32_t status{CopyCharsToDescriptor(hnam, buf, strLen)};
+ }
+
+ return status;
+}
+
} // namespace Fortran::runtime
diff --git a/flang/include/flang/Common/windows-include.h b/flang/include/flang/Common/windows-include.h
index 75ef4974251ff..01bc6fc9eb94f 100644
--- a/flang/include/flang/Common/windows-include.h
+++ b/flang/include/flang/Common/windows-include.h
@@ -18,6 +18,10 @@
#define WIN32_LEAN_AND_MEAN
#define NOMINMAX
+// Target Windows 2000 and above. This is needed for newer Windows API
+// functions, e.g. GetComputerNameExA()
+#define _WIN32_WINNT 0x0500
+
#include <windows.h>
#endif // _WIN32
>From a0b6f853748efea413e976907197ff8afb4b5b5c Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 18 Mar 2025 15:58:12 -0400
Subject: [PATCH 4/6] Code complete. Functional unit tests.
---
flang-rt/lib/runtime/command.cpp | 6 +-
.../flang/Optimizer/Builder/Runtime/Command.h | 2 +-
flang/include/flang/Runtime/command.h | 4 ++
flang/include/flang/Runtime/extensions.h | 3 +
flang/lib/Evaluate/intrinsics.cpp | 12 +++-
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 6 +-
.../lib/Optimizer/Builder/Runtime/Command.cpp | 4 +-
flang/test/Intrinsics/hostnm-linux-func.f90 | 60 +++++++++++++++++++
flang/test/Intrinsics/hostnm-linux-sub.f90 | 60 +++++++++++++++++++
9 files changed, 147 insertions(+), 10 deletions(-)
create mode 100644 flang/test/Intrinsics/hostnm-linux-func.f90
create mode 100644 flang/test/Intrinsics/hostnm-linux-sub.f90
diff --git a/flang-rt/lib/runtime/command.cpp b/flang-rt/lib/runtime/command.cpp
index c0b13509a8fa3..32371d146382a 100644
--- a/flang-rt/lib/runtime/command.cpp
+++ b/flang-rt/lib/runtime/command.cpp
@@ -264,10 +264,10 @@ std::int32_t RTNAME(GetCwd)(
}
std::int32_t RTNAME(Hostnm)(
- const Descriptor &hnam, const char *sourceFile, int line) {
+ const Descriptor &res, const char *sourceFile, int line) {
Terminator terminator{sourceFile, line};
- RUNTIME_CHECK(terminator, IsValidCharDescriptor(&hnam));
+ RUNTIME_CHECK(terminator, IsValidCharDescriptor(&res));
char buf[256];
std::int32_t status{0};
@@ -292,7 +292,7 @@ std::int32_t RTNAME(Hostnm)(
if (status == 0) {
std::int64_t strLen{StringLength(buf)};
- std::int32_t status{CopyCharsToDescriptor(hnam, buf, strLen)};
+ std::int32_t status{CopyCharsToDescriptor(res, buf, strLen)};
}
return status;
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index 299e1cef4af79..d896393ce02f7 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -61,7 +61,7 @@ mlir::Value genGetCwd(fir::FirOpBuilder &builder, mlir::Location loc,
/// Generate a call to the Hostnm runtime function which implements
/// the HOSTNM intrinsic.
mlir::Value genHostnm(fir::FirOpBuilder &builder, mlir::Location loc,
- mlir::Value c);
+ mlir::Value res);
} // namespace fir::runtime
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H
diff --git a/flang/include/flang/Runtime/command.h b/flang/include/flang/Runtime/command.h
index 3add66dd50d4a..e0069a9bc0321 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/flang/include/flang/Runtime/command.h
@@ -59,6 +59,10 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
// Calls getcwd()
std::int32_t RTNAME(GetCwd)(
const Descriptor &cwd, const char *sourceFile, int line);
+
+// Calls hostnm()
+std::int32_t RTNAME(Hostnm)(
+ const Descriptor &res, const char *sourceFile, int line);
}
} // namespace Fortran::runtime
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index 133194dea87cf..4e96f253a6c2c 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -54,6 +54,9 @@ uid_t RTNAME(GetUID)();
// GNU extension subroutine GETLOG(C).
void FORTRAN_PROCEDURE_NAME(getlog)(char *name, std::int64_t length);
+// GNU extension subroutine HOSTNM(C)
+void FORTRAN_PROCEDURE_NAME(hostnm)(char *name, std::int64_t length);
+
std::intptr_t RTNAME(Malloc)(std::size_t size);
// GNU extension function STATUS = SIGNAL(number, handler)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index fe691e85ee011..dc0ccd2cb342a 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -553,6 +553,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"getgid", {}, DefaultInt},
{"getpid", {}, DefaultInt},
{"getuid", {}, DefaultInt},
+ {"hostnm",
+ {{"c", DefaultChar, Rank::scalar, Optionality::required,
+ common::Intent::Out}},
+ TypePattern{IntType, KindCode::greaterOrEqualToKind, 4}},
{"huge",
{{"x", SameIntUnsignedOrReal, Rank::anyOrAssumedRank,
Optionality::required, common::Intent::In,
@@ -1545,6 +1549,12 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"status", TypePattern{IntType, KindCode::greaterOrEqualToKind, 4},
Rank::scalar, Optionality::optional, common::Intent::Out}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
+ {"hostnm",
+ {{"c", DefaultChar, Rank::scalar, Optionality::required,
+ common::Intent::Out},
+ {"status", TypePattern{IntType, KindCode::greaterOrEqualToKind, 4},
+ Rank::scalar, Optionality::optional, common::Intent::Out}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"move_alloc",
{{"from", SameType, Rank::known, Optionality::required,
common::Intent::InOut},
@@ -2765,7 +2775,7 @@ bool IntrinsicProcTable::Implementation::IsDualIntrinsic(
// Collection for some intrinsics with function and subroutine form,
// in order to pass the semantic check.
static const std::string dualIntrinsic[]{{"chdir"s}, {"etime"s}, {"getcwd"s},
- {"rename"s}, {"second"s}, {"system"s}};
+ {"hostnm"s}, {"rename"s}, {"second"s}, {"system"s}};
return llvm::is_contained(dualIntrinsic, name);
}
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index ca2a4dd0d2eef..e2d3a4789a8e2 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -481,7 +481,7 @@ static constexpr IntrinsicHandler handlers[]{
{"getpid", &I::genGetPID},
{"getuid", &I::genGetUID},
{"hostnm",
- &I::genGetCwd,
+ &I::genHostnm,
{{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}},
/*isElemental=*/false},
{"iachar", &I::genIchar},
@@ -4328,8 +4328,8 @@ IntrinsicLibrary::genHostnm(std::optional<mlir::Type> resultType,
assert((args.size() == 1 && resultType.has_value()) ||
(args.size() >= 1 && !resultType.has_value()));
- mlir::Value cwd = fir::getBase(args[0]);
- mlir::Value statusValue = fir::runtime::genHostnm(builder, loc, cwd);
+ mlir::Value res = fir::getBase(args[0]);
+ mlir::Value statusValue = fir::runtime::genHostnm(builder, loc, res);
if (resultType.has_value()) {
// Function form, return status.
diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
index 8bf32c522a5f1..612599551528f 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
@@ -103,7 +103,7 @@ mlir::Value fir::runtime::genGetCwd(fir::FirOpBuilder &builder,
}
mlir::Value fir::runtime::genHostnm(fir::FirOpBuilder &builder,
- mlir::Location loc, mlir::Value cwd) {
+ mlir::Location loc, mlir::Value res) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(Hostnm)>(loc, builder);
auto runtimeFuncTy = func.getFunctionType();
@@ -111,6 +111,6 @@ mlir::Value fir::runtime::genHostnm(fir::FirOpBuilder &builder,
mlir::Value sourceLine =
fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(2));
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
- builder, loc, runtimeFuncTy, cwd, sourceFile, sourceLine);
+ builder, loc, runtimeFuncTy, res, sourceFile, sourceLine);
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
}
diff --git a/flang/test/Intrinsics/hostnm-linux-func.f90 b/flang/test/Intrinsics/hostnm-linux-func.f90
new file mode 100644
index 0000000000000..9fdbc4609beb6
--- /dev/null
+++ b/flang/test/Intrinsics/hostnm-linux-func.f90
@@ -0,0 +1,60 @@
+! REQUIRES: system-linux
+
+! Verify that the hostname obtained by HOSTNM() intrinsic is the same
+! as the hostname obtained by directly calling C gethostname().
+
+! RUN: %flang -L"%libdir" %s -o %t
+! RUN: env LD_LIBRARY_PATH="$LD_LIBRARY_PATH:%libdir" %t | FileCheck %s
+
+! CHECK: PASS
+
+program get_hostname_cinterop
+ use, intrinsic :: iso_c_binding, only: c_char, c_int, c_size_t, c_null_char
+ implicit none
+
+ interface
+ function gethostname(name, namelen) bind(C)
+ import :: c_char, c_int, c_size_t
+ integer(c_int) :: gethostname
+ character(kind=c_char), dimension(*) :: name
+ integer(c_size_t), value :: namelen
+ end function gethostname
+ end interface
+
+ integer, parameter :: HOST_NAME_MAX = 255
+ character(kind=c_char), dimension(HOST_NAME_MAX + 1) :: c_hostname
+ character(HOST_NAME_MAX) :: hostname
+ character(HOST_NAME_MAX) :: hostnm_str
+ integer(c_int) :: status, i
+
+ status = gethostname(c_hostname, HOST_NAME_MAX)
+ if (status /= 0) then
+ print *, "Error in gethostname(), status code: ", status
+ error stop
+ end if
+
+ status = hostnm(hostnm_str)
+ if (status /= 0) then
+ print *, "Error in hostnm(), status code: ", status
+ error stop
+ end if
+
+ ! Find the position of the null terminator to convert C string to Fortran string
+ i = 1
+ do while (i <= HOST_NAME_MAX .and. c_hostname(i) /= c_null_char)
+ i = i + 1
+ end do
+
+ hostname = transfer(c_hostname(1:i-1), hostname)
+
+ print *, "Hostname from OS: ", hostname(1:i-1)
+ print *, "Hostname from hostnm(): ", hostnm_str(1:i-1)
+
+ if (hostname /= hostnm_str) then
+ print *, "FAIL"
+ else
+ print *, "PASS"
+ end if
+
+end program get_hostname_cinterop
+
diff --git a/flang/test/Intrinsics/hostnm-linux-sub.f90 b/flang/test/Intrinsics/hostnm-linux-sub.f90
new file mode 100644
index 0000000000000..981c3c937cec0
--- /dev/null
+++ b/flang/test/Intrinsics/hostnm-linux-sub.f90
@@ -0,0 +1,60 @@
+! REQUIRES: system-linux
+
+! Verify that the hostname obtained by HOSTNM() intrinsic is the same
+! as the hostname obtained by directly calling C gethostname().
+
+! RUN: %flang -L"%libdir" %s -o %t
+! RUN: env LD_LIBRARY_PATH="$LD_LIBRARY_PATH:%libdir" %t | FileCheck %s
+
+! CHECK: PASS
+
+program get_hostname_cinterop
+ use, intrinsic :: iso_c_binding, only: c_char, c_int, c_size_t, c_null_char
+ implicit none
+
+ interface
+ function gethostname(name, namelen) bind(C)
+ import :: c_char, c_int, c_size_t
+ integer(c_int) :: gethostname
+ character(kind=c_char), dimension(*) :: name
+ integer(c_size_t), value :: namelen
+ end function gethostname
+ end interface
+
+ integer, parameter :: HOST_NAME_MAX = 255
+ character(kind=c_char), dimension(HOST_NAME_MAX + 1) :: c_hostname
+ character(HOST_NAME_MAX) :: hostname
+ character(HOST_NAME_MAX) :: hostnm_str
+ integer(c_int) :: status, i
+
+ status = gethostname(c_hostname, HOST_NAME_MAX)
+ if (status /= 0) then
+ print *, "Error in gethostname(), status code: ", status
+ error stop
+ end if
+
+ call hostnm(hostnm_str, status)
+ if (status /= 0) then
+ print *, "Error in hostnm(), status code: ", status
+ error stop
+ end if
+
+ ! Find the position of the null terminator to convert C string to Fortran string
+ i = 1
+ do while (i <= HOST_NAME_MAX .and. c_hostname(i) /= c_null_char)
+ i = i + 1
+ end do
+
+ hostname = transfer(c_hostname(1:i-1), hostname)
+
+ print *, "Hostname from OS: ", hostname(1:i-1)
+ print *, "Hostname from hostnm(): ", hostnm_str(1:i-1)
+
+ if (hostname /= hostnm_str) then
+ print *, "FAIL"
+ else
+ print *, "PASS"
+ end if
+
+end program get_hostname_cinterop
+
>From b190979c9ee46f7cf03e550c25d85e9b13a6c231 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 18 Mar 2025 16:12:39 -0400
Subject: [PATCH 5/6] Test for semantic checks of hostnm()
---
flang/test/Semantics/hostnm.f90 | 42 +++++++++++++++++++++++++++++++++
1 file changed, 42 insertions(+)
create mode 100644 flang/test/Semantics/hostnm.f90
diff --git a/flang/test/Semantics/hostnm.f90 b/flang/test/Semantics/hostnm.f90
new file mode 100644
index 0000000000000..c9293a7f7bf8c
--- /dev/null
+++ b/flang/test/Semantics/hostnm.f90
@@ -0,0 +1,42 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! Tests for the HOSTNM intrinsics.
+
+subroutine bad_kind_error(cwd, status)
+ CHARACTER(len=255) :: cwd
+ INTEGER(2) :: status
+ !ERROR: Actual argument for 'status=' has bad type or kind 'INTEGER(2)'
+ call hostnm(cwd, status)
+end subroutine bad_kind_error
+
+subroutine bad_args_error()
+ !ERROR: missing mandatory 'c=' argument
+ call hostnm()
+end subroutine bad_args_error
+
+subroutine bad_function(cwd)
+ CHARACTER(len=255) :: cwd
+ INTEGER :: status
+ call hostnm(cwd, status)
+ !ERROR: Cannot call subroutine 'hostnm' like a function
+ status = hostnm(cwd)
+end subroutine bad_function
+
+subroutine bad_sub(cwd)
+ CHARACTER(len=255) :: cwd
+ INTEGER :: status
+ status = hostnm(cwd)
+ !ERROR: Cannot call function 'hostnm' like a subroutine
+ call hostnm(cwd, status)
+end subroutine bad_sub
+
+subroutine good_subroutine(cwd, status)
+ CHARACTER(len=255) :: cwd
+ INTEGER :: status
+ call hostnm(cwd, status)
+end subroutine good_subroutine
+
+subroutine good_function(cwd, status)
+ CHARACTER(len=255) :: cwd
+ INTEGER :: status
+ status = hostnm(cwd)
+end subroutine good_function
>From 7cc9756f259266a10f3091077e374044297f3533 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 18 Mar 2025 17:05:28 -0400
Subject: [PATCH 6/6] Documentation tweak
---
flang/docs/Intrinsics.md | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 99b1d327205c0..aa32b8618e053 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1026,10 +1026,10 @@ This intrinsic is provided in both subroutine and function forms; however, only
#### Example
```Fortran
PROGRAM example_hostnm
- CHARACTER(len=255) :: cwd
+ CHARACTER(len=255) :: hnam
INTEGER :: status
- CALL hostnm(cwd, status)
- PRINT *, cwd
+ CALL hostnm(hnam, status)
+ PRINT *, hnam
PRINT *, status
END PROGRAM
```
More information about the llvm-commits
mailing list