From 7caa5fadf28707c39d510ac5feeacc0b76c22058 Mon Sep 17 00:00:00 2001 From: David Truby Date: Mon, 30 Sep 2024 22:40:16 +0100 Subject: [PATCH] [flang] Add MALLOC and FREE intrinsics for Cray pointers (#110018) 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. --- flang/docs/Intrinsics.md | 4 +- .../flang/Optimizer/Builder/IntrinsicCall.h | 2 + .../Optimizer/Builder/Runtime/Intrinsics.h | 4 + flang/include/flang/Runtime/extensions.h | 4 + flang/lib/Evaluate/intrinsics.cpp | 2 + flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 15 ++++ .../Optimizer/Builder/Runtime/Intrinsics.cpp | 20 +++++ flang/lib/Semantics/check-call.cpp | 14 ++++ flang/runtime/extensions.cpp | 8 ++ flang/test/Lower/Intrinsics/free.f90 | 66 ++++++++++++++++ flang/test/Lower/Intrinsics/malloc.f90 | 75 +++++++++++++++++++ flang/test/Semantics/free.f90 | 33 ++++++++ 12 files changed, 245 insertions(+), 2 deletions(-) create mode 100644 flang/test/Lower/Intrinsics/free.f90 create mode 100644 flang/test/Lower/Intrinsics/malloc.f90 create mode 100644 flang/test/Semantics/free.f90 diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index 87716731ead855..d6f48a7fd87d7b 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 78bb82b17d4050..ca4030816b1a09 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 240de5a899d37b..f62071a49e3bf6 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 fef651f3b2eedb..8b7607be7e999a 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 17a09c080e72c4..a89e9732228cbc 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 4e6d92213c1241..86f7d14c6592b4 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 aff3cadc3c300d..cf2483d36c0274 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 71d1c083c31278..31079174239c24 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 be3833db88b07a..4412a9cbeb6d21 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 00000000000000..bb8d38e737aa72 --- /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 00000000000000..4a9b65bf7ae181 --- /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 00000000000000..6332f03b19cd89 --- /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