mirrors/llvm-project
0
0
Fork 0
mirror of https://github.com/llvm/llvm-project.git synced 2025-04-18 19:06:44 +00:00
Code Issues Projects Releases Wiki Activity

[flang] Add MALLOC and FREE intrinsics for Cray pointers (#110018)

Browse Source 
MALLOC and FREE are extensions provided by gfortran, Intel Fortran and
classic flang to allocate memory for Cray pointers. These are used in
some legacy codes such as libexodus.

All the above compilers accept using MALLOC and FREE with integers as
well, despite that this will often signify a bug in user code. We should
accept the same as the other compilers for compatibility.
This commit is contained in:
David Truby 2024-09-30 22:40:16 +01:00 committed by GitHub
parent 725eb6bb12
commit 78ccffc053
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
12 changed files with 245 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
flang/docs/Intrinsics.md
View File

@ -700,7 +700,7 @@ IBCHNG, ISHA, ISHC, ISHL, IXOR
IARG, IARGC, NARGS, NUMARG
BADDRESS, IADDR
CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, LOC
MALLOC
MALLOC, FREE
```
### Library subroutine
@ -765,7 +765,7 @@ This phase currently supports all the intrinsic procedures listed above but the
| Coarray intrinsic functions | COSHAPE |
| Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
| Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
| Non-standard intrinsic functions | AND, OR, XOR, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, GETPID, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC |
| Non-standard intrinsic functions | AND, OR, XOR, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, GETPID, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC, FREE |
| Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SIGNAL, SLEEP, SYSTEM, SYSTEM_CLOCK |
| Atomic intrinsic subroutines | ATOMIC_ADD |
| Collective intrinsic subroutines | CO_REDUCE |

2
flang/include/flang/Optimizer/Builder/IntrinsicCall.h
View File

@ -249,6 +249,7 @@ struct IntrinsicLibrary {
mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genFraction(mlir::Type resultType,
mlir::ArrayRef<mlir::Value> args);
void genFree(mlir::ArrayRef<fir::ExtendedValue> args);
fir::ExtendedValue genGetCwd(std::optional<mlir::Type> resultType,
llvm::ArrayRef<fir::ExtendedValue> args);
void genGetCommand(mlir::ArrayRef<fir::ExtendedValue> args);
@ -315,6 +316,7 @@ struct IntrinsicLibrary {
fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genMalloc(mlir::Type, llvm::ArrayRef<mlir::Value>);
template <typename Shift>
mlir::Value genMask(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genMatmul(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);

4
flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
View File

@ -47,6 +47,10 @@ void genDateAndTime(fir::FirOpBuilder &, mlir::Location,
void genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value values, mlir::Value time);
void genFree(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value ptr);
mlir::Value genMalloc(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value size);
void genRandomInit(fir::FirOpBuilder &, mlir::Location, mlir::Value repeatable,
mlir::Value imageDistinct);
void genRandomNumber(fir::FirOpBuilder &, mlir::Location, mlir::Value harvest);

4
flang/include/flang/Runtime/extensions.h
View File

@ -28,6 +28,8 @@ void FORTRAN_PROCEDURE_NAME(flush)(const int &unit);
// GNU extension subroutine FDATE
void FORTRAN_PROCEDURE_NAME(fdate)(char *string, std::int64_t length);
void RTNAME(Free)(std::intptr_t ptr);
// GNU Fortran 77 compatibility function IARGC.
std::int32_t FORTRAN_PROCEDURE_NAME(iargc)();
@ -38,6 +40,8 @@ void FORTRAN_PROCEDURE_NAME(getarg)(
// GNU extension subroutine GETLOG(C).
void FORTRAN_PROCEDURE_NAME(getlog)(char *name, std::int64_t length);
std::intptr_t RTNAME(Malloc)(std::size_t size);
// GNU extension function STATUS = SIGNAL(number, handler)
std::int64_t RTNAME(Signal)(std::int64_t number, void (*handler)(int));

2
flang/lib/Evaluate/intrinsics.cpp
View File

@ -620,6 +620,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"log10", {{"x", SameReal}}, SameReal},
{"logical", {{"l", AnyLogical}, DefaultingKIND}, KINDLogical},
{"log_gamma", {{"x", SameReal}}, SameReal},
{"malloc", {{"size", AnyInt}}, SubscriptInt},
{"matmul",
{{"matrix_a", AnyLogical, Rank::vector},
{"matrix_b", AnyLogical, Rank::matrix}},
@ -1409,6 +1410,7 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"exit", {{"status", DefaultInt, Rank::scalar, Optionality::optional}}, {},
Rank::elemental, IntrinsicClass::impureSubroutine},
{"free", {{"ptr", Addressable}}, {}},
{"get_command",
{{"command", DefaultChar, Rank::scalar, Optionality::optional,
common::Intent::Out},

15
flang/lib/Optimizer/Builder/IntrinsicCall.cpp
View File

@ -265,6 +265,7 @@ static constexpr IntrinsicHandler handlers[]{
/*isElemental=*/false},
{"floor", &I::genFloor},
{"fraction", &I::genFraction},
{"free", &I::genFree},
{"get_command",
&I::genGetCommand,
{{{"command", asBox, handleDynamicOptional},
@ -436,6 +437,7 @@ static constexpr IntrinsicHandler handlers[]{
{"lle", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sle>},
{"llt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::slt>},
{"loc", &I::genLoc, {{{"x", asBox}}}, /*isElemental=*/false},
{"malloc", &I::genMalloc},
{"maskl", &I::genMask<mlir::arith::ShLIOp>},
{"maskr", &I::genMask<mlir::arith::ShRUIOp>},
{"matmul",
@ -3581,6 +3583,12 @@ mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
}
void IntrinsicLibrary::genFree(llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 1);
fir::runtime::genFree(builder, loc, fir::getBase(args[0]));
}
// GETCWD
fir::ExtendedValue
IntrinsicLibrary::genGetCwd(std::optional<mlir::Type> resultType,
@ -5307,6 +5315,13 @@ IntrinsicLibrary::genLoc(mlir::Type resultType,
.getResults()[0];
}
mlir::Value IntrinsicLibrary::genMalloc(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
assert(args.size() == 1);
return builder.createConvert(loc, resultType,
fir::runtime::genMalloc(builder, loc, args[0]));
}
// MASKL, MASKR
template <typename Shift>
mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType,

20
flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
View File

@ -120,6 +120,26 @@ void fir::runtime::genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
builder.create<fir::CallOp>(loc, runtimeFunc, args);
}
void fir::runtime::genFree(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value ptr) {
auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Free)>(loc, builder);
mlir::Type intPtrTy = builder.getIntPtrType();
builder.create<fir::CallOp>(loc, runtimeFunc,
builder.createConvert(loc, intPtrTy, ptr));
}
mlir::Value fir::runtime::genMalloc(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value size) {
auto runtimeFunc =
fir::runtime::getRuntimeFunc<mkRTKey(Malloc)>(loc, builder);
auto argTy = runtimeFunc.getArgumentTypes()[0];
return builder
.create<fir::CallOp>(loc, runtimeFunc,
builder.createConvert(loc, argTy, size))
.getResult(0);
}
void fir::runtime::genRandomInit(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value repeatable,
mlir::Value imageDistinct) {

14
flang/lib/Semantics/check-call.cpp
View File

@ -1600,6 +1600,18 @@ static void CheckMaxMin(const characteristics::Procedure &proc,
}
}
static void CheckFree(evaluate::ActualArguments &arguments,
parser::ContextualMessages &messages) {
if (arguments.size() != 1) {
messages.Say("FREE expects a single argument"_err_en_US);
}
auto arg = arguments[0];
if (const Symbol * symbol{evaluate::UnwrapWholeSymbolDataRef(arg)};
!symbol || !symbol->test(Symbol::Flag::CrayPointer)) {
messages.Say("FREE should only be used with Cray pointers"_warn_en_US);
}
}
// MOVE_ALLOC (F'2023 16.9.147)
static void CheckMove_Alloc(evaluate::ActualArguments &arguments,
parser::ContextualMessages &messages) {
@ -1885,6 +1897,8 @@ static void CheckSpecificIntrinsic(const characteristics::Procedure &proc,
CheckReduce(arguments, context.foldingContext());
} else if (intrinsic.name == "transfer") {
CheckTransfer(arguments, context, scope);
} else if (intrinsic.name == "free") {
CheckFree(arguments, context.foldingContext().messages());
}
}

8
flang/runtime/extensions.cpp
View File

@ -96,6 +96,10 @@ void FORTRAN_PROCEDURE_NAME(fdate)(char *arg, std::int64_t length) {
CopyAndPad(arg, str, length, 24);
}
std::intptr_t RTNAME(Malloc)(std::size_t size) {
return reinterpret_cast<std::intptr_t>(std::malloc(size));
}
// RESULT = IARGC()
std::int32_t FORTRAN_PROCEDURE_NAME(iargc)() { return RTNAME(ArgumentCount)(); }
@ -124,6 +128,10 @@ void FORTRAN_PROCEDURE_NAME(getlog)(char *arg, std::int64_t length) {
#endif
}
void RTNAME(Free)(std::intptr_t ptr) {
std::free(reinterpret_cast<void *>(ptr));
}
std::int64_t RTNAME(Signal)(std::int64_t number, void (*handler)(int)) {
// using auto for portability:
// on Windows, this is a void *

66
flang/test/Lower/Intrinsics/free.f90 Normal file
View File

@ -0,0 +1,66 @@
! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
! CHECK-LABEL: func.func @_QPfree_ptr() {
subroutine free_ptr()
integer :: x
pointer (ptr_x, x)
! CHECK: %[[X:.*]] = fir.alloca !fir.box<!fir.ptr<i32>>
! CHECK: %[[X_PTR:.*]] = fir.alloca i64 {bindc_name = "ptr_x", uniq_name = "_QFfree_ptrEptr_x"}
! CHECK: %[[X_PTR_DECL:.*]]:2 = hlfir.declare %[[X_PTR]] {uniq_name = "_QFfree_ptrEptr_x"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFfree_ptrEx"} : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> (!fir.ref<!fir.box<!fir.ptr<i32>>>, !fir.ref<!fir.box<!fir.ptr<i32>>>)
! CHECK: %[[X_LD:.*]] = fir.load %[[X_PTR_DECL]]#0 : !fir.ref<i64>
! CHECK: %[[VOID:.*]] = fir.call @_FortranAFree(%[[X_LD]]) fastmath<contract> : (i64) -> none
! CHECK: return
call free(ptr_x)
end subroutine
! gfortran allows free to be used on integers, so we accept it with a warning.
! CHECK-LABEL: func.func @_QPfree_i8() {
subroutine free_i8
integer (kind=1) :: x
! CHECK: %[[X:.*]] = fir.alloca i8 {bindc_name = "x", uniq_name = "_QFfree_i8Ex"}
! CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] {uniq_name = "_QFfree_i8Ex"} : (!fir.ref<i8>) -> (!fir.ref<i8>, !fir.ref<i8>)
! CHECK: %[[X_LD:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref<i8>
! CHECK: %[[X_I64:.*]] = fir.convert %[[X_LD]] : (i8) -> i64
! CHECK: %[[VOID:.*]] = fir.call @_FortranAFree(%[[X_I64]]) fastmath<contract> : (i64) -> none
! CHECK: return
call free(x)
end subroutine
! CHECK-LABEL: func.func @_QPfree_i16() {
subroutine free_i16
integer (kind=2) :: x
! CHECK: %[[X:.*]] = fir.alloca i16 {bindc_name = "x", uniq_name = "_QFfree_i16Ex"}
! CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] {uniq_name = "_QFfree_i16Ex"} : (!fir.ref<i16>) -> (!fir.ref<i16>, !fir.ref<i16>)
! CHECK: %[[X_LD:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref<i16>
! CHECK: %[[X_I64:.*]] = fir.convert %[[X_LD]] : (i16) -> i64
! CHECK: %[[VOID:.*]] = fir.call @_FortranAFree(%[[X_I64]]) fastmath<contract> : (i64) -> none
! CHECK: return
call free(x)
end subroutine
! CHECK-LABEL: func.func @_QPfree_i32() {
subroutine free_i32
integer (kind=4) :: x
! CHECK: %[[X:.*]] = fir.alloca i32 {bindc_name = "x", uniq_name = "_QFfree_i32Ex"}
! CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] {uniq_name = "_QFfree_i32Ex"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
! CHECK: %[[X_LD:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref<i32>
! CHECK: %[[X_I64:.*]] = fir.convert %[[X_LD]] : (i32) -> i64
! CHECK: %[[VOID:.*]] = fir.call @_FortranAFree(%[[X_I64]]) fastmath<contract> : (i64) -> none
! CHECK: return
call free(x)
end subroutine
! CHECK-LABEL: func.func @_QPfree_i64() {
subroutine free_i64
integer (kind=8) :: x
! CHECK: %[[X:.*]] = fir.alloca i64 {bindc_name = "x", uniq_name = "_QFfree_i64Ex"}
! CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] {uniq_name = "_QFfree_i64Ex"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[X_LD:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref<i64>
! CHECK: %[[VOID:.*]] = fir.call @_FortranAFree(%[[X_LD]]) fastmath<contract> : (i64) -> none
! CHECK: return
call free(x)
end subroutine

75
flang/test/Lower/Intrinsics/malloc.f90 Normal file
View File

@ -0,0 +1,75 @@
! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
! CHECK-LABEL: func.func @_QPmalloc_ptr() {
subroutine malloc_ptr()
integer :: x
pointer (ptr_x, x)
! CHECK: %[[X:.*]] = fir.alloca !fir.box<!fir.ptr<i32>>
! CHECK: %[[X_PTR:.*]] = fir.alloca i64 {bindc_name = "ptr_x", uniq_name = "_QFmalloc_ptrEptr_x"}
! CHECK: %[[X_PTR_DECL:.*]]:2 = hlfir.declare %[[X_PTR]] {uniq_name = "_QFmalloc_ptrEptr_x"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[CST:.*]] = arith.constant 4 : i32
! CHECK: %[[CST_I64:.*]] = fir.convert %[[CST]] : (i32) -> i64
! CHECK: %[[ALLOC:.*]] = fir.call @_FortranAMalloc(%[[CST_I64]]) fastmath<contract> : (i64) -> i64
! CHECK: hlfir.assign %[[ALLOC]] to %[[X_PTR_DECL]]#0 : i64, !fir.ref<i64>
! CHECK: return
ptr_x = malloc(4)
end subroutine
! gfortran allows malloc to be assigned to integers, so we accept it.
! CHECK-LABEL: func.func @_QPmalloc_i8() {
subroutine malloc_i8()
integer(kind=1) :: x
! CHECK: %[[X:.*]] = fir.alloca i8 {bindc_name = "x", uniq_name = "_QFmalloc_i8Ex"}
! CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] {uniq_name = "_QFmalloc_i8Ex"} : (!fir.ref<i8>) -> (!fir.ref<i8>, !fir.ref<i8>)
! CHECK: %[[CST:.*]] = arith.constant 1 : i32
! CHECK: %[[CST_I64:.*]] = fir.convert %[[CST]] : (i32) -> i64
! CHECK: %[[ALLOC:.*]] = fir.call @_FortranAMalloc(%[[CST_I64]]) fastmath<contract> : (i64) -> i64
! CHECK: %[[ALLOC_I8:.*]] = fir.convert %[[ALLOC]] : (i64) -> i8
! CHECK: hlfir.assign %[[ALLOC_I8]] to %[[X_DECL]]#0 : i8, !fir.ref<i8>
! CHECK: return
x = malloc(1)
end subroutine
! CHECK-LABEL: func.func @_QPmalloc_i16() {
subroutine malloc_i16()
integer(kind=2) :: x
! CHECK: %[[X:.*]] = fir.alloca i16 {bindc_name = "x", uniq_name = "_QFmalloc_i16Ex"}
! CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] {uniq_name = "_QFmalloc_i16Ex"} : (!fir.ref<i16>) -> (!fir.ref<i16>, !fir.ref<i16>)
! CHECK: %[[CST:.*]] = arith.constant 1 : i32
! CHECK: %[[CST_I64:.*]] = fir.convert %[[CST]] : (i32) -> i64
! CHECK: %[[ALLOC:.*]] = fir.call @_FortranAMalloc(%[[CST_I64]]) fastmath<contract> : (i64) -> i64
! CHECK: %[[ALLOC_I16:.*]] = fir.convert %[[ALLOC]] : (i64) -> i16
! CHECK: hlfir.assign %[[ALLOC_I16]] to %[[X_DECL]]#0 : i16, !fir.ref<i16>
! CHECK: return
x = malloc(1)
end subroutine
! CHECK-LABEL: func.func @_QPmalloc_i32() {
subroutine malloc_i32()
integer(kind=4) :: x
! CHECK: %[[X:.*]] = fir.alloca i32 {bindc_name = "x", uniq_name = "_QFmalloc_i32Ex"}
! CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] {uniq_name = "_QFmalloc_i32Ex"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
! CHECK: %[[CST:.*]] = arith.constant 1 : i32
! CHECK: %[[CST_I64:.*]] = fir.convert %[[CST]] : (i32) -> i64
! CHECK: %[[ALLOC:.*]] = fir.call @_FortranAMalloc(%[[CST_I64]]) fastmath<contract> : (i64) -> i64
! CHECK: %[[ALLOC_I32:.*]] = fir.convert %[[ALLOC]] : (i64) -> i32
! CHECK: hlfir.assign %[[ALLOC_I32]] to %[[X_DECL]]#0 : i32, !fir.ref<i32>
! CHECK: return
x = malloc(1)
end subroutine
! CHECK-LABEL: func.func @_QPmalloc_i64() {
subroutine malloc_i64()
integer(kind=8) :: x
! CHECK: %[[X:.*]] = fir.alloca i64 {bindc_name = "x", uniq_name = "_QFmalloc_i64Ex"}
! CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] {uniq_name = "_QFmalloc_i64Ex"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[CST:.*]] = arith.constant 1 : i32
! CHECK: %[[CST_I64:.*]] = fir.convert %[[CST]] : (i32) -> i64
! CHECK: %[[ALLOC:.*]] = fir.call @_FortranAMalloc(%[[CST_I64]]) fastmath<contract> : (i64) -> i64
! CHECK: hlfir.assign %[[ALLOC]] to %[[X_DECL]]#0 : i64, !fir.ref<i64>
! CHECK: return
x = malloc(1)
end subroutine

33
flang/test/Semantics/free.f90 Normal file
View File

@ -0,0 +1,33 @@
! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
! Accept free of cray pointer without warning
subroutine free_cptr()
integer :: x
pointer(ptr_x, x)
call free(ptr_x)
end subroutine
subroutine free_i8()
integer(kind=1) :: x
! WARNING: FREE should only be used with Cray pointers
call free(x)
end subroutine
subroutine free_i16()
integer(kind=2) :: x
! WARNING: FREE should only be used with Cray pointers
call free(x)
end subroutine
subroutine free_i32()
integer(kind=4) :: x
! WARNING: FREE should only be used with Cray pointers
call free(x)
end subroutine
subroutine free_i64()
integer(kind=8) :: x
! WARNING: FREE should only be used with Cray pointers
call free(x)
end subroutine