subroutine test_link_extension_spec() type(StateRegistry), target :: r type(VirtualConnectionPt) :: x integer :: status type(ExtensionFamily), pointer :: family type(StateItemExtensionPtr), pointer :: wrapper class(StateItemSpec), allocatable :: spec_x, spec_y class(StateItemSpec), pointer :: spec type(StateItemExtensionPtrVector) :: extensions type(StateItemExtension), target :: ext_x, ext_y type(StateItemExtension), pointer :: ext r = StateRegistry('A') x = VirtualConnectionPt(state_intent='import', short_name='x') call r%add_virtual_pt(x, _RC) allocate(spec_x, source=MockItemSpec('x')) ext_x = StateItemExtension(spec_x) call r%link_extension(x, ext_x, _RC) @assert_that(r%num_owned_items(), is(0)) family => r%get_extension_family(x, _RC) @assert_that(associated(family%get_primary()), is(false())) extensions = family%get_extensions() @assert_that(int(extensions%size()), is(1)) wrapper => extensions%of(1) ext => wrapper%ptr spec => ext%get_spec() select type (spec) type is (MockItemSpec) @assert_that(spec%name, is('x')) class default @assert_that(1, is(0)) end select allocate(spec_y, source=MockItemSpec('y')) ext_y = StateItemExtension(spec_y) call r%link_extension(x, ext_y) @assert_that(r%num_owned_items(), is(0)) family => r%get_extension_family(x, _RC) @assert_that(associated(family%get_primary()), is(false())) extensions = family%get_extensions() @assert_that(int(extensions%size()), is(2)) wrapper => extensions%of(2) ext => wrapper%ptr spec => ext%get_spec() select type (spec) type is (MockItemSpec) @assert_that(spec%name, is('y')) class default @assert_that(1, is(0)) end select end subroutine test_link_extension_spec