WIP(test): add shallow-copy usage test

Work in Progress
----------------
This new test exposes what is probably a compiler bug that causes
a seg fault in the new test when a variable is passed to the
veggies assert_that() procedure.

Author: rouson

test/shallow_m.f90

@@ -0,0 +1,46 @@
+module shallow_m
+    use reference_counter_m, only: ref_reference_t
+
+    implicit none
+    private
+    public :: shallow_t, resource_freed
+
+    type, extends(ref_reference_t) :: shallow_t
+        integer, pointer :: ref => null()
+    contains
+        procedure :: shallow_copy
+        generic :: assignment(=) => shallow_copy
+        procedure :: free
+    end type
+
+    interface shallow_t
+        module procedure construct
+    end interface
+
+    integer, allocatable, target, save :: resource
+    logical, save :: resource_freed = .false.
+
+contains
+    function construct() result(shallow)
+        type(shallow_t) :: shallow
+
+        resource = 42
+        shallow%ref => resource
+        call shallow%start_ref_counter
+    end function
+
+    subroutine free(self)
+        class(shallow_t), intent(inout) :: self
+
+        deallocate(resource)
+        nullify(self%ref)
+        resource_freed = .true.
+    end subroutine
+
+    subroutine shallow_copy(lhs, rhs)
+       class(shallow_t), intent(inout) :: lhs
+       type(shallow_t), intent(in) :: rhs
+       lhs%ref => rhs%ref
+    end subroutine
+
+end module

test/usage_test.f90

@@ -9,6 +9,7 @@ module usage_test
             describe, &
             fail, &
             it
+    use shallow_m, only : shallow_t, resource_freed
 
     implicit none
     private
@@ -47,10 +48,11 @@ function test_usage() result(tests)
         type(test_item_t) :: tests
 
         tests = describe( &
-                "Using a reference-counted object", &
+                "A reference-counted object", &
                 [ it("creates a resource when constructed", check_creation) &
-                , it("removes the resource when it goes out of scope", check_deletion) &
-                , it("a copy points to the same resource", check_copy) &
+                , it("removes the resource when the object goes out of scope", check_deletion) &
+                , it("copy points to the same resource as the original", check_copy) &
+                , it("has zero references afrer a shallow copy goes out of scope", check_shallow_copy) &
                 ])
     end function
 
@@ -87,4 +89,18 @@ function check_copy() result(result_)
         object2 = object1
         result_ = assert_that(associated(object2%ref, object1%ref))
     end function
+    
+    function check_shallow_copy() result(result_)
+      type(result_t) :: result_
+      
+      block 
+        type(shallow_t) shallow_copy
+
+        associate(original => shallow_t())
+          shallow_copy = original
+        end associate
+      end block
+
+      result_ = assert_that(resource_freed)
+    end function
 end module