diff --git a/Fortran/UnitTests/CMakeLists.txt b/Fortran/UnitTests/CMakeLists.txt index 07269cbac6..84979dd70f 100644 --- a/Fortran/UnitTests/CMakeLists.txt +++ b/Fortran/UnitTests/CMakeLists.txt @@ -1,3 +1,4 @@ # This file should only contain add_subdirectory(...) one for each test add_subdirectory(hello) add_subdirectory(fcvs21_f95) # NIST Fortran Compiler Validation Suite +add_subdirectory(finalization) diff --git a/Fortran/UnitTests/finalization/.gitignore b/Fortran/UnitTests/finalization/.gitignore new file mode 100644 index 0000000000..959387d4b6 --- /dev/null +++ b/Fortran/UnitTests/finalization/.gitignore @@ -0,0 +1,4 @@ +# Configure the file below into the source tree with CMake so that the +# testing infrastructure can find it. + +specification_expression_finalization.reference_output diff --git a/Fortran/UnitTests/finalization/CMakeLists.txt b/Fortran/UnitTests/finalization/CMakeLists.txt new file mode 100644 index 0000000000..d62b86a658 --- /dev/null +++ b/Fortran/UnitTests/finalization/CMakeLists.txt @@ -0,0 +1,38 @@ +include(CheckFortranCompilerFlag) + +# LLVMFlang prefixes error stop output to stdout/stderr with "Fortran" +# and other compilers don't. +# The `specification_expression_finalization.f90` test requires +# examining the output of an `error_stop` statement. +# Configure the expected results based on the Fortran compiler in use. + +set(MAYBE_LLVM_ERROR_STOP_PREFIX "") +set(MAYBE_LLVM_ERROR_STOP_COLON "") +if(CMAKE_Fortran_COMPILER_ID MATCHES "LLVMFlang") + set(MAYBE_LLVM_ERROR_STOP_PREFIX "Fortran ") + set(MAYBE_LLVM_ERROR_STOP_COLON ":") +endif() + +configure_file( + specification_expression_finalization.reference_output.in + ${CMAKE_CURRENT_SOURCE_DIR}/specification_expression_finalization.reference_output + @ONLY) + +set(Source) +list(APPEND Source + allocatable_component.f90 + allocated_allocatable_lhs.f90 + block_end.f90 + finalize_on_deallocate.f90 + finalize_on_end.f90 + intent_out.f90 + lhs_object.f90 + rhs_function_reference.f90 + specification_expression_finalization.f90 + target_deallocation.f90) + +# set(FP_IGNOREWHITESPACE OFF) + +llvm_singlesource() + +file(COPY lit.local.cfg DESTINATION "${CMAKE_CURRENT_BINARY_DIR}") diff --git a/Fortran/UnitTests/finalization/README.md b/Fortran/UnitTests/finalization/README.md new file mode 100644 index 0000000000..19c9f39a8f --- /dev/null +++ b/Fortran/UnitTests/finalization/README.md @@ -0,0 +1,151 @@ +Finalization Unit Tests +======================= + +This suite of tests was created originally by Wileam Phan, Damian Rouson, +and Brad Richardson as part of the +[[ https://github.com/sourceryinstitute/smart-pointers | Smart-Pointers ]] +library's test suite. +All compilers, except for NAG, did not initially have a working/correct +implmentation of finalization. +An all-in-one reproducer test was created to share with compiler +teams that was easy to run (just compile a single file and run it). +This is ideal for reporting bugs to compiler teams, +but not appropriate for inclusion in a compiler test suite. + +The original adaptation for inclusion in the llvm-test-suite can be found here: + +* https://github.com/BerkeleyLab/llvm-test-suite/tree/damians-fortran-type-finalization + SHA: `0268bcf0048e67cd1280f9ef65aebd2aa402130b` +* https://github.com/BerkeleyLab/llvm-test-suite/tree/berkely-lab-damian-v0.1 + SHA: `0268bcf0048e67cd1280f9ef65aebd2aa402130b` + +The test suite was then adapted to be made appropriate for inclusion +in a compiler test suite by Izaak Beekman. +Broadly, this required: + +- Each test should be broken into in individual file. +- Each test should have a corresponding expected output. +- Use the compilers build system rather than a custom fortran driver program + (relying) on `execute_command_line`. +- The tests should be incorporated following the conventions adopted by the + compiler project. +- The README/documentation should be updated and made appropriate for keeping + in the compiler project's test suite repository. + - e.g., Describe the tests and how to use them + - Don't keep information about what version of which compiler works since + it will get stale quickly and be a maintainance headache. + +To run these finalization tests, and only these tests, +first you must build a recent version of llvm flang. +LLVM version d585a8afdf2f70159759dccb11d775cdf432aba4, +from Fri Apr 7 18:12:12 2023 +0000 is known to work. +Newer versions should work as well unless a regression is introduced. + +You can setup your directory structure as follows: + +``` +llvm-project # llvm-project/llvm source code +├── build # Build directory for llvm-project/flang +├── test-suite # llvm-project/llvm-test-suite source code +└── test-suite-build # Build directory for test-suite +``` + +Flang is built in the `build` subdirectory. +The test-suite-build directory is created by the user +and is initially empty until running CMake for the teset-suite. +To configure, build and run the tests once llvm/flang has been built, +a command similar to the following can be used from within test-suite-build: + +``` shell +cmake -DCMAKE_BUILD_TYPE=Release \ + -DCMAKE_Fortran_COMPILER:FILEPATH=/home/users//llvm-project/build/bin/flang-new \ + -DCMAKE_Fortran_FLAGS=-flang-experimental-exec \ + -DTEST_SUITE_FORTRAN:BOOL=On \ + -DTEST_SUITE_SUBDIRS=Fortran/UnitTests/finalization \ + ../test-suite +make -j 4 +../build/bin/llvm-lit Fortran/UnitTests/finalization +``` + +Summary of Tests +---------------- + +* [`allocatable_component.f90`] + * Finalizes an allocatable component object on deallocation of an intent out dymmy argument + * Test conformance with Fortran 2018 clause 7.5.6.3, para. 2 ("allocatable entity is deallocated") + + 9.7.3.2, para. 6 ("INTENT(OUT) allocatable dummy argument is deallocated") +* [`allocated_allocatable_lhs.f90`] + * Finalizes an allocated allocatable LHS of an intrinsic assignment + * Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 1 behavior: + "allocated allocatable variable" +* [`block_end.f90`] + * Finalizes a non-pointer non-allocatable object at the end of a block construct + * Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 4: + "termination of the BLOCK construct" +* [`finalize_on_deallocate.f90`] + * Finalizes an object upon explicit deallocation + * Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 2: + "allocatable entity is deallocated" +* [`finalize_on_end.f90`] + * finalizes a non-pointer non-allocatable object at the END statement + * Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 3: + "before return or END statement" +* [`intent_out.f90`] + * Finalizes an intent(out) derived type dummy argument + * Test conformance with Fortran 2018 standard clause 7.5.6.3, paragraph 7: + "nonpointer, nonallocatable, INTENT (OUT) dummy argument" +* [`lhs_object.f90`] + * Finalizes a non-allocatable object on the LHS of an intrinsic assignment + * Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 1 behavior: + "not an unallocated allocatable variable" +* [`rhs_function_reference.f90`] + * Finalizes a function reference on the RHS of an intrinsic assignment + * Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 5 behavior: + "nonpointer function result" +* [`specification_expression_finalization.f90`] + * Finalizes a function result in a specification expression + * Test compiler conformance with clause 7.5.6.3, paragraph 6 in the Fortran + Interpretation Document (https://j3-fortran.org/doc/year/18/18-007r1.pdf): + "If a specification expression in a scoping unit references + a function, the result is finalized before execution of the executable + constructs in the scoping unit." (The same statement appears in clause + 4.5.5.2, paragraph 5 of the Fortran 2003 standard.) In such a scenario, + the final subroutine must be pure. The only way to observe output from + a pure final subroutine is for the subroutine to execute an error stop + statement. A correct execution of this test will error-terminate and ouput + the text "finalize: intentional error termination to verify finalization". +* [`target_deallocation.f90`] + * Finalizes a target when the associated pointer is deallocated + * Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 2 behavior: + "pointer is deallocated" + + +Common Code +----------- + +* [`object_type_m.f90`] + * To reduce code duplication, yet allow each test to be treated by + CMake as a single source file, a small amount of common code is + `include`d from this file by each test file. + * Due to the way CMake handles `.mod` module files, it is important + that each of the test files uses unique module names, otherwise + CMake will encounter a race condition when building in parallel + wherein it might clobber a `.mod` module file or corresponding + timestamp when multiple `.mod` files are being created with the + same name. + * This file contains the main derived type object for testing and the + corresponding final subroutine, `count_finalizations` to verify that + finalization took pace (by counting finalizations in a public module + variable) + +[`allocatable_component.f90`]: ./allocatable_component.f90 +[`allocated_allocatable_lhs.f90`]: ./allocated_allocatable_lhs.f90 +[`block_end.f90`]: ./block_end.f90 +[`finalize_on_deallocate.f90`]: ./finalize_on_deallocate.f90 +[`finalize_on_end.f90`]: ./finalize_on_end.f90 +[`intent_out.f90`]: ./intent_out.f90 +[`lhs_object.f90`]: ./lhs_object.f90 +[`rhs_function_reference.f90`]: ./rhs_function_reference.f90 +[`specification_expression_finalization.f90`]: ./specification_expression_finalization.f90 +[`target_deallocation.f90`]: ./target_deallocation.f90 +[`object_type_m.f90`]: ./object_type_m.f90 diff --git a/Fortran/UnitTests/finalization/allocatable_component.f90 b/Fortran/UnitTests/finalization/allocatable_component.f90 new file mode 100644 index 0000000000..07dc82bc55 --- /dev/null +++ b/Fortran/UnitTests/finalization/allocatable_component.f90 @@ -0,0 +1,40 @@ +module allocatable_component_m + include "object_type_m.f90" + + function allocatable_component() result(outcome) + !! Test conformance with Fortran 2018 clause 7.5.6.3, para. 2 ("allocatable entity is deallocated") + !! + 9.7.3.2, para. 6 ("INTENT(OUT) allocatable dummy argument is deallocated") + !! finalizes an allocatable component object + type(wrapper_t), allocatable :: wrapper + logical outcome + integer initial_tally + + initial_tally = finalizations + + allocate(wrapper) + allocate(wrapper%object) + call finalize_intent_out_component(wrapper) + associate(finalization_tally => finalizations - initial_tally) + outcome = finalization_tally==1 + end associate + + contains + + subroutine finalize_intent_out_component(output) + type(wrapper_t), intent(out) :: output ! finalizes object component + allocate(output%object) + output%object%dummy = avoid_unused_variable_warning + end subroutine + + end function + +end module allocatable_component_m + +program main + use allocatable_component_m, only : allocatable_component, report + implicit none + character(len=*), parameter :: description = "finalizes an allocatable component object" + + write(*,"(A)") report(allocatable_component()) // description + +end program diff --git a/Fortran/UnitTests/finalization/allocatable_component.reference_output b/Fortran/UnitTests/finalization/allocatable_component.reference_output new file mode 100644 index 0000000000..edd2375a48 --- /dev/null +++ b/Fortran/UnitTests/finalization/allocatable_component.reference_output @@ -0,0 +1,2 @@ +Pass: finalizes an allocatable component object +exit 0 diff --git a/Fortran/UnitTests/finalization/allocated_allocatable_lhs.f90 b/Fortran/UnitTests/finalization/allocated_allocatable_lhs.f90 new file mode 100644 index 0000000000..1a3d824fe5 --- /dev/null +++ b/Fortran/UnitTests/finalization/allocated_allocatable_lhs.f90 @@ -0,0 +1,31 @@ +module allocated_allocatable_lhs_m + include "object_type_m.f90" + + function allocated_allocatable_lhs() result(outcome) + !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 1 behavior: + !! "allocated allocatable variable" + !! finalizes an allocated allocatable LHS of an intrinsic assignment + type(object_t), allocatable :: lhs + type(object_t) rhs + logical outcome + integer initial_tally + + rhs%dummy = avoid_unused_variable_warning + initial_tally = finalizations + allocate(lhs) + lhs = rhs ! finalizes lhs + associate(finalization_tally => finalizations - initial_tally) + outcome = finalization_tally==1 + end associate + end function + +end module allocated_allocatable_lhs_m + +program main + use allocated_allocatable_lhs_m, only : allocated_allocatable_lhs, report + implicit none + character(len=*), parameter :: description = "finalizes an allocated allocatable LHS of an intrinsic assignment" + + write(*,"(A)") report(allocated_allocatable_lhs()) // description + +end program diff --git a/Fortran/UnitTests/finalization/allocated_allocatable_lhs.reference_output b/Fortran/UnitTests/finalization/allocated_allocatable_lhs.reference_output new file mode 100644 index 0000000000..621493da4f --- /dev/null +++ b/Fortran/UnitTests/finalization/allocated_allocatable_lhs.reference_output @@ -0,0 +1,2 @@ +Pass: finalizes an allocated allocatable LHS of an intrinsic assignment +exit 0 diff --git a/Fortran/UnitTests/finalization/block_end.f90 b/Fortran/UnitTests/finalization/block_end.f90 new file mode 100644 index 0000000000..c0cacf3b4a --- /dev/null +++ b/Fortran/UnitTests/finalization/block_end.f90 @@ -0,0 +1,31 @@ +module block_end_m + include "object_type_m.f90" + + function block_end() result(outcome) + !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 4: + !! "termination of the BLOCK construct" + !! finalizes a non-pointer non-allocatable object at the end of a block construct + logical outcome + integer initial_tally + + initial_tally = finalizations + block + type(object_t) object + object % dummy = avoid_unused_variable_warning + end block ! Finalizes object + associate(finalization_tally => finalizations - initial_tally) + outcome = finalization_tally==1 + end associate + end function + +end module block_end_m + +program main + use block_end_m, only : block_end, report + implicit none + character(len=*), parameter :: description = & + "finalizes a non-pointer non-allocatable object at the end of a block construct" + + write(*,"(A)") report(block_end()) // description + +end program diff --git a/Fortran/UnitTests/finalization/block_end.reference_output b/Fortran/UnitTests/finalization/block_end.reference_output new file mode 100644 index 0000000000..14f04987d4 --- /dev/null +++ b/Fortran/UnitTests/finalization/block_end.reference_output @@ -0,0 +1,2 @@ +Pass: finalizes a non-pointer non-allocatable object at the end of a block construct +exit 0 diff --git a/Fortran/UnitTests/finalization/finalize_on_deallocate.f90 b/Fortran/UnitTests/finalization/finalize_on_deallocate.f90 new file mode 100644 index 0000000000..b8f5315a9d --- /dev/null +++ b/Fortran/UnitTests/finalization/finalize_on_deallocate.f90 @@ -0,0 +1,31 @@ +module finalize_on_deallocate_m + + include "object_type_m.f90" + + function finalize_on_deallocate() result(outcome) + !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 2: + !! "allocatable entity is deallocated" + !! finalizes an object upon explicit deallocation + type(object_t), allocatable :: object + logical outcome + integer initial_tally + + initial_tally = finalizations + allocate(object) + object%dummy = 1 + deallocate(object) ! finalizes object + associate(final_tally => finalizations - initial_tally) + outcome = final_tally==1 + end associate + end function + +end module finalize_on_deallocate_m + +program main + use finalize_on_deallocate_m, only : finalize_on_deallocate, report + implicit none + character(len=*), parameter :: description = "finalizes an object upon explicit deallocation" + + write(*,"(A)") report(finalize_on_deallocate()) // description + +end program diff --git a/Fortran/UnitTests/finalization/finalize_on_deallocate.reference_output b/Fortran/UnitTests/finalization/finalize_on_deallocate.reference_output new file mode 100644 index 0000000000..7386e9e144 --- /dev/null +++ b/Fortran/UnitTests/finalization/finalize_on_deallocate.reference_output @@ -0,0 +1,2 @@ +Pass: finalizes an object upon explicit deallocation +exit 0 diff --git a/Fortran/UnitTests/finalization/finalize_on_end.f90 b/Fortran/UnitTests/finalization/finalize_on_end.f90 new file mode 100644 index 0000000000..672f1771b8 --- /dev/null +++ b/Fortran/UnitTests/finalization/finalize_on_end.f90 @@ -0,0 +1,37 @@ +module finalize_on_end_m + + include "object_type_m.f90" + + function finalize_on_end() result(outcome) + !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 3: + !! "before return or END statement" + !! finalizes a non-pointer non-allocatable object at the END statement + logical outcome + integer initial_tally + + initial_tally = finalizations + call finalize_on_end_subroutine() ! Finalizes local_obj + associate(final_tally => finalizations - initial_tally) + outcome = final_tally==1 + end associate + + contains + + subroutine finalize_on_end_subroutine() + type(object_t) :: local_obj + local_obj % dummy = avoid_unused_variable_warning + end subroutine + + end function + +end module finalize_on_end_m + +program main + use finalize_on_end_m, only : finalize_on_end, report + implicit none + character(len=*), parameter :: description = & + "finalizes a non-pointer non-allocatable object at the END statement" + + write(*,"(A)") report(finalize_on_end()) // description + +end program diff --git a/Fortran/UnitTests/finalization/finalize_on_end.reference_output b/Fortran/UnitTests/finalization/finalize_on_end.reference_output new file mode 100644 index 0000000000..b002cad95f --- /dev/null +++ b/Fortran/UnitTests/finalization/finalize_on_end.reference_output @@ -0,0 +1,2 @@ +Pass: finalizes a non-pointer non-allocatable object at the END statement +exit 0 diff --git a/Fortran/UnitTests/finalization/intent_out.f90 b/Fortran/UnitTests/finalization/intent_out.f90 new file mode 100644 index 0000000000..8b14ea88b8 --- /dev/null +++ b/Fortran/UnitTests/finalization/intent_out.f90 @@ -0,0 +1,34 @@ +module intent_out_m + + include "object_type_m.f90" + + function intent_out() result(outcome) + !! Test conformance with Fortran 2018 standard clause 7.5.6.3, paragraph 7: + !! "nonpointer, nonallocatable, INTENT (OUT) dummy argument" + !! finalizes an intent(out) derived type dummy argument + logical outcome + type(object_t) object + integer initial_tally + + initial_tally = finalizations + call finalize_intent_out_arg(object) + associate(finalization_tally => finalizations - initial_tally) + outcome = finalization_tally==1 + end associate + contains + subroutine finalize_intent_out_arg(output) + type(object_t), intent(out) :: output ! finalizes output + output%dummy = avoid_unused_variable_warning + end subroutine + end function + +end module intent_out_m + +program main + use intent_out_m, only : intent_out, report + implicit none + character(len=*), parameter :: description = "finalizes an intent(out) derived type dummy argument" + + write(*,"(A)") report(intent_out()) // description + +end program diff --git a/Fortran/UnitTests/finalization/intent_out.reference_output b/Fortran/UnitTests/finalization/intent_out.reference_output new file mode 100644 index 0000000000..a706369cae --- /dev/null +++ b/Fortran/UnitTests/finalization/intent_out.reference_output @@ -0,0 +1,2 @@ +Pass: finalizes an intent(out) derived type dummy argument +exit 0 diff --git a/Fortran/UnitTests/finalization/lhs_object.f90 b/Fortran/UnitTests/finalization/lhs_object.f90 new file mode 100644 index 0000000000..a2376db9c7 --- /dev/null +++ b/Fortran/UnitTests/finalization/lhs_object.f90 @@ -0,0 +1,31 @@ +module lhs_object_m + + include "object_type_m.f90" + + function lhs_object() result(outcome) + !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 1 behavior: + !! "not an unallocated allocatable variable" + !! finalizes a non-allocatable object on the LHS of an intrinsic assignment + type(object_t) lhs, rhs + logical outcome + integer initial_tally + + rhs%dummy = avoid_unused_variable_warning + initial_tally = finalizations + lhs = rhs ! finalizes lhs + associate(finalization_tally => finalizations - initial_tally) + outcome = finalization_tally==1 + end associate + end function + +end module lhs_object_m + +program main + use lhs_object_m, only : lhs_object, report + implicit none + character(len=*), parameter :: description = & + "finalizes a non-allocatable object on the LHS of an intrinsic assignment" + + write(*,"(A)") report(lhs_object()) // description + +end program diff --git a/Fortran/UnitTests/finalization/lhs_object.reference_output b/Fortran/UnitTests/finalization/lhs_object.reference_output new file mode 100644 index 0000000000..e9a544bd95 --- /dev/null +++ b/Fortran/UnitTests/finalization/lhs_object.reference_output @@ -0,0 +1,2 @@ +Pass: finalizes a non-allocatable object on the LHS of an intrinsic assignment +exit 0 diff --git a/Fortran/UnitTests/finalization/lit.local.cfg b/Fortran/UnitTests/finalization/lit.local.cfg new file mode 100644 index 0000000000..65ced08f42 --- /dev/null +++ b/Fortran/UnitTests/finalization/lit.local.cfg @@ -0,0 +1,8 @@ +config.traditional_output = True +config.single_source = True + +# Flang uses NO_STOP_MESSAGE to control the output of the STOP statement. If +# it is present in the environment, we should forward it to the tests, otherwise +# they might choke on warnings about signaling INEXACT exceptions. +if 'NO_STOP_MESSAGE' in os.environ: + config.environment['NO_STOP_MESSAGE'] = os.environ['NO_STOP_MESSAGE'] diff --git a/Fortran/UnitTests/finalization/object_type_m.f90 b/Fortran/UnitTests/finalization/object_type_m.f90 new file mode 100644 index 0000000000..8cbdaefe87 --- /dev/null +++ b/Fortran/UnitTests/finalization/object_type_m.f90 @@ -0,0 +1,50 @@ + !! This file gets `include "..."`-ed from each main program. + !! To prevent a CMake race condition, each main program also declares + !! a unique module name so that the .mod files don't clobber eachother. + !! + !! Common object type module to be included in the test that: + !! Define tests for each scenario in which the Fortran 2018 + !! standard mandates type finalization. + implicit none + + public !! Needed for declaring module procedures at the top of each main program + public :: report + private :: construct_object, count_finalizations, object_t, wrapper_t, finalizations, avoid_unused_variable_warning + + type object_t + integer dummy + contains + !! Comment out the following line to prove the tests will fail + final :: count_finalizations + end type + + type wrapper_t + private + type(object_t), allocatable :: object + end type + + integer :: finalizations = 0 + integer, parameter :: avoid_unused_variable_warning = 1 + +contains + + function construct_object() result(object) + !! Constructor for object_t + type(object_t) object + object % dummy = avoid_unused_variable_warning + end function + + subroutine count_finalizations(self) + !! Destructor for object_t + type(object_t), intent(inout) :: self + finalizations = finalizations + 1 + self % dummy = avoid_unused_variable_warning + end subroutine + + pure function report(outcome) + logical, intent(in) :: outcome + character(len=:), allocatable :: report + report = merge("Pass: ", "Fail: ", outcome) + end function + + !! No end module statement since this will be `include`d from other source files diff --git a/Fortran/UnitTests/finalization/rhs_function_reference.f90 b/Fortran/UnitTests/finalization/rhs_function_reference.f90 new file mode 100644 index 0000000000..a9c934a2aa --- /dev/null +++ b/Fortran/UnitTests/finalization/rhs_function_reference.f90 @@ -0,0 +1,30 @@ +module rhs_function_reference_m + + include "object_type_m.f90" + + function rhs_function_reference() result(outcome) + !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 5 behavior: + !! "nonpointer function result" + !! finalizes a function reference on the RHS of an intrinsic assignment + type(object_t), allocatable :: object + logical outcome + integer initial_tally + + initial_tally = finalizations + object = construct_object() ! finalizes object_t result + associate(finalization_tally => finalizations - initial_tally) + outcome = finalization_tally==1 + end associate + end function + +end module rhs_function_reference_m + +program main + use rhs_function_reference_m, only : rhs_function_reference, report + implicit none + character(len=*), parameter :: description = & + "finalizes a function reference on the RHS of an intrinsic assignment" + + write(*,"(A)") report(rhs_function_reference()) // description + +end program diff --git a/Fortran/UnitTests/finalization/rhs_function_reference.reference_output b/Fortran/UnitTests/finalization/rhs_function_reference.reference_output new file mode 100644 index 0000000000..d871bb4a5f --- /dev/null +++ b/Fortran/UnitTests/finalization/rhs_function_reference.reference_output @@ -0,0 +1,2 @@ +Pass: finalizes a function reference on the RHS of an intrinsic assignment +exit 0 diff --git a/Fortran/UnitTests/finalization/specification_expression_finalization.f90 b/Fortran/UnitTests/finalization/specification_expression_finalization.f90 new file mode 100644 index 0000000000..93c37bb9c2 --- /dev/null +++ b/Fortran/UnitTests/finalization/specification_expression_finalization.f90 @@ -0,0 +1,68 @@ +module finalizable_m + !! This module supports the main program at the bottom of this file, which + !! tests compiler conformance with clause 7.5.6.3, paragraph 6 in the Fortran + !! Interpretation Document (https://j3-fortran.org/doc/year/18/18-007r1.pdf): + !! "If a specification expression in a scoping unit references + !! a function, the result is finalized before execution of the executable + !! constructs in the scoping unit." (The same statement appears in clause + !! 4.5.5.2, paragraph 5 of the Fortran 2003 standard.) In such a scenario, + !! the final subroutine must be pure. The only way to observe output from + !! a pure final subroutine is for the subroutine to execute an error stop + !! statement. A correct execution of this test will error-terminate and ouput + !! the text "finalize: intentional error termination to verify finalization". + implicit none + + private + public :: finalizable_t, component + + type finalizable_t + private + integer, pointer :: component_ => null() + contains + !! Comment out the next line to make the tests fail + final :: finalize + end Type + + interface finalizable_t + module procedure construct + end interface + +contains + + pure function construct(component) result(finalizable) + integer, intent(in) :: component + type(finalizable_t) finalizable + allocate(finalizable%component_, source = component) + end function + + pure function component(self) result(self_component) + type(finalizable_t), intent(in) :: self + integer self_component + if (.not. associated(self%component_)) error stop "component: unassociated component" + self_component = self%component_ + end function + + pure subroutine finalize(self) + type(finalizable_t), intent(inout) :: self + if (associated(self%component_)) deallocate(self%component_) + error stop "finalize: intentional error termination to verify finalization" + end subroutine + +end module + +program specification_expression_finalization + !! Test the finalization of a function result in a specification expression + use finalizable_m, only : finalizable_t, component + implicit none + + call finalize_specification_expression_result + +contains + + subroutine finalize_specification_expression_result + real tmp(component(finalizable_t(component=0))) !! Finalizes the finalizable_t function result + real eliminate_unused_variable_warning + tmp = eliminate_unused_variable_warning + end subroutine + +end program diff --git a/Fortran/UnitTests/finalization/specification_expression_finalization.reference_output.in b/Fortran/UnitTests/finalization/specification_expression_finalization.reference_output.in new file mode 100644 index 0000000000..41f5e42b2a --- /dev/null +++ b/Fortran/UnitTests/finalization/specification_expression_finalization.reference_output.in @@ -0,0 +1,2 @@ +@MAYBE_LLVM_ERROR_STOP_PREFIX@ERROR STOP@MAYBE_LLVM_ERROR_STOP_COLON@ finalize: intentional error termination to verify finalization +exit 1 diff --git a/Fortran/UnitTests/finalization/target_deallocation.f90 b/Fortran/UnitTests/finalization/target_deallocation.f90 new file mode 100644 index 0000000000..c8f8b2c546 --- /dev/null +++ b/Fortran/UnitTests/finalization/target_deallocation.f90 @@ -0,0 +1,29 @@ +module target_deallocation_m + include "object_type_m.f90" + + function target_deallocation() result(outcome) + !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 2 behavior: + !! "pointer is deallocated" + !! finalizes a target when the associated pointer is deallocated + type(object_t), pointer :: object_ptr => null() + logical outcome + integer initial_tally + + allocate(object_ptr, source=object_t(dummy=0)) + initial_tally = finalizations + deallocate(object_ptr) ! finalizes object + associate(finalization_tally => finalizations - initial_tally) + outcome = finalization_tally==1 + end associate + end function + +end module target_deallocation_m + +program main + use target_deallocation_m, only : target_deallocation, report + implicit none + character(len=*), parameter :: description = "finalizes a target when the associated pointer is deallocated" + + write(*,"(A)") report(target_deallocation()) // description + +end program diff --git a/Fortran/UnitTests/finalization/target_deallocation.reference_output b/Fortran/UnitTests/finalization/target_deallocation.reference_output new file mode 100644 index 0000000000..555fc11d3f --- /dev/null +++ b/Fortran/UnitTests/finalization/target_deallocation.reference_output @@ -0,0 +1,2 @@ +Pass: finalizes a target when the associated pointer is deallocated +exit 0