From da239408a997765a00af200da764d62cbdb54bcc Mon Sep 17 00:00:00 2001
From: Tom Clune <thomas.l.clune@nasa.gov>
Date: Thu, 19 Sep 2024 15:10:17 -0400
Subject: [PATCH] Refactor make_extension()

With adaptors, we can now implent make_extension() independent
of the StateItemSpec subclasses.

Reviewed-by: Tom Clune <thomas.l.clune@nasa.gov>
---
 generic3g/connection/SimpleConnection.F90 | 34 ----------
 generic3g/registry/StateItemExtension.F90 | 18 ++++--
 generic3g/specs/BracketSpec.F90           | 16 -----
 generic3g/specs/FieldSpec.F90             | 27 --------
 generic3g/specs/InvalidSpec.F90           | 31 ---------
 generic3g/specs/ServiceSpec.F90           | 16 -----
 generic3g/specs/StateItemSpec.F90         | 12 ----
 generic3g/specs/StateSpec.F90             | 30 ---------
 generic3g/specs/WildcardSpec.F90          | 16 -----
 generic3g/tests/MockItemSpec.F90          | 78 -----------------------
 10 files changed, 12 insertions(+), 266 deletions(-)

diff --git a/generic3g/connection/SimpleConnection.F90 b/generic3g/connection/SimpleConnection.F90
index 6fcb4d18e3da..f1e9799fdee3 100644
--- a/generic3g/connection/SimpleConnection.F90
+++ b/generic3g/connection/SimpleConnection.F90
@@ -205,40 +205,6 @@ subroutine activate_dependencies(extension, registry, rc)
       _RETURN(_SUCCESS)
    end subroutine activate_dependencies
 
-!#   subroutine find_closest_extension(goal_extension, candidate_extensions, closest_extension, lowest_cost, rc)
-!#      type(StateItemExtension), intent(in) :: goal_extension
-!#      type(StateItemExtensionPtr), target, intent(in) :: candidate_extensions(:)
-!#      type(StateItemExtension), pointer :: closest_extension
-!#      integer, intent(out) :: lowest_cost
-!#      integer, optional, intent(out) :: rc
-!#
-!#      integer :: status
-!#      type(StateItemExtension), pointer :: extension
-!#      class(StateItemSpec), pointer :: spec
-!#      class(StateItemSpec), pointer :: goal_spec
-!#      integer :: cost
-!#      integer :: j
-!#      
-!#      _ASSERT(size(candidate_extensions) > 0, 'no candidates found')
-!#
-!#      goal_spec => goal_extension%get_spec()
-!#      closest_extension => candidate_extensions(1)%ptr
-!#      spec => closest_extension%get_spec()
-!#      lowest_cost = goal_spec%extension_cost(spec, _RC)
-!#      do j = 2, size(candidate_extensions)
-!#         if (lowest_cost == 0) exit
-!#
-!#         extension => candidate_extensions(j)%ptr
-!#         spec => extension%get_spec()
-!#         cost = goal_spec%extension_cost(spec)
-!#         if (cost < lowest_cost) then
-!#            lowest_cost = cost
-!#            closest_extension => extension
-!#         end if
-!#
-!#      end do
-!#
-!#   end subroutine find_closest_extension
 
 end module mapl3g_SimpleConnection
 
diff --git a/generic3g/registry/StateItemExtension.F90 b/generic3g/registry/StateItemExtension.F90
index 7d7f6f7b337a..bb719d060b0a 100644
--- a/generic3g/registry/StateItemExtension.F90
+++ b/generic3g/registry/StateItemExtension.F90
@@ -111,22 +111,28 @@ function make_extension(this, goal, rc) result(extension)
       integer, intent(out) :: rc
 
       integer :: status
+      integer :: i
       class(StateItemSpec), allocatable :: new_spec
       class(ExtensionAction), allocatable :: action
       type(GriddedComponentDriver) :: producer
       type(ESMF_GridComp) :: coupler_gridcomp
+      type(StateItemAdapterWrapper), allocatable :: adapters(:)
       type(ESMF_Clock) :: fake_clock
 
       call this%spec%set_active()
-      call this%spec%make_extension(goal, new_spec, action, _RC)
 
