diff --git a/Fortran/UnitTests/CMakeLists.txt b/Fortran/UnitTests/CMakeLists.txt --- 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/CMakeLists.txt b/Fortran/UnitTests/finalization/CMakeLists.txt new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/finalization/CMakeLists.txt @@ -0,0 +1,23 @@ +include(CheckFortranCompilerFlag) + +set(Source) + +#file(GLOB Source CONFIGURE_DEPENDS *.f90) +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 --- /dev/null +++ b/Fortran/UnitTests/finalization/README.md @@ -0,0 +1,174 @@ +Type Finalization Tests +======================= + +Standalone compilation and execution steps and results are below for the +following compilers: + +* [NAG] +* [GNU] +* [Cray] +* [Intel] +* [NVIDIA] +* [IBM] +* [AMD] +* [LLVM] + +NAG +--- +- Version: 7.1 (Build 7113) +- Result: 0 test failures. +``` +nagfor compile_me_only.f90 +./a.out + Pass: finalizes a non-allocatable object on the LHS of an intrinsic assignment + Pass: finalizes an allocated allocatable LHS of an intrinsic assignment + Pass: finalizes a target when the associated pointer is deallocated + Pass: finalizes an object upon explicit deallocation + Pass: finalizes a non-pointer non-allocatable object at the END statement + Pass: finalizes a non-pointer non-allocatable object at the end of a block construct + Pass: finalizes a function reference on the RHS of an intrinsic assignment + Pass: finalizes a specification expression function result + Pass: finalizes an intent(out) derived type dummy argument + Pass: finalizes an allocatable component object +``` + +GNU +--- +- Version: 12.2.0 +- Result: 4 test failures. +``` +gfortran compile_me_only.f90 +./a.out + Fail: finalizes a non-allocatable object on the LHS of an intrinsic assignment + Fail: finalizes an allocated allocatable LHS of an intrinsic assignment + Pass: finalizes a target when the associated pointer is deallocated + Pass: finalizes an object upon explicit deallocation + Pass: finalizes a non-pointer non-allocatable object at the END statement + Pass: finalizes a non-pointer non-allocatable object at the end of a block construct + Fail: finalizes a function reference on the RHS of an intrinsic assignment + Fail: finalizes a specification expression function result + Pass: finalizes an intent(out) derived type dummy argument + Pass: finalizes an allocatable component object +``` + +Cray +---- +- Version: 13.0.1 +- Result: 3 test failures. +``` +ftn compile_me_only.f90 +./a.out +Cray Fortran : Version 13.0.1 fails to compile specification_expression_finalization.f90 +Pass: finalizes a non-allocatable object on the LHS of an intrinsic assignment +Fail: finalizes an allocated allocatable LHS of an intrinsic assignment +Pass: finalizes a target when the associated pointer is deallocated +Pass: finalizes an object upon explicit deallocation +Pass: finalizes a non-pointer non-allocatable object at the END statement +Pass: finalizes a non-pointer non-allocatable object at the end of a block construct +Pass: finalizes a function reference on the RHS of an intrinsic assignment +Fail: finalizes a specification expression function result +Fail: finalizes an intent(out) derived type dummy argument +Pass: finalizes an allocatable component object +``` + +Intel +----- +- Version: 2021.1 Beta Build 20200827 +- Result: 2 test failures. +``` +ifort compile_me_only.f90 +./a.out +Pass: finalizes a non-allocatable object on the LHS of an intrinsic assignment +Pass: finalizes an allocated allocatable LHS of an intrinsic assignment +Pass: finalizes a target when the associated pointer is deallocated +Pass: finalizes an object upon explicit deallocation +Pass: finalizes a non-pointer non-allocatable object at the END statement +Pass: finalizes a non-pointer non-allocatable object at the end of a block construct +Fail: finalizes a function reference on the RHS of an intrinsic assignment +Pass: finalizes a specification expression function result +Pass: finalizes an intent(out) derived type dummy argument +Fail: finalizes an allocatable component object + +``` + +NVIDIA +------ +- Version: 22.7-0 64-bit target on x86-64 Linux -tp zen3 +- Result: 2 test failures + +``` +nvfortran compile_me_only.f90 +./a.out +Pass: finalizes a non-allocatable object on the LHS of an intrinsic assignment +Fail: finalizes an allocated allocatable LHS of an intrinsic assignment +Pass: finalizes a target when the associated pointer is deallocated +Pass: finalizes an object upon explicit deallocation +Pass: finalizes a non-pointer non-allocatable object at the END statement +Pass: finalizes a non-pointer non-allocatable object at the end of a block construct +Pass: finalizes a function reference on the RHS of an intrinsic assignment +Pass: finalizes a specification expression function result +Fail: finalizes an intent(out) derived type dummy argument +Pass: finalizes an allocatable component object +``` + +IBM +--- +- Version: IBM Open XL Fortran for AIX 17.1.0 +- Result: 1 test failure + +In order to for the tests to complete in a way that reports all of the results, +place an exclamation mark (`!`) at the beginning of the following line in the +`compile_me_only.f90` file: +``` +,test_result_t("finalizes a specification expression function result", specification_expression()) & +``` +which removes the one failing test. Compiling and excuting the same file then + +``` +xlf2003_r compile_me_only.f90 +./a.out + Pass: finalizes a non-allocatable object on the LHS of an intrinsic assignment + Pass: finalizes an allocated allocatable LHS of an intrinsic assignment + Pass: finalizes a target when the associated pointer is deallocated + Pass: finalizes an object upon explicit deallocation + Pass: finalizes a non-pointer non-allocatable object at the END statement + Pass: finalizes a non-pointer non-allocatable object at the end of a block construct + Pass: finalizes a function reference on the RHS of an intrinsic assignment + Pass: finalizes an intent(out) derived type dummy argument + Pass: finalizes an allocatable component object +``` +**Fail:** Separately compiling `specification_expression_finalization.f90` with +`xlf2003_r` causes a core dump. This is a compiler bug that has been reported to +via the Oak Ridge Leadership Computing Facility (OLCF) under ticket OLCFHELP-9069. + +AMD +--- +- Version tested: 13.0.0 (AOCC_3.2.0-Build#128 2021_11_12) +- Result: Fails to build due to an internal compiler error (ICE) + + +LLVM +---- + +(flang-new) + +- Version tested: `git` commit `76911b5f75907eef53a30cc3` +- Result: Fails with the error message `not yet implemented: derived type finalization` + +- Version tested: `git` commit `27b6ddbf6ea632389f582c0ca1481ed370f0af45` on 2023-04-06. +- Result: Fails with the error message: + +``` +error: loc("/home/users/ibeekman/Sandbox/llvm-project/test-suite/Fortran/UnitTests/finalization/compile_me_only.f90":210:5): /home/users/ibeekman/Sandbox/llvm-project/flang/lib/Optimizer/Builder/IntrinsicCall.cpp:1799: not yet implemented: intrinsic: execute_command_line +LLVM ERROR: aborting +``` + +[NAG]: #nag +[GNU]: #gnu +[Cray]: #cray +[Intel]: #intel +[NVIDIA]: #nvidia +[IBM]: #ibm +[AMD]: #amd +[LLVM]: #llvm + diff --git a/Fortran/UnitTests/finalization/allocatable_component.f90 b/Fortran/UnitTests/finalization/allocatable_component.f90 new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/finalization/allocatable_component.f90 @@ -0,0 +1,39 @@ +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 object_type_m + +program main + use object_type_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 --- /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 --- /dev/null +++ b/Fortran/UnitTests/finalization/allocated_allocatable_lhs.f90 @@ -0,0 +1,30 @@ +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 object_type_m + +program main + use object_type_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 --- /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 --- /dev/null +++ b/Fortran/UnitTests/finalization/block_end.f90 @@ -0,0 +1,30 @@ +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 object_type_m + +program main + use object_type_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 --- /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 --- /dev/null +++ b/Fortran/UnitTests/finalization/finalize_on_deallocate.f90 @@ -0,0 +1,29 @@ +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 object_type_m + +program main + use object_type_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 --- /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 --- /dev/null +++ b/Fortran/UnitTests/finalization/finalize_on_end.f90 @@ -0,0 +1,35 @@ +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 object_type_m + +program main + use object_type_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 --- /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 --- /dev/null +++ b/Fortran/UnitTests/finalization/intent_out.f90 @@ -0,0 +1,32 @@ +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 object_type_m + +program main + use object_type_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 --- /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 --- /dev/null +++ b/Fortran/UnitTests/finalization/lhs_object.f90 @@ -0,0 +1,29 @@ +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 object_type_m + +program main + use object_type_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 --- /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 --- /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 --- /dev/null +++ b/Fortran/UnitTests/finalization/object_type_m.f90 @@ -0,0 +1,47 @@ +module object_type_m + !! 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 --- /dev/null +++ b/Fortran/UnitTests/finalization/rhs_function_reference.f90 @@ -0,0 +1,28 @@ +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 object_type_m + +program main + use object_type_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 --- /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 --- /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 b/Fortran/UnitTests/finalization/specification_expression_finalization.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/finalization/specification_expression_finalization.reference_output @@ -0,0 +1,2 @@ +Fortran ERROR STOP: 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 --- /dev/null +++ b/Fortran/UnitTests/finalization/target_deallocation.f90 @@ -0,0 +1,28 @@ +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 object_type_m + +program main + use object_type_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 --- /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