Merge pull request #584 from Fortran-FOSS-Programmers/fix-call-chain-…

…external-types Fix call chain following for external types
Fortran-FOSS-Programmers · Nov 9, 2023 · e2784cb · e2784cb
2 parents cd71a3f + 45b8dd2
commit e2784cb
Show file tree

Hide file tree

Showing 4 changed files with 54 additions and 5 deletions.
diff --git a/ford/sourceform.py b/ford/sourceform.py
@@ -1479,9 +1479,9 @@ def get_label_item(context, label):
                 context = item
             elif isinstance(item, FortranVariable):
                 type_str = strip_type(item.full_type)
-                if item.parent is None:
+                if not (parent_all_types := getattr(item.parent, "all_types", {})):
                     return None
-                context = item.parent.all_types.get(type_str, None)
+                context = parent_all_types.get(type_str, None)
             else:
                 context = None
 

diff --git a/test/test_projects/test_external_project.py b/test/test_projects/test_external_project.py
@@ -5,13 +5,32 @@
 import copy
 from urllib.parse import urlparse
 import json
+from typing import Dict, Any
 
 import ford
 
 from bs4 import BeautifulSoup
 import pytest
 
 
+REMOTE_TYPE_JSON: Dict[str, Any] = {
+    "name": "remote_type",
+    "external_url": "./type/remote_type.html",
+    "obj": "type",
+    "extends": None,
+    "variables": [
+        {
+            "name": "cptr",
+            "external_url": "./type/config.html#variable-cptr",
+            "obj": "variable",
+            "vartype": "type",
+            "permission": "public",
+        },
+    ],
+    "boundprocs": [],
+    "permission": "public",
+}
+
 REMOTE_MODULES_JSON = [
     {
         "name": "remote_module",
@@ -32,7 +51,7 @@
             },
         },
         "pub_absints": {},
-        "pub_types": {},
+        "pub_types": {"remote_type": REMOTE_TYPE_JSON},
         "pub_vars": {},
         "functions": [],
         "subroutines": [
@@ -51,7 +70,7 @@
         ],
         "interfaces": [],
         "absinterfaces": [],
-        "types": [],
+        "types": [REMOTE_TYPE_JSON],
         "variables": [],
     }
 ]

diff --git a/test/test_sourceform.py b/test/test_sourceform.py
@@ -456,6 +456,14 @@ def test_function_and_subroutine_call_on_same_line(parse_fortran_file):
             """,
             ["p_faz", "p_fuz"],
         ),
+        (
+            """
+            USE m_baz, ONLY: t_unknown_parent
+            TYPE(t_unknown_parent)
+            call t_unknown_parent%known_method()
+            """,
+            ["known_method"],
+        ),
     ],
 )
 def test_type_chain_function_and_subroutine_calls(
@@ -501,13 +509,19 @@ def test_type_chain_function_and_subroutine_calls(
 
         USE m_foo, ONLY: t_baz
         USE m_bar, ONLY: t_foo
+        USE unknown_module
         TYPE, EXTENDS(t_foo) :: t_bar
             TYPE(t_baz) :: v_baz
         CONTAINS
             PROCEDURE :: p_bar
             PROCEDURE :: renamed => p_bar
         END TYPE t_bar
 
+        TYPE, EXTENDS(unknown_type) :: t_unknown_parent
+        CONTAINS
+            PROCEDURE, NOPASS :: known_method
+        END TYPE
+
         CONTAINS
 
         SUBROUTINE p_bar(self)
@@ -518,6 +532,9 @@ def test_type_chain_function_and_subroutine_calls(
             INTEGER, DIMENSION(2), INTENT(IN) :: var_int
         END SUBROUTINE p_buz
 
+        SUBROUTINE known_method()
+        END SUBROUTINE
+
     END MODULE m_baz
 
     MODULE m_main

diff --git a/test_data/external_project/top_level_project/src/top_level.f90 b/test_data/external_project/top_level_project/src/top_level.f90
@@ -1,3 +1,16 @@
+module config_mod
+   use remote_module
+   implicit none
+contains
+
+   function create() result(config)
+      type (remote_type) :: config
+      ! Checks call chain following when using external entities
+      config%cptr%buffer(1:1) = 10
+   end function create
+end module config_mod
+
+
 module myAbort
   use external_module
   type, public, extends(solverAborts_type) :: vel_abortCriteria_type
@@ -39,7 +52,7 @@ program top_level
 
   type, extends(test) :: maintest
     character(len=10) :: label
-  end type
+  end type maintest
 
   call external_sub
   call remote_sub