module test_module
  implicit none
  
  private
  public :: test
  public :: json_value
  public :: json_file
  
  ! Object that has Fortran's typical value semantics, that can be a bit 
  ! weighty, so we don't always want to be copying it around.
  type :: json_value
    integer :: i = 0
  end type json_value
  
  ! Object that acts as a shared reference to objects of type json_value.
  type :: json_value_ref
    type(json_value), pointer :: ptr => null()
    integer, pointer :: count => null()
  contains
    procedure :: assign_json_value_ref_to_self
    procedure, pass(rhs) :: assign_json_value_ref_to_json_value
    generic :: assignment(=) =>  &
        assign_json_value_ref_to_self,  &
        assign_json_value_ref_to_json_value
    
    final :: final_json_value_ref
  end type json_value_ref
  
  ! Constructors for json_value_ref.
  interface json_value_ref
    procedure :: construct_json_value_ref
  end interface json_value_ref
  
  ! Object that holds a reference to a json_value object.
  !
  ! Because the json_value object is held by reference, we can copy 
  ! this around with wanton abandon, without having to worry about 
  ! the size of the json_value object.
  type :: json_file
    type(json_value_ref) :: value_ref
  end type json_file
  
  ! Constructors for json_file.
  interface json_file
    procedure :: construct_json_file
  end interface json_file
contains
  ! Constructs a json_value_ref object, by taking ownership of a 
  ! pointer to a json_value object previously created by an allocate 
  ! statement.
  !
  ! When there are no more references to the owned object, the object 
  ! will be deallocated.
  !
  ! If p has not been created by an allocate statement, bad things 
  ! will happen.
  function construct_json_value_ref(p) result(r)
    type(json_value), pointer :: p
    type(json_value_ref) :: r
    allocate(r%count)
    r%count = 1
    r%ptr => p
  end function construct_json_value_ref
  
  ! Defined assignment for json_value_ref to json_value_ref.
  impure elemental subroutine assign_json_value_ref_to_self(lhs, rhs)
    class(json_value_ref), intent(out) :: lhs
    type(json_value_ref), intent(in) :: rhs
    
    lhs%count => rhs%count
    lhs%ptr => rhs%ptr
    lhs%count = lhs%count + 1
  end subroutine assign_json_value_ref_to_self
  
  impure elemental subroutine assign_json_value_ref_to_json_value(lhs, rhs)
    type(json_value), intent(out) :: lhs
    class(json_value_ref), intent(in) :: rhs
    
    if (.not. associated(rhs%ptr))  &
        error stop 'reference to dissociated json_value_ref object'
    lhs = rhs%ptr
  end subroutine assign_json_value_ref_to_json_value
  
  subroutine final_json_value_ref(me)
    type(json_value_ref), intent(inout) :: me
    
    if (associated(me%count)) then
      me%count = me%count - 1
      if (me%count == 0) then
        deallocate(me%count)
        deallocate(me%ptr)
      end if
    end if
  end subroutine final_json_value_ref
  
  !-----------------------------------------------------------------------------
  
  ! Construct a json_file object, given a pointer to a json_value object 
  ! that has been created by an allocate statement.  See comments for 
  ! construct_json_value_ref.
  function construct_json_file(p) result(me)
    type(json_value), pointer :: p
    type(json_file) :: me
    
    me%value_ref = json_value_ref(p)
  end function construct_json_file
  
  subroutine test     ! test function constructor
    type(json_value), pointer :: p
    type(json_file) :: f
    type(json_file) :: f2
    
    print *, '...test...'
    allocate(p)
    print '(A40,I20,I20)', 'allocate(p)', loc(p)
    p%i = 99
    print *, p%i
    
    f = json_file(p)
    print *, f%value_ref%ptr%i
    f2 = f
    print *, f2%value_ref%ptr%i
  end subroutine test
end module test_module

program main
  use test_module
  implicit none
  print *, ''
  call test
  print *, ''
end program main
