Merge branch 'main' into detect-compiler

Author: rouson

example/smart_pointer.f90

@@ -0,0 +1,101 @@
+module foo_m
+  implicit none
+
+  private
+  public :: foo_t
+
+  type foo_t
+  end type
+
+end module
+
+module smart_pointer_m
+  use reference_counter_m, only: ref_reference_t
+  use foo_m, only : foo_t
+
+  implicit none
+  private
+  public :: smart_pointer_t
+
+  type, extends(ref_reference_t) :: smart_pointer_t
+    type(foo_t), pointer :: ref => null()
+  contains
+    procedure :: free
+  end type
+
+  interface smart_pointer_t
+
+    module function construct(foo) result(smart_pointer)
+      implicit none
+      type(foo_t), intent(in), pointer:: foo
+      type(smart_pointer_t) :: smart_pointer
+    end function
+
+  end interface
+
+  interface
+
+    module subroutine free(self)
+      implicit none
+      class(smart_pointer_t), intent(inout) :: self
+    end subroutine
+
+  end interface
+
+end module
+
+submodule(smart_pointer_m) smart_pointer_s
+  use assert_m, only : assert
+  implicit none
+
+contains
+
+  module procedure construct
+    call assert(associated(foo), "construct_from_pointer: associated(foo)")
+    smart_pointer%ref => foo
+    call smart_pointer%start_ref_counter
+  end procedure
+
+  module procedure free
+    if (associated(self%ref)) then
+      deallocate(self%ref)
+      nullify(self%ref)
+      print *,"free(): foo deallocated"
+    end if
+  end procedure
+
+end submodule
+
+program main
+  use smart_pointer_m, only : smart_pointer_t
+  use foo_m, only : foo_t
+  implicit none
+
+  block 
+
+    type(smart_pointer_t) ptr_1, ptr_2
+    type(foo_t), pointer :: foo => null()
+
+    allocate(foo, source = foo_t())
+    ptr_1 = smart_pointer_t(foo)  ! 1st reference
+    print *, ptr_1%reference_count() 
+    ptr_2 = ptr_1 ! 2nd reference
+    print *, ptr_2%reference_count()
+    call new_reference(ptr_2)
+    print *, ptr_2%reference_count() ! 2 remaining references
+
+  end block ! ref_reference_counter frees the memory after the 2 remaining references go out of scope
+
+  print *,"All references gone"
+
+contains
+
+  subroutine new_reference(obj)
+    type(smart_pointer_t), intent(in) :: obj
+    type(smart_pointer_t) local_ptr
+
+    local_ptr = obj                     ! 3rd reference
+    print *, local_ptr%reference_count()
+  end subroutine
+
+end program

example/specification_expression_finalization.f90

@@ -10,6 +10,7 @@ module ref_counter_m
     integer, pointer :: count_ => null()
     class(ref_resource_t), pointer :: object_ => null()
   contains
+    procedure :: reference_count
     procedure, non_overridable :: grab
     procedure, non_overridable :: release
     procedure :: assign_ref_counter
@@ -29,6 +30,12 @@ module function construct(object) result(ref_counter)
 
   interface
 
+    pure module function reference_count(self) result(counter)
+      implicit none
+      class(ref_counter_t), intent(in) :: self
+      integer counter
+    end function
+
     module subroutine grab(self)
       implicit none
       class(ref_counter_t), intent(inout) :: self

src/reference_counter/ref_counter_m.f90

@@ -4,6 +4,11 @@
 
 contains
 
+  module procedure reference_count
+    call assert(associated(self%count_),"ref_counter_t%grab: associated(self%count_)")
+    counter = self%count_
+  end procedure
+
   module procedure construct
     allocate(ref_counter%count_, source=0)
     allocate(ref_counter%object_, source=object)

src/reference_counter/ref_counter_s.f90

@@ -9,12 +9,19 @@ module ref_reference_m
   type, abstract, extends(ref_resource_t) :: ref_reference_t
     type(ref_counter_t) :: ref_counter
   contains
+    procedure :: reference_count
     procedure, non_overridable :: release_handle
     procedure, non_overridable :: start_ref_counter
   end type
 
   interface
 
+    pure module function reference_count(self) result(counter)
+      implicit none
+      class(ref_reference_t), intent(in) :: self
+      integer counter
+    end function
+
     module subroutine release_handle(self)
       implicit none
       class(ref_reference_t), intent(inout) :: self

src/reference_counter/ref_reference_m.f90

@@ -3,6 +3,10 @@
 
 contains
 
+  module procedure reference_count
+    counter = self%ref_counter%reference_count()
+  end procedure
+
   module procedure release_handle
     call self%ref_counter%release
   end procedure

src/reference_counter/ref_reference_s.f90

@@ -1,6 +1,7 @@
 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
@@ -197,7 +198,7 @@ function check_rhs_function_reference() result(result_)
   end function
 
   function check_specification_expression() result(result_)
-    !! Test conformance with Fortran 2018 standard clause 7.5.6.3, paragraph 6: 
+    !! Test conformance with Fortran 2018 standard clause 7.5.6.3, paragraph 6:
     !! "specification expression function result"
     type(result_t) result_
     integer exit_status

test/compiler_test.f90

@@ -0,0 +1,53 @@
+module for_use_in_spec_expr_m
+    !! This module supports the specification expression finalization
+    !! test in compiler_test.f90, check_specification_expression
+    implicit none
+
+    private
+    public :: finalizable_t, component, was_finalized
+
+    type finalizable_t
+        private
+        integer, pointer :: component_ => null()
+    contains
+        final :: finalize
+    end Type
+
+    interface finalizable_t
+        module procedure construct
+    end interface
+
+    logical :: was_finalized = .false.
+
+    interface
+        pure subroutine lie()
+        end subroutine
+    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_)
+        call lie()
+    end subroutine
+
+end module
+
+subroutine lie()
+    use for_use_in_spec_expr_m, only: was_finalized
+    was_finalized = .true.
+end subroutine