test_link_extension_spec Subroutine

public subroutine test_link_extension_spec()

Arguments

None

Calls

proc~~test_link_extension_spec~~CallsGraph proc~test_link_extension_spec test_link_extension_spec anyexceptions anyexceptions proc~test_link_extension_spec->anyexceptions assert_that assert_that proc~test_link_extension_spec->assert_that false false proc~test_link_extension_spec->false none~add_virtual_pt StateRegistry%add_virtual_pt proc~test_link_extension_spec->none~add_virtual_pt none~get_extension_family StateRegistry%get_extension_family proc~test_link_extension_spec->none~get_extension_family none~get_extensions~2 ExtensionFamily%get_extensions proc~test_link_extension_spec->none~get_extensions~2 none~get_primary ExtensionFamily%get_primary proc~test_link_extension_spec->none~get_primary none~get_spec~2 StateItemExtension%get_spec proc~test_link_extension_spec->none~get_spec~2 none~link_extension StateRegistry%link_extension proc~test_link_extension_spec->none~link_extension none~num_owned_items StateRegistry%num_owned_items proc~test_link_extension_spec->none~num_owned_items none~of~229 StateItemExtensionPtrVector%of proc~test_link_extension_spec->none~of~229 sourcelocation sourcelocation proc~test_link_extension_spec->sourcelocation interface~mapl_assert MAPL_Assert none~add_virtual_pt->interface~mapl_assert none~has_virtual_pt StateRegistry%has_virtual_pt none~add_virtual_pt->none~has_virtual_pt none~insert~130 VirtualPtFamilyMap%insert none~add_virtual_pt->none~insert~130 proc~mapl_return MAPL_Return none~add_virtual_pt->proc~mapl_return none~at~112 VirtualPtFamilyMap%at none~get_extension_family->none~at~112 none~get_extension_family->proc~mapl_return proc~mapl_verify MAPL_Verify none~get_extension_family->proc~mapl_verify none~get_primary->interface~mapl_assert none~front~56 StateItemExtensionPtrVector%front none~get_primary->none~front~56 none~get_primary->proc~mapl_return none~link_extension->interface~mapl_assert none~add_extension~2 ExtensionFamily%add_extension none~link_extension->none~add_extension~2 none~link_extension->none~at~112 none~link_extension->none~has_virtual_pt none~link_extension->proc~mapl_return none~link_extension->proc~mapl_verify none~of_size_kind~19 StateItemExtensionPtrVector%of_size_kind none~of~229->none~of_size_kind~19 none~push_back~56 StateItemExtensionPtrVector%push_back none~add_extension~2->none~push_back~56 none~at_rc~8 VirtualPtFamilyMap%at_rc none~at~112->none~at_rc~8 none~insert_pair~12 VirtualPtFamilyMap%insert_pair none~insert~130->none~insert_pair~12 at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception proc~mapl_verify->proc~mapl_throw_exception none~find~36 VirtualPtFamilyMap%find none~at_rc~8->none~find~36 none~capacity~331 StateItemExtensionPtrVector%capacity none~push_back~56->none~capacity~331 none~resize~112 StateItemExtensionPtrVector%resize none~push_back~56->none~resize~112

Source Code

   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