-      ! If no action is needed, then "this" can already directly
-      ! connect to goal.  I.e., extensions have converged.
-      select type (action)
-      type is (NullAction)
+      new_spec = this%spec
+      adapters = this%spec%make_adapters(goal, _RC)
+      do i = 1, size(adapters)
+         if (adapters(i)%adapter%match(new_spec)) cycle
+         call adapters(i)%adapter%adapt(new_spec, action)
+         exit
+      end do
+
+      if (.not. allocated(action)) then
          extension = StateItemExtension(this%spec)
          _RETURN(_SUCCESS)
-      end select
+      end if
 
       call new_spec%create(_RC)
       call new_spec%set_active()
diff --git a/generic3g/specs/BracketSpec.F90 b/generic3g/specs/BracketSpec.F90
index f9e734c30f51..6d17f4034a64 100644
--- a/generic3g/specs/BracketSpec.F90
+++ b/generic3g/specs/BracketSpec.F90
@@ -44,7 +44,6 @@ module mapl3g_BracketSpec
       procedure :: add_to_state
       procedure :: add_to_bundle
 
-      procedure :: make_extension
       procedure :: make_adapters
       procedure :: set_geometry
    end type BracketSpec
@@ -255,21 +254,6 @@ subroutine add_to_bundle(this, bundle, rc)
       _UNUSED_DUMMY(bundle)
    end subroutine add_to_bundle
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(BracketSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      action = NullAction() ! default
-      new_spec = this
-
-      _FAIL('not implemented')
-      _UNUSED_DUMMY(this)
-      _UNUSED_DUMMY(dst_spec)
-   end subroutine make_extension
-
    subroutine set_geometry(this, geom, vertical_grid, rc)
       class(BracketSpec), intent(inout) :: this
       type(ESMF_Geom), optional, intent(in) :: geom
diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90
index 3f00f5a59805..3783b472be32 100644
--- a/generic3g/specs/FieldSpec.F90
+++ b/generic3g/specs/FieldSpec.F90
@@ -104,7 +104,6 @@ module mapl3g_FieldSpec
       procedure :: add_to_state
       procedure :: add_to_bundle
 
-      procedure :: make_extension
       procedure :: make_adapters
 
       procedure :: set_info
@@ -1040,32 +1039,6 @@ recursive function make_adapters(this, goal_spec, rc) result(adapters)
 
    end function make_adapters
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(FieldSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      type(StateItemAdapterWrapper), allocatable :: adapters(:)
-      integer :: i
-      integer :: status
-
-      new_spec = this
-      adapters = this%make_adapters(dst_spec, _RC)
-      do i = 1, size(adapters)
-         if (adapters(i)%adapter%match(new_spec)) cycle
-         call adapters(i)%adapter%adapt(new_spec, action)
-         exit
-      end do
-     _RETURN_IF(allocated(action))
-      
-      ! no action needed
-      action = NullAction()
-
-      _RETURN(_SUCCESS)
-   end subroutine make_extension
-
 
 end module mapl3g_FieldSpec
 
diff --git a/generic3g/specs/InvalidSpec.F90 b/generic3g/specs/InvalidSpec.F90
index 16bb8eae7a55..2bfd28d47495 100644
--- a/generic3g/specs/InvalidSpec.F90
+++ b/generic3g/specs/InvalidSpec.F90
@@ -34,8 +34,6 @@ module mapl3g_InvalidSpec
       procedure :: add_to_state
       procedure :: add_to_bundle
 
-      procedure :: make_extension
-      procedure :: extension_cost
       procedure :: set_geometry => set_geometry
 
       procedure :: make_adapters
@@ -140,35 +138,6 @@ subroutine add_to_bundle(this, bundle, rc)
       _UNUSED_DUMMY(bundle)
    end subroutine add_to_bundle
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(InvalidSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      integer :: status
-
-      action = NullAction() ! default
-      new_spec = this
-
-      _FAIL('attempt to use item of type InvalidSpec')
-      _UNUSED_DUMMY(this)
-      _UNUSED_DUMMY(dst_spec)
-   end subroutine make_extension
-
-   integer function extension_cost(this, src_spec, rc) result(cost)
-      class(InvalidSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: src_spec
-      integer, optional, intent(out) :: rc
-
-      cost = -1
-      _FAIL('Attempt to use item of type InvalidSpec')
-      _UNUSED_DUMMY(this)
-      _UNUSED_DUMMY(src_spec)
-
-   end function extension_cost
-
    subroutine set_geometry(this, geom, vertical_grid, rc)
       class(InvalidSpec), intent(inout) :: this
       type(ESMF_Geom), optional, intent(in) :: geom
diff --git a/generic3g/specs/ServiceSpec.F90 b/generic3g/specs/ServiceSpec.F90
index 99cee1cc53a0..ed458e4adf3f 100644
--- a/generic3g/specs/ServiceSpec.F90
+++ b/generic3g/specs/ServiceSpec.F90
@@ -40,7 +40,6 @@ module mapl3g_ServiceSpec
 
       procedure :: connect_to
       procedure :: can_connect_to
-      procedure :: make_extension
       procedure :: make_adapters
 
       procedure :: add_to_state
@@ -185,21 +184,6 @@ subroutine destroy(this, rc)
    end subroutine destroy
 
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(ServiceSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      integer :: status
-
-      action = NullAction() ! default
-      new_spec = this
-
-      _RETURN(_SUCCESS)
-   end subroutine make_extension
-
    subroutine set_geometry(this, geom, vertical_grid, rc)
       class(ServiceSpec), intent(inout) :: this
       type(ESMF_Geom), optional, intent(in) :: geom
diff --git a/generic3g/specs/StateItemSpec.F90 b/generic3g/specs/StateItemSpec.F90
index 058fec0bcddb..6230d5619a94 100644
--- a/generic3g/specs/StateItemSpec.F90
+++ b/generic3g/specs/StateItemSpec.F90
@@ -46,8 +46,6 @@ module mapl3g_StateItemSpec
 
       procedure(I_connect), deferred :: connect_to
       procedure(I_can_connect), deferred :: can_connect_to
-      procedure(I_make_extension), deferred :: make_extension
-
       procedure(I_make_adapters), deferred :: make_adapters
 
       procedure(I_add_to_state), deferred :: add_to_state
@@ -127,16 +125,6 @@ subroutine I_allocate(this, rc)
          integer, optional, intent(out) :: rc
       end subroutine I_allocate
 
-      recursive subroutine I_make_extension(this, dst_spec, new_spec, action, rc)
-         use mapl3g_ExtensionAction
-         import StateItemSpec
-         class(StateItemSpec), intent(in) :: this
-         class(StateItemSpec), intent(in) :: dst_spec
-         class(StateItemSpec), allocatable, intent(out) :: new_spec
-         class(ExtensionAction), allocatable, intent(out) :: action
-         integer, optional, intent(out) :: rc
-      end subroutine I_make_extension
-
       subroutine I_add_to_state(this, multi_state, actual_pt, rc)
          use mapl3g_MultiState
          use mapl3g_ActualConnectionPt
diff --git a/generic3g/specs/StateSpec.F90 b/generic3g/specs/StateSpec.F90
index ce7bc43e8374..2f8052d5e409 100644
--- a/generic3g/specs/StateSpec.F90
+++ b/generic3g/specs/StateSpec.F90
@@ -33,8 +33,6 @@ module mapl3g_StateSpec
       
       procedure :: connect_to
       procedure :: can_connect_to
-      procedure :: make_extension
-      procedure :: extension_cost
       procedure :: make_adapters
 
       procedure :: add_to_state
@@ -170,34 +168,6 @@ subroutine add_to_bundle(this, bundle, rc)
    end subroutine add_to_bundle
    
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(StateSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      action = NullAction() ! default
-      new_spec = this
-
-      _FAIL('not implemented')
-
-      _UNUSED_DUMMY(this)
-      _UNUSED_DUMMY(dst_spec)
-   end subroutine make_extension
-
-   integer function extension_cost(this, src_spec, rc) result(cost)
-      class(StateSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: src_spec
-      integer, optional, intent(out) :: rc
-
-      cost = 0
-
-      _RETURN(_SUCCESS)
-      _UNUSED_DUMMY(this)
-      _UNUSED_DUMMY(src_spec)
-   end function extension_cost
-
 
    function make_adapters(this, goal_spec, rc) result(adapters)
       type(StateItemAdapterWrapper), allocatable :: adapters(:)
diff --git a/generic3g/specs/WildcardSpec.F90 b/generic3g/specs/WildcardSpec.F90
index 387582df08ab..0215228d1f74 100644
--- a/generic3g/specs/WildcardSpec.F90
+++ b/generic3g/specs/WildcardSpec.F90
@@ -31,7 +31,6 @@ module mapl3g_WildcardSpec
 
       procedure :: connect_to
       procedure :: can_connect_to
-      procedure :: make_extension
       procedure :: make_adapters
       procedure :: add_to_state
       procedure :: add_to_bundle
@@ -198,21 +197,6 @@ subroutine add_to_bundle(this, bundle, rc)
       _RETURN(_SUCCESS)
    end subroutine add_to_bundle
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(WildcardSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      integer :: status
-
-      action = NullAction() ! default
-      new_spec = this
-
-      _FAIL('not implemented')
-   end subroutine make_extension
-
    subroutine set_geometry(this, geom, vertical_grid, rc)
       class(WildcardSpec), intent(inout) :: this
       type(ESMF_Geom), optional, intent(in) :: geom
diff --git a/generic3g/tests/MockItemSpec.F90 b/generic3g/tests/MockItemSpec.F90
index 458917e63cfd..b3d865591023 100644
--- a/generic3g/tests/MockItemSpec.F90
+++ b/generic3g/tests/MockItemSpec.F90
@@ -32,8 +32,6 @@ module MockItemSpecMod
 
       procedure :: connect_to
       procedure :: can_connect_to
-      procedure :: make_extension
-      procedure :: extension_cost
       procedure :: make_adapters
       procedure :: add_to_state
       procedure :: add_to_bundle
@@ -207,82 +205,6 @@ function new_MockAction(src_subtype, dst_subtype) result(action)
       end if
    end function new_MockAction
 
-
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(MockItemSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      integer :: status
-      type(MockItemSpec) :: tmp_spec
-
-      action = NullAction()
-      new_spec = this
-      select type(dst_spec)
-      type is (MockItemSpec)
-         call make_extension_typesafe(this, dst_spec, tmp_spec, action, _RC)
-         deallocate(new_spec)
-         allocate(new_spec, source=tmp_spec)
-         new_spec = tmp_spec
-      class default
-         _FAIL('incompatible spec')
-      end select
-      
-      _RETURN(_SUCCESS)
-   end subroutine make_extension
-
-   subroutine make_extension_typesafe(this, dst_spec, new_spec, action, rc)
-      class(MockItemSpec), intent(in) :: this
-      type(MockItemSpec), intent(in) :: dst_spec
-      class(MockItemSpec), intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      integer :: status
-
-      action = NullAction()
-
-      if (this%name /= dst_spec%name) then
-         new_spec%name = dst_spec%name
-         action = MockAction(this%subtype, new_spec%subtype)
-         _RETURN(_SUCCESS)
-      end if
-      
-      if (allocated(dst_spec%subtype) .and. allocated(this%subtype)) then
-         if (this%subtype /= dst_spec%subtype) then
-            new_spec%subtype = dst_spec%subtype
-            action = MockAction(this%subtype, new_spec%subtype)
-            _RETURN(_SUCCESS)
-         end if
-      end if
-
-      _RETURN(_SUCCESS)
-
-   end subroutine make_extension_typesafe
- 
-  integer function extension_cost(this, src_spec, rc) result(cost)
-      class(MockItemSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: src_spec
-      integer, optional, intent(out) :: rc
-
-      integer :: status
-
-      cost = 0
-      select type(src_spec)
-      type is (MockItemSpec)
-         if (this%name /= src_spec%name) cost = cost + 1
-         if (allocated(src_spec%subtype) .and. allocated(this%subtype)) then
-            if (this%subtype /= src_spec%subtype) cost = cost + 1
-         end if
-      class default
-         _FAIL('incompatible spec')
-      end select
-
-      _RETURN(_SUCCESS)
-   end function extension_cost
-
    subroutine initialize(this, importState, exportState, clock, rc)
       use esmf
       class(MockAction), intent(inout) :: this