Better testing through more robust construction and destruction

example/test-support/README.md

@@ -0,0 +1,7 @@
+Test Support
+============
+
+This directory exists to support the test suite: programs compiled from source
+code contained here can be executed by a test using Fortran's `execute_command_line`
+subroutine.  Doing so facilitates checking for expected error termination without
+actually terminating the execution of the test suite.

example/test-support/specification_expression_finalization.f90

@@ -0,0 +1,57 @@
+module finalizable_m
+  !! This module supports the specification_expression_finalization main program 
+  !! (at the bottom of this file), which in turn supports the check_specification_expression 
+  !! unit-test function in ../test/compiler_test.f90.
+  implicit none
+
+  private
+  public :: finalizable_t, component
+
+  type finalizable_t
+    private
+    integer, pointer :: component_ => null()
+  contains
+    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
+  end subroutine
+
+end program

test/README.md

@@ -28,10 +28,11 @@ below or with a corresponding substring not contained in the first usage
 test description.
 
 ### Failing checks in `compiler_test.f90`
-1. finalizes a non-allocatable object on the LHS of an intrinsic assignment
-2. finalizes an allocated allocatable LHS of an intrinsic assignment
-3. finalizes a function reference on the RHS of an intrinsic assignment
-4. finalizes a specification expression function result
+GFortran fails to finalize
+1. a non-allocatable object on the LHS of an intrinsic assignment
+2. an allocated allocatable LHS of an intrinsic assignment
+3. a function reference on the RHS of an intrinsic assignment
+4. a specification expression function result
 
 ### Failing checks in `usage_test.f90`
 1. copy points to the same resource as the original

test/compiler_test.f90

@@ -1,7 +1,6 @@
 module compiler_test
   !! Test compiler conformance with each scenario in which the Fortran 2018
   !! standard mandates type finalization.
-  use for_use_in_spec_expr_m, only: finalizable_t, component, was_finalized
   use veggies, only: result_t, test_item_t, describe, it, assert_equals, assert_that
   use iso_fortran_env, only : compiler_version
   implicit none

test/usage_test.F90

@@ -9,7 +9,6 @@ module usage_test
             assert_that, &
             describe, &
             fail, &
-            succeed, &
             it
     use shallow_m, only : shallow_t, resource_freed
 
@@ -29,20 +28,22 @@ module usage_test
 
     integer, allocatable, target :: the_resource
     integer, parameter :: the_answer = 42
+
 contains
+
     function construct() result(object)
         type(object_t) :: object
 
-        allocate(the_resource)
+        if (.not. allocated(the_resource)) allocate(the_resource, source=the_answer)
         object%ref => the_resource
-        object%ref = the_answer
+        !object%ref = the_answer
         call object%start_ref_counter
     end function
 
     subroutine free(self)
         class(object_t), intent(inout) :: self
 
-        deallocate(the_resource)
+        if (allocated(the_resource)) deallocate(the_resource)
         nullify(self%ref)
     end subroutine
 
@@ -84,17 +85,28 @@ function check_deletion() result(result_)
 
     function check_copy() result(result_)
         type(result_t) :: result_
-        type(object_t) :: object1, object2
+        type(object_t) :: reference
 
-        if (scan(compiler_version(),"GCC ")==1) then
-          result_ = fail("skipped due to known gfortran bug that causes a segmenation fault")
-        else
+        associate(original => object_t())
+          reference = original
+
+          block 
+            type(object_t) declared, reference_to_declared
+
+            if (scan(compiler_version(),"GCC ")==1) then
+              result_ = assert_that(associated(original%ref, reference%ref)) .and. &
+                        fail("skipped copy of declared reference due to a gfortran bug that would cause a segmentation fault")
+            else
 #ifndef __GFORTRAN__
-          object1 = object_t()
-          object2 = object1
-          result_ = assert_that(associated(object2%ref, object1%ref))
+              declared = object_t() ! compiling with gfortran generates a runtime error even when this line doesn't execute
 #endif
-        end if
+              reference_to_declared = declared
+              result_ = assert_that(associated(original%ref, reference%ref)) .and.  &
+                        assert_that(associated(declared%ref, reference_to_declared%ref))
+            end if
+          end block
+        end associate
+
     end function
 
     function check_shallow_copy() result(result_)