mirror of
https://github.com/safishamsi/graphify.git
synced 2026-10-13 15:40:05 +00:00
fix(fortran): link type-bound procedures to their derived type
A derived type's contains section binds procedures as the type's methods
(procedure :: area => circle_area, or plain procedure :: scale), but the
derived_type_definition branch only minted the type node and ignored the
binding list entirely. The type ended up in the graph with no connection to
its own methods, and calls dispatched through the type were unrepresented.
Collect the bindings while walking the type and, after the whole tree is
walked (so the module's internal procedures already have nodes), add a method
edge from the type to each implementing procedure. A binding to a procedure
from another module resolves to a sourceless stub via ensure_named_node, the
same treatment parameter and return types already get, so the corpus rewire
can collapse it and no dangling edge is produced.
(cherry picked from commit 75f8fff533)
This commit is contained in:
1 parent
6cff8d6952
commit
a0c1359154
2 files changed
+107
No files matched your search
@@ -101,6 +101,11 @@ def extract_fortran(path: Path) -> dict:
|
||||
file_nid = _make_id(str(path))
|
||||
add_node(file_nid, path.name, 1)
|
||||
|
||||
# (type_nid, implementing_procedure_name, line) for every type-bound
|
||||
# procedure. Resolved after the whole tree is walked, once the module's
|
||||
# internal procedures have their nodes.
|
||||
type_bound_procs: list[tuple[str, str, int]] = []
|
||||
|
||||
def _fortran_name(stmt_node) -> str | None:
|
||||
"""Extract name from a *_statement node. Fortran is case-insensitive; lowercase."""
|
||||
for child in stmt_node.children:
|
||||
@@ -179,6 +184,23 @@ def extract_fortran(path: Path) -> dict:
|
||||
if tgt != fn_nid:
|
||||
add_edge(fn_nid, tgt, "references", var_line, context="return_type")
|
||||
|
||||
def _type_bound_impl_name(proc_stmt) -> str | None:
|
||||
"""The module procedure implementing a type-bound `procedure` statement.
|
||||
|
||||
`procedure :: area => circle_area` binds the method name `area` to the
|
||||
implementation `circle_area` (a `binding` node with a `method_name`
|
||||
child); `procedure :: scale` binds `scale` to a same-named procedure
|
||||
(a bare `method_name` child)."""
|
||||
binding = next((c for c in proc_stmt.children if c.type == "binding"), None)
|
||||
if binding is not None:
|
||||
mn = next((c for c in binding.children if c.type == "method_name"), None)
|
||||
if mn is not None:
|
||||
return _read_text(mn, source).lower()
|
||||
mn = next((c for c in proc_stmt.children if c.type == "method_name"), None)
|
||||
if mn is not None:
|
||||
return _read_text(mn, source).lower()
|
||||
return None
|
||||
|
||||
def walk_calls(node, scope_nid: str) -> None:
|
||||
if node is None:
|
||||
return
|
||||
@@ -253,6 +275,20 @@ def extract_fortran(path: Path) -> dict:
|
||||
line = node.start_point[0] + 1
|
||||
add_node(type_nid, type_name, line)
|
||||
add_edge(scope_nid, type_nid, "defines", line)
|
||||
# Type-bound procedures in the `contains` section bind the
|
||||
# derived type to the module procedures that implement its
|
||||
# methods. Without this the binding was dropped and the type
|
||||
# sat in the graph with no link to its own methods.
|
||||
procs = next((c for c in node.children
|
||||
if c.type == "derived_type_procedures"), None)
|
||||
if procs is not None:
|
||||
for stmt in procs.children:
|
||||
if stmt.type != "procedure_statement":
|
||||
continue
|
||||
impl = _type_bound_impl_name(stmt)
|
||||
if impl:
|
||||
type_bound_procs.append(
|
||||
(type_nid, impl, stmt.start_point[0] + 1))
|
||||
return
|
||||
|
||||
if t == "subroutine":
|
||||
@@ -299,6 +335,15 @@ def extract_fortran(path: Path) -> dict:
|
||||
|
||||
walk(root, file_nid)
|
||||
|
||||
# Link each derived type to the procedures bound as its methods, now that
|
||||
# the module's internal procedures have been given nodes. A binding to a
|
||||
# procedure imported from another module resolves to a sourceless stub the
|
||||
# corpus rewire can collapse (same treatment as parameter/return types).
|
||||
for type_nid, impl_name, line in type_bound_procs:
|
||||
tgt = ensure_named_node(impl_name, line)
|
||||
if tgt != type_nid:
|
||||
add_edge(type_nid, tgt, "method", line, context="type_bound_procedure")
|
||||
|
||||
_stmt_headers = {
|
||||
"subroutine_statement", "function_statement",
|
||||
"program_statement", "module_statement",
|
||||
|
||||
@@ -2421,6 +2421,68 @@ def test_fortran_capital_F_parses_preprocessed():
|
||||
assert any("compute_volume" in l for l in labels)
|
||||
|
||||
|
||||
def test_fortran_type_bound_procedures_link_to_the_type(tmp_path):
|
||||
"""A derived type's `contains` section binds procedures as its methods.
|
||||
|
||||
Both the renaming form (`procedure :: area => circle_area`) and the plain
|
||||
form (`procedure :: scale`) must connect the type to the module procedure
|
||||
that implements it; before this the whole binding was dropped and the type
|
||||
had no link to its own methods.
|
||||
"""
|
||||
src = tmp_path / "geom.f90"
|
||||
src.write_text(
|
||||
"module geom\n"
|
||||
" type :: circle\n"
|
||||
" real :: radius\n"
|
||||
" contains\n"
|
||||
" procedure :: area => circle_area\n"
|
||||
" procedure :: scale\n"
|
||||
" end type circle\n"
|
||||
"contains\n"
|
||||
" real function circle_area(self)\n"
|
||||
" class(circle), intent(in) :: self\n"
|
||||
" circle_area = 3.14159 * self%radius**2\n"
|
||||
" end function circle_area\n"
|
||||
" subroutine scale(self, f)\n"
|
||||
" class(circle), intent(inout) :: self\n"
|
||||
" real, intent(in) :: f\n"
|
||||
" self%radius = self%radius * f\n"
|
||||
" end subroutine scale\n"
|
||||
"end module geom\n",
|
||||
encoding="utf-8",
|
||||
)
|
||||
r = extract_fortran(src)
|
||||
assert "error" not in r
|
||||
methods = _edge_labels(r, "method", "type_bound_procedure")
|
||||
assert ("circle", "circle_area") in methods
|
||||
assert ("circle", "scale") in methods
|
||||
|
||||
|
||||
def test_fortran_type_bound_procedure_from_other_module_is_sourceless(tmp_path):
|
||||
"""A binding to a procedure implemented in another module resolves to a
|
||||
sourceless stub the corpus rewire can collapse, never a dangling edge."""
|
||||
src = tmp_path / "shape.f90"
|
||||
src.write_text(
|
||||
"module shape\n"
|
||||
" use draw_mod\n"
|
||||
" type :: widget\n"
|
||||
" contains\n"
|
||||
" procedure :: render => external_render\n"
|
||||
" end type widget\n"
|
||||
"end module shape\n",
|
||||
encoding="utf-8",
|
||||
)
|
||||
r = extract_fortran(src)
|
||||
node_ids = {n["id"] for n in r["nodes"]}
|
||||
# the binding still produced an edge...
|
||||
assert ("widget", "external_render") in _edge_labels(r, "method", "type_bound_procedure")
|
||||
# ...with a resolvable target node and no dangling endpoints
|
||||
for e in r["edges"]:
|
||||
assert e["source"] in node_ids and e["target"] in node_ids, e
|
||||
stub = next(n for n in r["nodes"] if n["label"] == "external_render")
|
||||
assert stub["source_file"] == ""
|
||||
|
||||
|
||||
# ── PowerShell ───────────────────────────────────────────────────────────────
|
||||
|
||||
def test_powershell_no_error():
|
||||
|
||||
Reference in new issue
Block a user