Merge pull request #31 from sourceryinstitute/shallow-copy-test

Shallow copy test

Author: rouson

.github/workflows/deploy-docs.yml

@@ -5,7 +5,7 @@ on: [push, pull_request]
 
 jobs:
   Build:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-22.04
 
     steps:
     - name: Checkout code
@@ -14,8 +14,8 @@ jobs:
     - name: Install Dependencies Ubuntu
       run: |
         sudo apt-get update
-        sudo apt install -y python-dev python build-essential graphviz
-        sudo pip install ford
+        sudo apt install -y python3-dev python3 build-essential graphviz
+        sudo pip install ford markdown==3.3.4
 
     - name: Build Developer Documenation
       run: |

README.md

@@ -66,12 +66,14 @@ to finalize objects.  The table below summarizes the observed compiler behaviors
 
 | _Compiler_   | _Test failures_      | _Version tested_                                    |
 | :---         |       :---:          | :---                                                |
-| NAG          |         1            | `nagfor` 7.1                                        |
-| GCC          |         4            | `gfortran` 11.3.0, 12.1.0                           |
+| NAG          |         0            | `nagfor` 7.1 Build 7113                             |
+| GCC          |         6            | `gfortran` 12.2.0                                   |
 | Intel        |         2            | `ifort` 2021.5.0 Build 20211109\_000000             |
 | NVIDIA       | Fails to build (ICE) | `nvfortran` 2022.2                                  |
 | AMD          | Fails to build (ICE) | `flang` 13.0.0 (AOCC_3.2.0-Build\#128 2021\_11\_12) |
 
+See the [test suite README.md](./test/README.md) for more details on each compiler's test
+failures.
 
 Downloading, Building, and Testing
 ----------------------------------

example/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

fpm.toml

@@ -1,4 +1,4 @@
-name = "reference-counter"
+name = "reference_counter"
 version = "1.0.0"
 license = "BSD"
 author = ["Damian Rouson, Karla Morris, and Jim Xia"]
@@ -9,4 +9,5 @@ copyright = "2020-2022 Sourcery Institute"
 assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.3.0"}
 
 [dev-dependencies]
-vegetables = {git = "https://gitlab.com/everythingfunctional/vegetables", tag = "v7.4.2"}
+veggies = {git = "https://gitlab.com/everythingfunctional/veggies", tag = "v1.0.4"}
+iso_varying_string = {git = "https://gitlab.com/everythingfunctional/iso_varying_string", tag = "v3.0.2"}

test/README.md

@@ -0,0 +1,41 @@
+Compiler Support Status
+=======================
+
+This directory contains two categories of unit tests separated into two files:
+
+* `usage_test.f90` exercises the reference-counter library, whereas
+* `compiler_test.f90` tests the compiler without using reference-counter, 
+
+`compiler_test.f90` verifies that a compiler calls a type's final subroutine
+in each of the scenarios in which the Fortran standard requires finalization
+to occur.
+
+`nagfor` 7.1.0 
+--------------
+:trophy: The Numerical Algorithms Group (NAG) Fortran [compiler] passes all
+reference-counter tests. 
+
+`gfortran` 12.2.0
+-----------------
+Because the first usage test listed below causes a segmentation fault,
+obtaining the `gfortran` test results requires skipping that test by, 
+for example, running running individual tests as follows:
+```
+fpm test -- -f "<description>"
+```
+Replace <description> above with one of the enumerated test descriptions
+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 function reference on the RHS of an intrinsic assignment
+5. finalizes a specification expression function result
+
+### Failing checks in `usage_test.f90`
+1. copy points to the same resource as the original
+2. has zero references after a shallow copy goes out of scope
+
+[compiler]: https://www.nag.com/content/nag-fortran-compiler

test/compiler_test.f90

@@ -1,5 +1,7 @@
 module compiler_test
-  use vegetables, only: result_t, test_item_t, describe, it, assert_equals
+  !! Test compiler conformance with each scenario in which the Fortran 2018
+  !! standard mandates type finalization.
+  use veggies, only: result_t, test_item_t, describe, it, assert_equals, assert_that
   implicit none
 
   private
@@ -54,7 +56,8 @@ subroutine count_finalizations(self)
   end subroutine
 
   function check_lhs_object() result(result_)
-    !! Verify Fortran 2018 clause 7.5.6.3, paragraph 1 behavior: "not an unallocated allocatable variable"
+    !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 1 behavior:
+    !! "not an unallocated allocatable variable"
     type(object_t) lhs, rhs
     type(result_t) result_
     integer initial_tally
@@ -68,7 +71,8 @@ function check_lhs_object() result(result_)
   end function
 
   function check_allocated_allocatable_lhs() result(result_)
-    !! Verify Fortran 2018 clause 7.5.6.3, paragraph 1 behavior: "allocated allocatable variable"
+    !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 1 behavior:
+    !! "allocated allocatable variable"
     type(object_t), allocatable :: lhs
     type(object_t) rhs
     type(result_t) result_
@@ -84,7 +88,8 @@ function check_allocated_allocatable_lhs() result(result_)
   end function
 
   function check_target_deallocation() result(result_)
-    !! Verify Fortran 2018 clause 7.5.6.3, paragraph 2 behavior: "pointer is deallocated"
+    !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 2 behavior:
+    !! "pointer is deallocated"
     type(object_t), pointer :: object_ptr => null()
     type(result_t) result_
     integer initial_tally
@@ -98,7 +103,7 @@ function check_target_deallocation() result(result_)
   end function
 
   function check_allocatable_component_finalization() result(result_)
-    !! Tests 7.5.6.3, para. 2 ("allocatable entity is deallocated")
+    !! 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")
     type(wrapper_t), allocatable :: wrapper
     type(result_t) result_
@@ -124,7 +129,8 @@ subroutine finalize_intent_out_component(output)
   end function
 
   function check_finalize_on_deallocate() result(result_)
-    !! Tests 7.5.6.3, paragraph 2: "allocatable entity is deallocated"
+    !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 2:
+    !! "allocatable entity is deallocated"
     type(object_t), allocatable :: object
     type(result_t) result_
     integer initial_tally
@@ -139,7 +145,8 @@ function check_finalize_on_deallocate() result(result_)
   end function
 
   function check_finalize_on_end() result(result_)
-    !! Tests 7.5.6.3, paragraph 3: "before return or END statement"
+    !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 3:
+    !! "before return or END statement"
     type(result_t) result_
     integer initial_tally
 
@@ -159,7 +166,8 @@ subroutine finalize_on_end_subroutine()
   end function
 
   function check_block_finalization() result(result_)
-    !! Tests 7.5.6.3, paragraph 4: "termination of the BLOCK construct"
+    !! Test conformance with Fortran 2018 clause  7.5.6.3, paragraph 4:
+    !! "termination of the BLOCK construct"
     type(result_t) result_
     integer initial_tally
 
@@ -174,7 +182,8 @@ function check_block_finalization() result(result_)
   end function
 
   function check_rhs_function_reference() result(result_)
-    !! Verify Fortran 2018 clause 7.5.6.3, paragraph 5 behavior: "nonpointer function result"
+    !! Test conformance with Fortran 2018 clause 7.5.6.3, paragraph 5 behavior:
+    !! "nonpointer function result"
     type(object_t), allocatable :: object
     type(result_t) result_
     integer initial_tally
@@ -187,27 +196,25 @@ function check_rhs_function_reference() result(result_)
   end function
 
   function check_specification_expression() result(result_)
-    !! Tests 7.5.6.3, paragraph 6: "specification expression function result"
+    !! Test conformance with Fortran 2018 standard clause 7.5.6.3, paragraph 6: 
+    !! "specification expression function result"
     type(result_t) result_
-    integer initial_tally
-
-    initial_tally = finalizations
-    call finalize_specification_expression
-    associate(delta => finalizations - initial_tally)
-      result_ = assert_equals(1, delta)
-    end associate
-
-  contains
-
-    subroutine finalize_specification_expression
-      character(len=size([object_t(dummy=this_image())])) :: string ! Finalizes RHS function reference
-      string = ""
-    end subroutine
+    integer exit_status
+    logical error_termination_occurred
+  
+    call execute_command_line( &
+      command = "fpm run --example specification_expression_finalization > /dev/null 2>&1", &
+      wait = .true., &
+      exitstat = exit_status &
+    )
+    error_termination_occurred = exit_status /=0
+    result_ = assert_that(error_termination_occurred)
 
   end function
 
   function check_intent_out_finalization() result(result_)
-    !! Tests 7.5.6.3, paragraph 7: "nonpointer, nonallocatable, INTENT (OUT) dummy argument"
+    !! Test conformance with Fortran 2018 standard clause 7.5.6.3, paragraph 7:
+    !! "nonpointer, nonallocatable, INTENT (OUT) dummy argument"
     type(result_t) result_
     type(object_t) object
     integer initial_tally

test/main.f90

@@ -1,20 +1,22 @@
-! Generated by make_vegetable_driver. DO NOT EDIT
+! Generated by cart. DO NOT EDIT
 program main
     implicit none
 
-    call run()
+    if (.not.run()) stop 1
 contains
-    subroutine run()
+    function run() result(passed)
         use compiler_test, only: &
                 compiler_ref_reference => &
                     test_ref_reference
         use usage_test, only: &
                 usage_usage => &
                     test_usage
-        use vegetables, only: test_item_t, test_that, run_tests
+        use veggies, only: test_item_t, test_that, run_tests
 
 
 
+        logical :: passed
+
         type(test_item_t) :: tests
         type(test_item_t) :: individual_tests(2)
 
@@ -23,7 +25,7 @@ subroutine run()
         tests = test_that(individual_tests)
 
 
-        call run_tests(tests)
+        passed = run_tests(tests)
 
-    end subroutine
+    end function
 end program

test/shallow_m.f90

@@ -0,0 +1,38 @@
+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 :: 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
+
+end module