Skip to content

Commit

Permalink
[flang] Add MALLOC and FREE intrinsics for Cray pointers (llvm#110018)
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
DavidTruby authored and VitaNuo committed Oct 2, 2024
1 parent 4820728 commit 7caa5fa
Show file tree
Hide file tree
Showing 12 changed files with 245 additions and 2 deletions.
4 changes: 2 additions & 2 deletions flang/docs/Intrinsics.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 |
Expand Down
2 changes: 2 additions & 0 deletions flang/include/flang/Optimizer/Builder/IntrinsicCall.h
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down Expand Up @@ -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>);
Expand Down
4 changes: 4 additions & 0 deletions flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down
4 changes: 4 additions & 0 deletions flang/include/flang/Runtime/extensions.h
Original file line number Diff line number Diff line change
Expand Up @@ -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)();

Expand All @@ -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));

Expand Down
2 changes: 2 additions & 0 deletions flang/lib/Evaluate/intrinsics.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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}},
Expand Down Expand Up @@ -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},
Expand Down
15 changes: 15 additions & 0 deletions flang/lib/Optimizer/Builder/IntrinsicCall.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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},
Expand Down Expand Up @@ -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",
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand Down
20 changes: 20 additions & 0 deletions flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand Down
14 changes: 14 additions & 0 deletions flang/lib/Semantics/check-call.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand Down Expand Up @@ -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());
}
}

Expand Down
8 changes: 8 additions & 0 deletions flang/runtime/extensions.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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)(); }

Expand Down Expand Up @@ -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 *
Expand Down
66 changes: 66 additions & 0 deletions flang/test/Lower/Intrinsics/free.f90
Original file line number Diff line number Diff line change
@@ -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 changes: 75 additions & 0 deletions flang/test/Lower/Intrinsics/malloc.f90
Original file line number Diff line number Diff line change
@@ -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 changes: 33 additions & 0 deletions flang/test/Semantics/free.f90
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit 7caa5fa

Please sign in to comment.