Honor MCP extra libdirs from environment
ober
7765fea05df47999d154b15211e779affcdc237a
--- a/mcp/server.ss +++ b/mcp/server.ss @@ -681,6 +681,12 @@ value)] [else '()]))) +(def (env-extra-libdirs project home) + (let ([value (getenv "JERBOA_MCP_EXTRA_LIBDIRS")]) + (if (and value (> (string-length (string-trim value)) 0)) + (libdir-list-value value project home) + '()))) + (def (project-libdirs project home) (if project (let ([from-makefile (makefile-libdirs project home)] @@ -717,6 +723,7 @@ (let ([project (tool-project-path args file)]) (unique-strings (append (arg-libdirs args project home) + (env-extra-libdirs project home) (project-libdirs project home) (source-extra-libdirs file))))) --- a/mcp/test/external-lib-test.ss +++ b/mcp/test/external-lib-test.ss @@ -88,38 +88,64 @@ (cons "project_path" root) (cons "extra_libdirs" (list "lib"))))) +(def old-extra-libdirs (getenv "JERBOA_MCP_EXTRA_LIBDIRS")) +(putenv "JERBOA_MCP_EXTRA_LIBDIRS" "") (def responses - (run-server - (list - (request 1 "initialize" - (alist->hash-table - (list (cons "protocolVersion" "2024-11-05") - (cons "capabilities" (make-hash-table)) - (cons "clientInfo" (alist->hash-table '()))))) - (call-tool 2 "jerboa_module_exists" args-with-extra) - (call-tool 3 "jerboa_module_exports" args-with-extra) - (call-tool 4 "jerboa_module_exports" - (alist->hash-table - (list (cons "module_path" "(demo api)")))) - (call-tool 5 "jerboa_function_signature" - (alist->hash-table - (list (cons "symbol" "fixed") - (cons "imports" (list "(demo api)")) - (cons "project_path" root) - (cons "extra_libdirs" (list "lib"))))) - (call-tool 6 "jerboa_function_signature" - (alist->hash-table - (list (cons "symbol" "with-demo") - (cons "imports" (list "(demo api)")) - (cons "project_path" root) - (cons "extra_libdirs" (list "lib"))))) - (call-tool 7 "jerboa_cookbook_task_bundle" - (alist->hash-table - (list (cons "task" "Qt Tetris self-test") - (cons "module_path" "(jerboa-qt qt)") - (cons "extra_libdirs" - (list (path-join (getenv "HOME") - "mine/jerboa-qt/lib"))))))))) + (dynamic-wind + (lambda () (void)) + (lambda () + (run-server + (list + (request 1 "initialize" + (alist->hash-table + (list (cons "protocolVersion" "2024-11-05") + (cons "capabilities" (make-hash-table)) + (cons "clientInfo" (alist->hash-table '()))))) + (call-tool 2 "jerboa_module_exists" args-with-extra) + (call-tool 3 "jerboa_module_exports" args-with-extra) + (call-tool 4 "jerboa_module_exports" + (alist->hash-table + (list (cons "module_path" "(demo api)")))) + (call-tool 5 "jerboa_function_signature" + (alist->hash-table + (list (cons "symbol" "fixed") + (cons "imports" (list "(demo api)")) + (cons "project_path" root) + (cons "extra_libdirs" (list "lib"))))) + (call-tool 6 "jerboa_function_signature" + (alist->hash-table + (list (cons "symbol" "with-demo") + (cons "imports" (list "(demo api)")) + (cons "project_path" root) + (cons "extra_libdirs" (list "lib"))))) + (call-tool 7 "jerboa_cookbook_task_bundle" + (alist->hash-table + (list (cons "task" "Qt Tetris self-test") + (cons "module_path" "(jerboa-qt qt)") + (cons "extra_libdirs" + (list (path-join (getenv "HOME") + "mine/jerboa-qt/lib"))))))))) + (lambda () + (putenv "JERBOA_MCP_EXTRA_LIBDIRS" (or old-extra-libdirs ""))))) + +(putenv "JERBOA_MCP_EXTRA_LIBDIRS" lib-dir) +(def env-responses + (dynamic-wind + (lambda () (void)) + (lambda () + (run-server + (list + (request 8 "initialize" + (alist->hash-table + (list (cons "protocolVersion" "2024-11-05") + (cons "capabilities" (make-hash-table)) + (cons "clientInfo" (alist->hash-table '()))))) + (call-tool 9 "jerboa_function_signature" + (alist->hash-table + (list (cons "symbol" "with-demo") + (cons "imports" (list "(demo api)")))))))) + (lambda () + (putenv "JERBOA_MCP_EXTRA_LIBDIRS" (or old-extra-libdirs ""))))) (def exists-text (content-text (result (list-ref responses 1)))) (def exports-text (content-text (result (list-ref responses 2)))) @@ -127,6 +153,7 @@ (def fixed-text (content-text (result (list-ref responses 4)))) (def macro-text (content-text (result (list-ref responses 5)))) (def qt-bundle-text (content-text (result (list-ref responses 6)))) +(def env-macro-text (content-text (result (list-ref env-responses 1)))) (def cookbook-text (read-file-string (path-join repo-root "data" "cookbooks.sexp"))) (check "module_exists honors relative extra_libdirs" @@ -151,6 +178,9 @@ (string-contains macro-text "Usage: (with-demo ctx body ...)") (string-contains macro-text "Source: ") (not (string-contains macro-text "Accepted arity: unknown")))) +(check "function_signature honors JERBOA_MCP_EXTRA_LIBDIRS defaults" + (and (string-contains env-macro-text "Kind: syntax") + (string-contains env-macro-text "Usage: (with-demo ctx body ...)"))) (check "qt dependency context is compact and current" (and (< (string-length qt-bundle-text) 4096) (string-contains qt-bundle-text "Qt dependency context bundle")