diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index 87716731ead85..d6f48a7fd87d7 100644 --- a/flang/docs/Intrinsics.md +++ b/flang/docs/Intrinsics.md @@ -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 | diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h index 78bb82b17d405..ca4030816b1a0 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -249,6 +249,7 @@ struct IntrinsicLibrary { mlir::Value genFloor(mlir::Type, llvm::ArrayRef); mlir::Value genFraction(mlir::Type resultType, mlir::ArrayRef args); + void genFree(mlir::ArrayRef args); fir::ExtendedValue genGetCwd(std::optional resultType, llvm::ArrayRef args); void genGetCommand(mlir::ArrayRef args); @@ -315,6 +316,7 @@ struct IntrinsicLibrary { fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genLoc(mlir::Type, llvm::ArrayRef); + mlir::Value genMalloc(mlir::Type, llvm::ArrayRef); template mlir::Value genMask(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genMatmul(mlir::Type, llvm::ArrayRef); diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h index 240de5a899d37..f62071a49e3bf 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h @@ -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); diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h index fef651f3b2eed..8b7607be7e999 100644 --- a/flang/include/flang/Runtime/extensions.h +++ b/flang/include/flang/Runtime/extensions.h @@ -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)); diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 17a09c080e72c..a89e9732228cb 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -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}, diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index 4e6d92213c124..86f7d14c6592b 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -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}, {"llt", &I::genCharacterCompare}, {"loc", &I::genLoc, {{{"x", asBox}}}, /*isElemental=*/false}, + {"malloc", &I::genMalloc}, {"maskl", &I::genMask}, {"maskr", &I::genMask}, {"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 args) { + assert(args.size() == 1); + + fir::runtime::genFree(builder, loc, fir::getBase(args[0])); +} + // GETCWD fir::ExtendedValue IntrinsicLibrary::genGetCwd(std::optional resultType, @@ -5307,6 +5315,13 @@ IntrinsicLibrary::genLoc(mlir::Type resultType, .getResults()[0]; } +mlir::Value IntrinsicLibrary::genMalloc(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 1); + return builder.createConvert(loc, resultType, + fir::runtime::genMalloc(builder, loc, args[0])); +} + // MASKL, MASKR template mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType, diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp index aff3cadc3c300..cf2483d36c027 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp @@ -120,6 +120,26 @@ void fir::runtime::genEtime(fir::FirOpBuilder &builder, mlir::Location loc, builder.create(loc, runtimeFunc, args); } +void fir::runtime::genFree(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value ptr) { + auto runtimeFunc = fir::runtime::getRuntimeFunc(loc, builder); + mlir::Type intPtrTy = builder.getIntPtrType(); + + builder.create(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(loc, builder); + auto argTy = runtimeFunc.getArgumentTypes()[0]; + return builder + .create(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) { diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 71d1c083c3127..31079174239c2 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -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()); } } diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp index be3833db88b07..4412a9cbeb6d2 100644 --- a/flang/runtime/extensions.cpp +++ b/flang/runtime/extensions.cpp @@ -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::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(ptr)); +} + std::int64_t RTNAME(Signal)(std::int64_t number, void (*handler)(int)) { // using auto for portability: // on Windows, this is a void * diff --git a/flang/test/Lower/Intrinsics/free.f90 b/flang/test/Lower/Intrinsics/free.f90 new file mode 100644 index 0000000000000..bb8d38e737aa7 --- /dev/null +++ b/flang/test/Lower/Intrinsics/free.f90 @@ -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> + ! 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) -> (!fir.ref, !fir.ref) + ! CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFfree_ptrEx"} : (!fir.ref>>) -> (!fir.ref>>, !fir.ref>>) + ! CHECK: %[[X_LD:.*]] = fir.load %[[X_PTR_DECL]]#0 : !fir.ref + ! CHECK: %[[VOID:.*]] = fir.call @_FortranAFree(%[[X_LD]]) fastmath : (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) -> (!fir.ref, !fir.ref) + ! CHECK: %[[X_LD:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref + ! CHECK: %[[X_I64:.*]] = fir.convert %[[X_LD]] : (i8) -> i64 + ! CHECK: %[[VOID:.*]] = fir.call @_FortranAFree(%[[X_I64]]) fastmath : (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) -> (!fir.ref, !fir.ref) + ! CHECK: %[[X_LD:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref + ! CHECK: %[[X_I64:.*]] = fir.convert %[[X_LD]] : (i16) -> i64 + ! CHECK: %[[VOID:.*]] = fir.call @_FortranAFree(%[[X_I64]]) fastmath : (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) -> (!fir.ref, !fir.ref) + ! CHECK: %[[X_LD:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref + ! CHECK: %[[X_I64:.*]] = fir.convert %[[X_LD]] : (i32) -> i64 + ! CHECK: %[[VOID:.*]] = fir.call @_FortranAFree(%[[X_I64]]) fastmath : (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) -> (!fir.ref, !fir.ref) + ! CHECK: %[[X_LD:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref + ! CHECK: %[[VOID:.*]] = fir.call @_FortranAFree(%[[X_LD]]) fastmath : (i64) -> none + ! CHECK: return + call free(x) +end subroutine diff --git a/flang/test/Lower/Intrinsics/malloc.f90 b/flang/test/Lower/Intrinsics/malloc.f90 new file mode 100644 index 0000000000000..4a9b65bf7ae18 --- /dev/null +++ b/flang/test/Lower/Intrinsics/malloc.f90 @@ -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> + ! 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) -> (!fir.ref, !fir.ref) + ! CHECK: %[[CST:.*]] = arith.constant 4 : i32 + ! CHECK: %[[CST_I64:.*]] = fir.convert %[[CST]] : (i32) -> i64 + ! CHECK: %[[ALLOC:.*]] = fir.call @_FortranAMalloc(%[[CST_I64]]) fastmath : (i64) -> i64 + ! CHECK: hlfir.assign %[[ALLOC]] to %[[X_PTR_DECL]]#0 : i64, !fir.ref + ! 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) -> (!fir.ref, !fir.ref) +! CHECK: %[[CST:.*]] = arith.constant 1 : i32 +! CHECK: %[[CST_I64:.*]] = fir.convert %[[CST]] : (i32) -> i64 +! CHECK: %[[ALLOC:.*]] = fir.call @_FortranAMalloc(%[[CST_I64]]) fastmath : (i64) -> i64 +! CHECK: %[[ALLOC_I8:.*]] = fir.convert %[[ALLOC]] : (i64) -> i8 +! CHECK: hlfir.assign %[[ALLOC_I8]] to %[[X_DECL]]#0 : i8, !fir.ref +! 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) -> (!fir.ref, !fir.ref) +! CHECK: %[[CST:.*]] = arith.constant 1 : i32 +! CHECK: %[[CST_I64:.*]] = fir.convert %[[CST]] : (i32) -> i64 +! CHECK: %[[ALLOC:.*]] = fir.call @_FortranAMalloc(%[[CST_I64]]) fastmath : (i64) -> i64 +! CHECK: %[[ALLOC_I16:.*]] = fir.convert %[[ALLOC]] : (i64) -> i16 +! CHECK: hlfir.assign %[[ALLOC_I16]] to %[[X_DECL]]#0 : i16, !fir.ref +! 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) -> (!fir.ref, !fir.ref) +! CHECK: %[[CST:.*]] = arith.constant 1 : i32 +! CHECK: %[[CST_I64:.*]] = fir.convert %[[CST]] : (i32) -> i64 +! CHECK: %[[ALLOC:.*]] = fir.call @_FortranAMalloc(%[[CST_I64]]) fastmath : (i64) -> i64 +! CHECK: %[[ALLOC_I32:.*]] = fir.convert %[[ALLOC]] : (i64) -> i32 +! CHECK: hlfir.assign %[[ALLOC_I32]] to %[[X_DECL]]#0 : i32, !fir.ref +! 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) -> (!fir.ref, !fir.ref) +! CHECK: %[[CST:.*]] = arith.constant 1 : i32 +! CHECK: %[[CST_I64:.*]] = fir.convert %[[CST]] : (i32) -> i64 +! CHECK: %[[ALLOC:.*]] = fir.call @_FortranAMalloc(%[[CST_I64]]) fastmath : (i64) -> i64 +! CHECK: hlfir.assign %[[ALLOC]] to %[[X_DECL]]#0 : i64, !fir.ref +! CHECK: return + x = malloc(1) +end subroutine diff --git a/flang/test/Semantics/free.f90 b/flang/test/Semantics/free.f90 new file mode 100644 index 0000000000000..6332f03b19cd8 --- /dev/null +++ b/flang/test/Semantics/free.f90 @@ -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