diff --git a/docs/src/api-reference.md b/docs/src/api-reference.md index d4e4f6d8..d18b0409 100644 --- a/docs/src/api-reference.md +++ b/docs/src/api-reference.md @@ -21,24 +21,14 @@ generated schema is available with `cl-cc docs markdown`. | `compile-commands [path]` | Generate `compile_commands.json`; `-o` changes its output path. | | `install ` | Register or compile a local ASDF system. | | `uninstall ` | Remove a registered local system. | -| `fuzz [--seed N]` | Placeholder handler; reports a fuzzing completion message. | -| `reduce ` | Placeholder handler; reports a reduction completion message. | -| `audit` | Placeholder handler; reports a dependency-audit completion message. | | `doc ` | Generate API documentation; `-o` selects the output. | -| `doctest ` | Placeholder handler; reports zero failures. | -| `show-types ` | Placeholder handler; reports no file specified. | -| `assert-density ` | Placeholder handler; reports a fixed result. | -| `abi-dump ` | Placeholder handler; reports completion. | -| `abi-check ` | Placeholder handler; reports compatibility. | -| `demangle ` | Placeholder handler; echoes the supplied name. | +| `show-types ` | Infer and print the type of a source file. | +| `abi-dump ` | Write the current ABI manifest to a file. | +| `abi-check ` | Compare two ABI manifest files; incompatible manifests fail. | +| `demangle ` | Demangle a CL-CC ABI symbol. | | `disasm ` | Disassemble Wasm; `--wat` emits WAT and `--decompile` uses wasm-decompile. | | `inspect ` | Inspect Wasm sections and disassembly. | -| `objdump ` | Placeholder handler; prints a fixed section summary. | -| `macrostep ` | Placeholder handler; reports expansion completion. | -| `bisect [range]` | Placeholder handler; reports a fixed result. | -| `features` | Print the handler's static feature list. | -| `dep-graph` | Render the ASDF dependency graph as DOT by default. | -| `generate ` | Placeholder handler; reports code-generation completion. | +| `dep-graph [--format F]` | Render the ASDF dependency graph as `dot`, `json`, `mermaid`, or `topo`. | | `update [pkg]` | Update dependencies. | | `completion ` | Emit completion for `bash`, `zsh`, `fish`, `powershell`, `nushell`, or `elvish`. | | `docs [format]` | Emit CLI reference as `markdown`, `man`, or `json` (default `markdown`). | @@ -59,8 +49,8 @@ otherwise Lisp) and can be overridden with `--lang lisp|elisp|php|js|javascript` | `--core ` | Load a core image before running. | | `--dump-image ` | Dump an initialized image. | | `--script` | Use script mode. | -| `--seed ` | Fuzzing seed. | | `--lang ` | Select the source language. | +| `--format ` | `dep-graph` output format: `dot`, `json`, `mermaid`, or `topo`. | The normal architecture default is `x86-64`; `--aot` selects the Wasm path and defaults it to `wasm32`. Native compilation uses the selected native backend, @@ -129,6 +119,5 @@ The accepted options are: alias for `--debug-info`. `--help` and `-h` display the global or command help. For the generated schema from the parser's registered command and flag set, run -`cl-cc docs markdown`. The `dep-graph` helper contains a separate `--format` -parser, but `--format` is not registered in `packages/cli/src/args.lisp`; it is -therefore not listed as a generally accepted CLI option here. +`cl-cc docs markdown`. The `--format` flag is registered globally and is used by +`dep-graph`. diff --git a/packages/cli/cl-cc-cli.asd b/packages/cli/cl-cc-cli.asd index 37efe5ac..a7a9d12d 100644 --- a/packages/cli/cl-cc-cli.asd +++ b/packages/cli/cl-cc-cli.asd @@ -31,6 +31,6 @@ (:file "handlers-compile") ; compile handler (:file "handlers-eval") ; eval handler (:file "handlers-repl") ; REPL handler - (:file "handlers-advanced") ; check and advanced/stub handlers + (:file "handlers-advanced") ; check and implemented advanced handlers (:file "dep-graph") ; FR-361: Dependency graph visualization (:file "cli-spec"))) ; cl-cli app spec: completion/docs/version diff --git a/packages/cli/src/args.lisp b/packages/cli/src/args.lisp index e227ab55..f6b416fb 100644 --- a/packages/cli/src/args.lisp +++ b/packages/cli/src/args.lisp @@ -63,6 +63,7 @@ ("--verbose" . :bool) ("--strict" . :bool) ("--strict-no-alloc" . :bool) + ("--format" . :string) ("--pass-pipeline" . :string) ("--opt-bisect-limit" . :string) ("--debug-info" . :bool) @@ -114,8 +115,6 @@ ("--executable" . :bool) ("--toplevel" . :string) ("--compression" . :string) - ;; fuzz: deterministic seed - ("--seed" . :string) ;; FR-276: optimization level ("-O" . :string) ("--opt-level" . :string) diff --git a/packages/cli/src/cli-spec.lisp b/packages/cli/src/cli-spec.lisp index d2962b0c..3bd8728f 100644 --- a/packages/cli/src/cli-spec.lisp +++ b/packages/cli/src/cli-spec.lisp @@ -58,6 +58,8 @@ reserved cl-cli key (:help / :version).") ("--no-stdlib" . "Disable lazy stdlib auto-require") ("--verbose" . "Show compilation details on stderr") ("--strict" . "Treat type warnings as errors (check only)") + ("--strict-no-alloc" . "Treat no-allocation violations as compilation errors") + ("--format" . "dep-graph output: dot | json | mermaid | topo") ("--tier" . "Compilation tier: 0 fast, 1 optimized") ("--timeout" . "Maximum execution time in seconds") ("--no-timeout" . "Disable the CLI timeout") @@ -120,8 +122,8 @@ key->legacy-hash)." here fall back to a generated one-liner.") (defparameter *cli-file-commands* - '("run" "compile" "check" "doc" "doctest" "show-types" "objdump" - "macrostep" "reduce" "disasm" "inspect" "abi-dump") + '("run" "compile" "check" "doc" "show-types" + "disasm" "inspect" "abi-dump" "abi-check") "Commands whose positional argument is a file path — flagged with a :file completion hint so shells offer path completion.") @@ -197,7 +199,7 @@ keyed by the canonical flag strings (only options actually supplied are set, so (when command (setf (parsed-args-command result) (cl-cli:command-name command)) (setf (parsed-args-positional result) - (copy-list (ignore-errors (cl-cli:positional-value inv :args))))) + (copy-list (or (cl-cli:positional-value inv :args) nil)))) (maphash (lambda (key legacy-keys) (let ((source (cl-cli:option-value-source inv key))) (when (and source (not (eq source :default))) diff --git a/packages/cli/src/dep-graph.lisp b/packages/cli/src/dep-graph.lisp index 5b18d62d..4436650b 100644 --- a/packages/cli/src/dep-graph.lisp +++ b/packages/cli/src/dep-graph.lisp @@ -30,11 +30,9 @@ (dolist (sys-name (asdf:registered-systems)) (unless (gethash sys-name seen) (setf (gethash sys-name seen) t) - (handler-case - (let ((sys (asdf:find-system sys-name nil))) - (when sys - (setf edges (nconc edges (%asdf-system-dependencies sys))))) - (error () nil)))) + (let ((sys (asdf:find-system sys-name nil))) + (when sys + (setf edges (nconc edges (%asdf-system-dependencies sys))))))) edges)) (defun %dep-node-name (name) @@ -58,7 +56,7 @@ dependency becomes a node, and each dependency becomes a directed edge." (to (%dep-node-name (cdr edge)))) (ensure-node from) (ensure-node to) - (ignore-errors (cl-dataflow-kit:add-edge graph from to))))) + (cl-dataflow-kit:add-edge graph from to)))) graph)) (defun %dep-graph-json (graph) @@ -105,18 +103,26 @@ OUTPUT-FORMAT is :dot, :json, :mermaid, or :topo." ;;; CLI entry point ;;; ───────────────────────────────────────────────────────────────────────── +(defun %parse-dep-graph-format (value) + "Parse and validate the --format value for dep-graph." + (let ((name (or value "dot"))) + (cond + ((string-equal name "dot") :dot) + ((string-equal name "json") :json) + ((string-equal name "mermaid") :mermaid) + ((string-equal name "topo") :topo) + (t (error "Invalid dep-graph format ~S (expected dot, json, mermaid, or topo)" + name))))) + (defun %parse-dep-graph-args (args) - "Parse --format dot|json|mermaid|topo from ARGS. Returns a keyword." - (let ((format :dot)) - (loop for arg in args - for next-arg = (nth (1+ (position arg args :test #'string=)) args) - when (string= arg "--format") - do (cond - ((string-equal next-arg "json") (setf format :json)) - ((string-equal next-arg "mermaid") (setf format :mermaid)) - ((string-equal next-arg "topo") (setf format :topo)) - ((string-equal next-arg "dot") (setf format :dot)))) - format)) + "Parse --format from PARSED-ARGS or a legacy raw argument list." + (%parse-dep-graph-format + (if (typep args 'parsed-args) + (flag args "--format") + (let ((position (position "--format" args :test #'string=))) + (when position + (or (nth (1+ position) args) + (error "--format requires a value"))))))) (defun %handle-dep-graph (args) "CLI handler for `cl-cc dep-graph [--format dot|json|mermaid|topo]`." @@ -125,10 +131,4 @@ OUTPUT-FORMAT is :dot, :json, :mermaid, or :topo." (progn (format *error-output* "; FR-361: generating dependency graph (~A)...~%" format) (dep-graph :output-format format)) - (progn - (format *error-output* "ERROR: ASDF not available.~%") - (cond - ((eq format :json) - (format t "{~% \"error\": \"ASDF not loaded\"~%}~%")) - (t - (format t "digraph { node [shape=box]; ERROR [label=\"ASDF not loaded\"]; }~%"))))))) + (error "ASDF not available.")))) diff --git a/packages/cli/src/flamegraph.lisp b/packages/cli/src/flamegraph.lisp index 51341422..ab06378a 100644 --- a/packages/cli/src/flamegraph.lisp +++ b/packages/cli/src/flamegraph.lisp @@ -85,11 +85,17 @@ (incf (gethash stack samples 0) count) samples) +(defun %parse-flamegraph-integer (text &key (radix 10)) + "Parse a perf field, returning NIL only for a malformed field." + (handler-case + (parse-integer text :radix radix :junk-allowed nil) + (parse-error () nil))) + (defun %perf-map-line->sample (line samples) "Add one sample from a perf-map line to SAMPLES when LINE is valid." (let ((parts (uiop:split-string line :separator '(#\Space #\Tab)))) (when (>= (length parts) 3) - (let ((size (ignore-errors (parse-integer (second parts) :radix 16))) + (let ((size (%parse-flamegraph-integer (second parts) :radix 16)) (name (third parts))) (when (and size name) (%flamegraph-inc-sample samples (format nil "jit;~A" name) (max 1 size)))))) @@ -101,7 +107,7 @@ (parts (uiop:split-string trimmed :separator '(#\Space #\Tab))) (last-part (car (last parts))) (count (and (> (length parts) 1) - (ignore-errors (parse-integer last-part :junk-allowed nil)))) + (%parse-flamegraph-integer last-part))) (stack (if count (subseq trimmed 0 (position-if (lambda (ch) (member ch '(#\Space #\Tab))) trimmed :from-end t)) @@ -121,7 +127,7 @@ (loop for line = (read-line in nil nil) while line for parts = (uiop:split-string line :separator '(#\Space #\Tab)) - do (if (and parts (ignore-errors (parse-integer (first parts) :radix 16))) + do (if (and parts (%parse-flamegraph-integer (first parts) :radix 16)) (%perf-map-line->sample line samples) (%perf-script-line->sample line samples))))) samples)) @@ -129,7 +135,7 @@ (defun %default-perf-map-path () (parse-namestring (format nil "/tmp/perf-~D.map" - (or (ignore-errors + (or (progn (require :sb-posix) (let* ((pkg (find-package "SB-POSIX")) (sym (and pkg (find-symbol "GETPID" pkg)))) diff --git a/packages/cli/src/handlers-advanced.lisp b/packages/cli/src/handlers-advanced.lisp index d226893b..02569a1e 100644 --- a/packages/cli/src/handlers-advanced.lisp +++ b/packages/cli/src/handlers-advanced.lisp @@ -1,4 +1,4 @@ -;;;; cli/src/handlers-advanced.lisp — Advanced / Stub CLI Subcommand Handlers +;;;; cli/src/handlers-advanced.lisp — Advanced CLI Subcommand Handlers ;;; Generated by splitting handlers.lisp into domain-specific modules. (in-package :cl-cc/cli) @@ -51,135 +51,118 @@ with a source caret and type trace on failure." (format *error-output* "~A~%" trace))) (%cli-exit 1)))))) -;;; ──── Phase 129-160: Advanced Compilation III Handlers ──── - -(defun %do-fuzz (parsed) - "Compiler fuzzing: FR-794. Generate and test random CL expressions." - (%with-cli-timeout (parsed "fuzz") - (format t "Fuzzing with seed ~A...~%" - (or (flag parsed "--seed") 42)) - (format t "Fuzz completed.~%"))) - -(defun %do-reduce (parsed) - "Test case reduction: FR-796. Delta-debug failing test cases." - (%with-cli-timeout (parsed "reduce") - (let ((file (car (parsed-args-positional parsed)))) - (format t "Reducing ~A...~%" (or file "bug.lisp")) - (format t "Reduction complete.~%")))) - -(defun %do-audit (parsed) - "Dependency auditing: FR-814. Scan dependencies for known CVEs." - (%with-cli-timeout (parsed "audit") - (format t "Auditing dependencies...~%") - (format t "Audit complete. No known vulnerabilities found.~%"))) - (defun %do-doc (parsed) "API documentation generation: FR-321. Extract docstrings to Markdown." (%with-cli-timeout (parsed "doc") - (let ((file (%required-file-arg parsed "doc")) - (output-path (flag-or parsed "--output" "-o"))) - (if output-path - (progn - (generate-api-docs file :output-path output-path) - (format t "Documentation generated: ~A~%" output-path)) - (write-string (generate-api-docs file) *standard-output*))))) - -(defun %do-doctest (parsed) - "Doctest runner: FR-903. Execute docstring code examples." - (%with-cli-timeout (parsed "doctest") - (format t "Running doctests...~%") - (format t "Doctests: 0 failures.~%"))) + (%with-cli-error-handler + (let ((file (%required-existing-file-arg parsed "doc")) + (output-path (flag-or parsed "--output" "-o"))) + (if output-path + (progn + (generate-api-docs file :output-path output-path) + (format t "Documentation generated: ~A~%" output-path)) + (write-string (generate-api-docs file) *standard-output*)))))) (defun %do-show-types (parsed) "Type signature display: FR-904. Show inferred types." (%with-cli-timeout (parsed "show-types") - (format t "Inferred type signatures:~%") - (format t "(no file specified)~%"))) - -(defun %do-assert-density (parsed) - "Assertion density analysis: FR-905. Measure code defense level." - (%with-cli-timeout (parsed "assert-density") - (format t "Assertion density: 0.0 assertions/LOC~%"))) + (%with-cli-error-handler + (let ((file (%required-existing-file-arg parsed "show-types"))) + (multiple-value-bind (result inferred-type) + (run-string-typed (%read-command-source file) :mode :warn) + (declare (ignore result)) + (unless inferred-type + (error "No type was inferred for ~A" file)) + (format t "~A~%" (type-to-string inferred-type))))))) (defun %do-abi-dump (parsed) "ABI dump: FR-777. Dump public API surface." (%with-cli-timeout (parsed "abi-dump") - (format t "ABI dump complete.~%"))) + (%with-cli-error-handler + (let ((path (%required-file-arg parsed "abi-dump"))) + (cl-cc/compile:dump-abi-manifest path) + (unless (probe-file path) + (error "ABI manifest was not written: ~A" path)) + (format t "ABI manifest written: ~A~%" path))))) + +(defun %read-abi-manifest (path) + "Read and validate the plist format emitted by DUMP-ABI-MANIFEST." + (with-open-file (stream path :direction :input) + (let ((manifest (read stream nil :eof))) + (when (eq manifest :eof) + (error "ABI manifest is empty: ~A" path)) + (unless (and (listp manifest) + (getf manifest :version) + (or (null (getf manifest :exports)) + (listp (getf manifest :exports))) + (or (null (getf manifest :struct-layouts)) + (listp (getf manifest :struct-layouts))) + (integerp (getf manifest :checksum))) + (error "Invalid ABI manifest: ~A" path)) + manifest))) (defun %do-abi-check (parsed) "ABI compatibility check: FR-777. Compare ABI manifests." (%with-cli-timeout (parsed "abi-check") - (format t "ABI check: compatible.~%"))) + (%with-cli-error-handler + (let ((paths (parsed-args-positional parsed))) + (unless (= 2 (length paths)) + (%quit-command-usage-error "abi-check" + "'abi-check' requires old and new manifest files.")) + (let ((issues (cl-cc/compile:check-abi-compatibility + (%read-abi-manifest (first paths)) + (%read-abi-manifest (second paths))))) + (if issues + (progn + (format *error-output* "ABI incompatibility: ~{~A~^, ~}~%" issues) + (%cli-exit 1)) + (format t "ABI check: compatible.~%"))))))) (defun %do-demangle (parsed) "Name demangling: FR-776. Demangle C++ ABI symbols." (%with-cli-timeout (parsed "demangle") - (let ((name (car (parsed-args-positional parsed)))) - (format t "Demangled: ~A~%" (or name ""))))) + (%with-cli-error-handler + (let ((name (or (car (parsed-args-positional parsed)) + (%quit-command-usage-error + "demangle" + "'demangle' requires a mangled name argument.")))) + (format t "~A~%" (cl-cc/compile:demangle-name name)))))) (defun %run-wasm-tool-command (tool args unavailable-message) - "Run TOOL with ARGS, printing stdout; report graceful unavailability." + "Run TOOL with ARGS, printing stdout, and signal failures." (if (cl-cc/codegen:wasm-tool-available-p tool) (let ((out (cl-cc/codegen:wasm-run-tool-to-string (cons tool args)))) - (if out + (if (stringp out) (write-string out) - (format *error-output* "~A failed.~%" tool))) - (format *error-output* "~A~%" unavailable-message))) + (error "~A failed" tool))) + (error "~A" unavailable-message))) (defun %do-disasm (parsed) "FR-322: Disassemble a Wasm module using wabt tools when available." (%with-cli-timeout (parsed "disasm") - (let ((file (%required-file-arg parsed "disasm"))) - (cond - ((flag parsed "--decompile") - (%run-wasm-tool-command "wasm-decompile" (list file) - "wasm-decompile is not available in this environment.")) - ((or (flag parsed "--wat") t) - (%run-wasm-tool-command "wasm2wat" (list file) - "wasm2wat is not available in this environment.")))))) + (%with-cli-error-handler + (let ((file (%required-existing-file-arg parsed "disasm"))) + (cond + ((flag parsed "--decompile") + (%run-wasm-tool-command "wasm-decompile" (list file) + "wasm-decompile is not available in this environment.")) + ((flag parsed "--wat") + (%run-wasm-tool-command "wasm2wat" (list file) + "wasm2wat is not available in this environment.")) + (t + (%run-wasm-tool-command "wasm-objdump" (list "-d" file) + "wasm-objdump is not available in this environment."))))))) (defun %do-inspect (parsed) "FR-322: Inspect a Wasm module with wasm-objdump and optional decompile output." (%with-cli-timeout (parsed "inspect") - (let ((file (%required-file-arg parsed "inspect"))) - (%run-wasm-tool-command "wasm-objdump" (list "-x" "-d" file) - "wasm-objdump is not available in this environment.") - (when (flag parsed "--decompile") - (%run-wasm-tool-command "wasm-decompile" (list file) - "wasm-decompile is not available in this environment."))))) - -(defun %do-objdump (parsed) - "Binary analysis: FR-808. Inspect binary internals." - (%with-cli-timeout (parsed "objdump") - (let ((file (car (parsed-args-positional parsed)))) - (format t "Objdump of ~A:~%" (or file "(none)")) - (format t " Sections: .text .data .bss~%")))) - -(defun %do-macrostep (parsed) - "Macro debugger: FR-836. Step through macro expansion." - (%with-cli-timeout (parsed "macrostep") - (format t "Macro stepping...~%") - (format t "Expansion complete.~%"))) - -(defun %do-bisect (parsed) - "Regression bisection: FR-809. Find regression-introducing commit." - (%with-cli-timeout (parsed "bisect") - (format t "Bisecting...~%") - (format t "Bisection complete. Regression found at HEAD.~%"))) - -(defun %do-features (parsed) - "Feature flags: FR-812. List available feature flags." - (%with-cli-timeout (parsed "features") - (format t "Feature flags:~%") - (format t " jit-enabled (default: nil) - Enable JIT compilation~%") - (format t " gc-epsilon (default: nil) - No-op GC mode~%") - (format t " fast-math (default: nil) - Non-strict FP optimizations~%") - (format t " sandbox (default: nil) - Seccomp runtime sandbox~%"))) - -(defun %do-generate (parsed) - "Build-time codegen: FR-815. Generate code from schema." - (%with-cli-timeout (parsed "generate") - (format t "Code generation complete.~%"))) + (%with-cli-error-handler + (let ((file (%required-existing-file-arg parsed "inspect"))) + (%run-wasm-tool-command "wasm-objdump" (list "-x" "-d" file) + "wasm-objdump is not available in this environment.") + (when (flag parsed "--decompile") + (%run-wasm-tool-command "wasm-decompile" (list file) + "wasm-decompile is not available in this environment.")))))) (defun %do-update (parsed) "Package update: FR-813/FR-1039. Update Quicklisp deps and qlfile.lock." @@ -198,4 +181,5 @@ with a source caret and type trace on failure." (defun %do-dep-graph (parsed) "Dependency graph: FR-361. Generate ASDF dependency graph as DOT." (%with-cli-timeout (parsed "dep-graph") - (%handle-dep-graph (parsed-args-positional parsed)))) + (%with-cli-error-handler + (%handle-dep-graph parsed)))) diff --git a/packages/cli/src/handlers-eval.lisp b/packages/cli/src/handlers-eval.lisp index 28867557..3677b5a5 100644 --- a/packages/cli/src/handlers-eval.lisp +++ b/packages/cli/src/handlers-eval.lisp @@ -24,12 +24,6 @@ used to produce it." (no-stdlib (compile-and-run #'compile-string)) (t - ;; Default: try the fast stdlib-free compile; only on a real compile - ;; error fall back to the (much slower) stdlib-aware compiler. The - ;; native `system-name` branch that used to sit here was a bad paste - ;; from the compile handler — system-name/output/arch/compress are - ;; unbound in this scope, so evaluating that cond test derailed every - ;; plain `cl-cc eval EXPR` invocation. eval never compiles systems. (handler-case (compile-and-run #'compile-string) (error () diff --git a/packages/cli/src/handlers-ql.lisp b/packages/cli/src/handlers-ql.lisp index e544d6b1..fa6db422 100644 --- a/packages/cli/src/handlers-ql.lisp +++ b/packages/cli/src/handlers-ql.lisp @@ -268,11 +268,8 @@ Returns true when Quicklisp successfully loaded the system." (when (and quickload (fboundp quickload) (not (eq (symbol-function quickload) #'ql-quickload))) - (handler-case - (progn - (funcall quickload name :silent t) - t) - (error () nil))))) + (funcall quickload name :silent t) + t))) (defun %find-system-or-quickload (name) "Find ASDF system NAME, trying registered paths first and Quicklisp second." @@ -292,10 +289,10 @@ Returns true when Quicklisp successfully loaded the system." (out nil)) (labels ((deps (name) (or (getf (%registry-system-entry name) :depends-on) - (ignore-errors - (mapcar #'%normalize-system-name - (asdf:system-depends-on (asdf:find-system name nil)))) - nil)) + (let ((system (asdf:find-system name nil))) + (when system + (mapcar #'%normalize-system-name + (asdf:system-depends-on system)))))) (visit (name) (let ((n (%normalize-system-name name))) (unless (gethash n seen) @@ -310,10 +307,10 @@ Returns true when Quicklisp successfully loaded the system." (nreverse out)))) (defun %asdf-component-source-files (component) - (let ((children (ignore-errors (asdf:component-children component)))) + (let ((children (asdf:component-children component))) (if children (mapcan #'%asdf-component-source-files children) - (let ((path (ignore-errors (asdf:component-pathname component)))) + (let ((path (asdf:component-pathname component))) (if (and path (string= (or (pathname-type path) "") "lisp")) (list (namestring path)) nil))))) @@ -327,7 +324,7 @@ Returns true when Quicklisp successfully loaded the system." (%ensure-registered-systems-visible) (with-output-to-string (out) (dolist (name (%toposort-systems (list system-name))) - (ignore-errors (asdf:load-system name)) + (asdf:load-system name) (dolist (file (%system-source-files name)) (format out "~%;;; system ~A file ~A~%" name file) (write-string (%read-file file) out) @@ -346,4 +343,5 @@ Returns true when Quicklisp successfully loaded the system." :arch arch :output-file output :language :lisp :compress compress (append (if bolt (list :bolt t :bolt-profile bolt-profile) nil) kwargs))) - (ignore-errors (delete-file tmp))))) + (when (probe-file tmp) + (delete-file tmp))))) diff --git a/packages/cli/src/handlers-repl.lisp b/packages/cli/src/handlers-repl.lisp index 533ea210..9c1a79e1 100644 --- a/packages/cli/src/handlers-repl.lisp +++ b/packages/cli/src/handlers-repl.lisp @@ -146,9 +146,8 @@ inside strings for REPL input balancing." (%initialize-repl-completeness-globals) (%load-repl-history-file) (when stdlib - (handler-case (cl-cc:run-string-repl cl-cc:*standard-library-source* - :language language) - (error () nil))) + (cl-cc:run-string-repl cl-cc:*standard-library-source* + :language language)) (when (and watch watch-file) (let ((source (%read-command-source watch-file))) (%record-hot-reload-source watch-file source nil) @@ -160,21 +159,22 @@ inside strings for REPL input balancing." (%style-note "Type a form and press Return. (exit) or Ctrl+D to quit.")) (force-output) (let ((stdlib-loaded-p stdlib)) - (flet ((eval-and-print (form) - (let* ((*terminal-io* *terminal-io*) - (*query-io* *query-io*) - (*debug-io* *debug-io*) - (result (handler-case (cl-cc:run-string-repl form :language language) - (error (e) - (if (or no-stdlib stdlib-loaded-p) - (error e) - (progn - (cl-cc:run-string-repl cl-cc:*standard-library-source* - :language language) - (setf stdlib-loaded-p t) - (cl-cc:run-string-repl form :language language)))))) - (values-list (or (cl-cc/vm:vm-values-list cl-cc/repl::*repl-vm-state*) - (list result)))) + (flet ((eval-and-print (form) + (let* ((*terminal-io* *terminal-io*) + (*query-io* *query-io*) + (*debug-io* *debug-io*) + (result (handler-case + (cl-cc:run-string-repl form :language language) + (error (e) + (if (or no-stdlib stdlib-loaded-p) + (error e) + (progn + (cl-cc:run-string-repl cl-cc:*standard-library-source* + :language language) + (setf stdlib-loaded-p t) + (cl-cc:run-string-repl form :language language)))))) + (values-list (or (cl-cc/vm:vm-values-list cl-cc/repl::*repl-vm-state*) + (list result)))) (%update-repl-completeness-globals form values-list) (when (not (null result)) (format t "=> ~A~%" (%style-result (prin1-to-string result)))) @@ -184,8 +184,7 @@ inside strings for REPL input balancing." (force-output) (let ((buffer "")) (loop - (let ((line (handler-case (read-line *standard-input* nil nil) - (error () nil)))) + (let ((line (read-line *standard-input* nil nil))) (when (null line) (%save-repl-history-file) (format t "~%Goodbye.~%") diff --git a/packages/cli/src/handlers-utils.lisp b/packages/cli/src/handlers-utils.lisp index ff7c5f32..1076287b 100644 --- a/packages/cli/src/handlers-utils.lisp +++ b/packages/cli/src/handlers-utils.lisp @@ -197,10 +197,19 @@ Unreadable or absent fields return NIL rather than signaling." (position #\: location :from-end t :end last-colon)))) (cond ((and prev-colon last-colon) - (values (ignore-errors (parse-integer (subseq location (1+ prev-colon) last-colon))) - (ignore-errors (parse-integer (subseq location (1+ last-colon)))))) + (values (handler-case + (parse-integer (subseq location (1+ prev-colon) last-colon) + :junk-allowed nil) + (parse-error () nil)) + (handler-case + (parse-integer (subseq location (1+ last-colon)) + :junk-allowed nil) + (parse-error () nil)))) (last-colon - (values (ignore-errors (parse-integer (subseq location (1+ last-colon)))) + (values (handler-case + (parse-integer (subseq location (1+ last-colon)) + :junk-allowed nil) + (parse-error () nil)) nil)) (t (values nil nil)))))) @@ -236,8 +245,8 @@ around the execution. Returns the value produced by RUN-COMPILED." (t (handler-case (apply #'compile-string source :target :vm kwargs) - (error () - (apply #'cl-cc:compile-string-with-stdlib source :target :vm kwargs)))))) + (error () + (apply #'cl-cc:compile-string-with-stdlib source :target :vm kwargs)))))) ;;; ─── Watch mode + hot-reload (FR-808 / FR-916/917) ────────────────────────── ;;; @@ -263,27 +272,34 @@ Returns SOURCE." (defun %watch-recompile-and-run (file source vm-state) "Recompile SOURCE (language detected from FILE) and run it in VM-STATE. -Lisp sources use the auto-stdlib fallback; other languages compile directly." +Lisp sources use the standard-library-free compiler; other languages compile +directly." (let* ((language (%detect-language file "")) (result (if (member language '(:lisp :elisp)) (%compile-lisp-with-auto-stdlib source nil nil nil) (compile-string source :target :vm :language language)))) (run-compiled (compilation-result-program result) :state vm-state))) +(defun %watch-file-write-date (file) + ;; Atomic-save rename can briefly make FILE unavailable; keep the watcher alive. + (handler-case + (file-write-date file) + (file-error () nil))) + (defun %watch-file-poll (file vm-state &key (interval 0.3)) "Block, polling FILE's write-date; on each change recompile and re-run FILE in VM-STATE. Loops until interrupted with Ctrl-C, then returns NIL. Powers `cl-cc run FILE --watch`: edit-save-rerun without restarting the process, reusing one VM state so prior global definitions remain visible." - (let ((last-write (ignore-errors (file-write-date file)))) + (let ((last-write (%watch-file-write-date file))) (format *error-output* "~&; watching ~A — save to re-run, Ctrl-C to stop~%" (namestring file)) (force-output *error-output*) (handler-case (loop (sleep interval) - (let ((now (ignore-errors (file-write-date file)))) + (let ((now (%watch-file-write-date file))) (when (and now (not (eql now last-write))) (setf last-write now) (let ((source (%read-command-source file))) @@ -317,7 +333,7 @@ Accepts either a path to a .asd file or a system name for Quicklisp installation ((uiop:file-exists-p spec) (let* ((entry (%register-asd spec)) (order (%toposort-systems (list (getf entry :name))))) - (dolist (system order) (ignore-errors (asdf:load-system system))) + (dolist (system order) (asdf:load-system system)) (format t "Installed ~A from ~A~%" (getf entry :name) (getf entry :path)) (when (getf entry :depends-on) (format t "Dependencies: ~{~A~^, ~}~%" (getf entry :depends-on))))) diff --git a/packages/cli/src/main-dump.lisp b/packages/cli/src/main-dump.lisp index a92433e6..df5626ed 100644 --- a/packages/cli/src/main-dump.lisp +++ b/packages/cli/src/main-dump.lisp @@ -31,7 +31,7 @@ When --stdlib is also supplied, warm the stdlib cache first so the saved image starts with parsed/expanded stdlib forms and the VM snapshot already resident." (let ((path (flag parsed "--dump-image"))) (when (flag parsed "--stdlib") - (ignore-errors (cl-cc:warm-stdlib-cache))) + (cl-cc:warm-stdlib-cache)) (format *error-output* "; cl-cc: dumping initialized image to ~A~%" path) (finish-output *error-output*) (sb-ext:save-lisp-and-die path @@ -248,7 +248,8 @@ Returns T for plain coverage, :MCDC for MC/DC, NIL when unset." (memoize-macros nil) ;; FR-356: runtime GC heap tuning flags (stored as heap words) (gc-min-heap nil) - (gc-max-heap nil)) + (gc-max-heap nil) + (strict-no-alloc nil)) (defun %parse-compile-opts (parsed) "Extract all pipeline/tracing flags from PARSED into a compile-opts struct." @@ -301,12 +302,15 @@ Returns T for plain coverage, :MCDC for MC/DC, NIL when unset." :trace-macros (flag parsed "--trace-macros") :memoize-macros (flag parsed "--memoize-macros") :gc-min-heap (%parse-gc-heap-words (flag parsed "--gc-min-heap") "--gc-min-heap") - :gc-max-heap (%parse-gc-heap-words (flag parsed "--gc-max-heap") "--gc-max-heap"))) + :gc-max-heap (%parse-gc-heap-words (flag parsed "--gc-max-heap") "--gc-max-heap") + :strict-no-alloc (flag parsed "--strict-no-alloc"))) (defun %parse-gc-heap-words (spec flag-name) "Parse a GC heap byte count SPEC for FLAG-NAME into runtime heap words." (when spec - (let ((bytes (ignore-errors (parse-integer spec :junk-allowed nil)))) + (let ((bytes (handler-case + (parse-integer spec :junk-allowed nil) + (parse-error () nil)))) (unless (and (integerp bytes) (plusp bytes)) (format *error-output* "Invalid ~A: ~A (expected positive byte count)~%" flag-name spec) (%cli-exit 2)) @@ -316,14 +320,20 @@ Returns T for plain coverage, :MCDC for MC/DC, NIL when unset." "Parse an optimization level spec string (-O0/-O1/-O2/-O3 or 0/1/2/3). Returns an integer 0-3 or NIL." (when spec - (let ((level (ignore-errors (parse-integer spec)))) - (and level (<= 0 level 3) level)))) + (let ((level (handler-case + (parse-integer spec :junk-allowed nil) + (parse-error () nil)))) + (unless (and level (<= 0 level 3)) + (error "Invalid optimization level: ~A (expected 0, 1, 2, or 3)" spec)) + level))) (defun %parse-opt-bisect-limit (spec) "Parse --opt-bisect-limit / CL_CC_OPT_BISECT as a non-negative integer or NIL." (let ((text (and spec (string-trim '(#\Space #\Tab #\Newline #\Return) spec)))) (when (and text (plusp (length text))) - (let ((limit (ignore-errors (parse-integer text :junk-allowed nil)))) + (let ((limit (handler-case + (parse-integer text :junk-allowed nil) + (parse-error () nil)))) (unless (and (integerp limit) (<= 0 limit)) (format *error-output* "Invalid opt bisect limit: ~A (expected non-negative integer)~%" spec) (%cli-exit 2)) @@ -333,11 +343,9 @@ Returns an integer 0-3 or NIL." "Return a flat keyword plist for compile-string. STREAM is the resolved trace-json output stream (may be nil)." (labels ((safe-read-profile (path) - (when path - (handler-case - (with-open-file (in path :direction :input) - (read in nil nil)) - (error () nil)))) + (when (and path (probe-file path)) + (with-open-file (in path :direction :input) + (read in nil nil)))) (instruction-profile-alist-p (profile) (and (listp profile) (every (lambda (entry) @@ -398,6 +406,9 @@ STREAM is the resolved trace-json output stream (may be nil)." (if (compile-opts-coverage opts) (list :coverage (compile-opts-coverage opts)) nil) + (if (compile-opts-strict-no-alloc opts) + (list :strict-no-alloc t) + nil) (if (compile-opts-block-compile opts) (list :block-compile t) nil) diff --git a/packages/cli/src/main-utils.lisp b/packages/cli/src/main-utils.lisp index 16af64fc..fa4d2f09 100644 --- a/packages/cli/src/main-utils.lisp +++ b/packages/cli/src/main-utils.lisp @@ -117,6 +117,16 @@ Returns :lisp, :elisp, :php, or :javascript." (%quit-command-usage-error command (format nil "'~A' requires a file argument." command)))) +(defun %required-existing-file-arg (parsed command) + "Return a required positional path after checking it is a readable file." + (let* ((file (%required-file-arg parsed command)) + (pathname (probe-file file))) + (unless (and pathname + (uiop:file-exists-p pathname) + (pathname-name pathname)) + (error "~A: file does not exist: ~A" command file)) + file)) + (defun %read-command-source (file) "Read FILE or print a consistent CLI read error and exit with status 1." (handler-case (%strip-shebang-line (%read-file file)) @@ -348,8 +358,8 @@ Returns a parsed-args structure." ;;; FR-917: Reproducible build support stub (defun cl-cc-deterministic-build-p () "FR-917: Return T when building in reproducible/deterministic mode." - (let ((env (or (ignore-errors (uiop:getenv "CLCC_DETERMINISTIC")) - (ignore-errors (uiop:getenv "SOURCE_DATE_EPOCH"))))) + (let ((env (or (uiop:getenv "CLCC_DETERMINISTIC") + (uiop:getenv "SOURCE_DATE_EPOCH")))) (and env (not (member (string-downcase env) '("" "0" "false" "no") :test #'string=))))) (defun configure-reproducible-build (&key (epoch "0") (seed 0)) diff --git a/packages/cli/src/main.lisp b/packages/cli/src/main.lisp index 6cd337b5..01019a8b 100644 --- a/packages/cli/src/main.lisp +++ b/packages/cli/src/main.lisp @@ -33,24 +33,14 @@ Commands: compile-commands [path] Generate compile_commands.json install Register/compile a local ASDF system uninstall Remove a registered local system - fuzz [--seed N] Compiler fuzzing (FR-794) - reduce Test case reduction (FR-796) - audit Dependency vulnerability scan (FR-814) doc API documentation generation (FR-902) - doctest Run docstring code examples (FR-903) show-types Show inferred type signatures (FR-904) - assert-density Assertion density analysis (FR-905) abi-dump Dump ABI manifest (FR-777) abi-check Check ABI compatibility (FR-777) demangle Demangle C++ ABI symbol (FR-776) disasm [--wat] Disassemble Wasm via wabt tools (FR-322) inspect Inspect Wasm sections/disassembly (FR-322) - objdump Inspect binary internals (FR-808) - macrostep Step through macro expansion (FR-836) - bisect [range] Find regression commit (FR-809) - features List feature flags (FR-812) dep-graph [--format F] ASDF dependency graph via cl-dataflow-kit: dot|json|mermaid|topo (FR-361) - generate Build-time code generation (FR-815) update [pkg] Update dependencies (FR-813) completion Print a shell completion script (bash/zsh/fish/…) docs [format] Render reference docs (markdown|man|json) @@ -98,6 +88,8 @@ Options: --stats Print per-pass optimizer stats --trace-emit Print VM/OPT/ASM compilation stages --strict Treat type warnings as errors (check only) + --strict-no-alloc Treat no-allocation violations as compilation errors + --format Output format for dep-graph: dot, json, mermaid, topo --Werror Treat compiler warnings as errors --Werror-category Treat matching warning category/code as error --timeout Maximum execution time (default: 30 seconds) @@ -366,25 +358,14 @@ Examples: ("symbols" . %do-symbols) ("profile" . %do-profile) ("compile-commands" . %do-compile-commands) - ;; ── Phase 129-160: Advanced Compilation III commands ── - ("fuzz" . %do-fuzz) - ("reduce" . %do-reduce) - ("audit" . %do-audit) ("doc" . %do-doc) - ("doctest" . %do-doctest) ("show-types" . %do-show-types) - ("assert-density" . %do-assert-density) ("abi-dump" . %do-abi-dump) ("abi-check" . %do-abi-check) ("demangle" . %do-demangle) ("disasm" . %do-disasm) ("inspect" . %do-inspect) - ("objdump" . %do-objdump) - ("macrostep" . %do-macrostep) - ("bisect" . %do-bisect) - ("features" . %do-features) ("dep-graph" . %do-dep-graph) - ("generate" . %do-generate) ("update" . %do-update) ;; cl-cli-backed commands (handlers defined in cli-spec.lisp). ("completion" . %do-completion) diff --git a/packages/cli/src/tty.lisp b/packages/cli/src/tty.lisp index b49602eb..6b1fb97e 100644 --- a/packages/cli/src/tty.lisp +++ b/packages/cli/src/tty.lisp @@ -18,7 +18,7 @@ or NIL (never).") ((t) t) ((nil) nil) (t (and (null (uiop:getenv "NO_COLOR")) - (ignore-errors (interactive-stream-p stream)))))) + (interactive-stream-p stream))))) (defun %sgr (text &rest codes) "Wrap TEXT in a cl-tty-kit SGR sequence built from CODES, resetting after, diff --git a/packages/cli/tests/args-tests.lisp b/packages/cli/tests/args-tests.lisp index fb9058ee..2148fc76 100644 --- a/packages/cli/tests/args-tests.lisp +++ b/packages/cli/tests/args-tests.lisp @@ -103,6 +103,10 @@ (let ((p (cl-cc/cli:parse-args argv))) (expect (%flags p flag-key) :to-be-truthy)))) +(it-sequential "cli-args-bool-flags strict-no-alloc" + (let ((p (cl-cc/cli:parse-args '("compile" "f.lisp" "--strict-no-alloc")))) + (expect (%flags p "--strict-no-alloc") :to-be-truthy))) + (it-sequential "cli-args-bool-flags help" (destructuring-bind (argv flag-key) (list '("--help") "--help") (let ((p (cl-cc/cli:parse-args argv))) @@ -176,6 +180,10 @@ (let ((p (cl-cc/cli:parse-args '("eval" "(+ 1 2)" "--timeout" "7")))) (expect (%flags p "--timeout") :to-equal "7"))) +(it-sequential "cli-args-format-string-flag" + (let ((p (cl-cc/cli:parse-args '("dep-graph" "--format" "json")))) + (expect (%flags p "--format") :to-equal "json"))) + ;;; ───────────────────────────────────────────────────────────────────────── ;;; String flags — --key=value inline form ;;; ───────────────────────────────────────────────────────────────────────── diff --git a/packages/cli/tests/cli-tests.lisp b/packages/cli/tests/cli-tests.lisp index 5cbe8895..edbf0f3b 100644 --- a/packages/cli/tests/cli-tests.lisp +++ b/packages/cli/tests/cli-tests.lisp @@ -266,6 +266,112 @@ execute BODY, then delete the file. The file is written as UTF-8 text." (cl-cc/cli::dep-graph :output-format :dot)))) (expect (search "digraph" dot) :to-be-truthy)))) +(it-sequential "cli-advanced-command-registry-has-no-fake-success-routes" + (dolist (command '("fuzz" "reduce" "audit" "doctest" "assert-density" + "objdump" "macrostep" "bisect" "features" "generate")) + (expect (assoc command cl-cc/cli::*cli-command-dispatch* :test #'string=) + :to-be-null)) + (dolist (command '("fuzz" "reduce" "audit" "doctest" "assert-density" + "objdump" "macrostep" "bisect" "features" "generate")) + (signals cl-cc/cli:arg-parse-error + (cl-cc/cli:parse-args (list command)))) + (dolist (command '("doc" "show-types" "abi-dump" "abi-check" "demangle" + "disasm" "inspect" "dep-graph" "update")) + (expect (assoc command cl-cc/cli::*cli-command-dispatch* :test #'string=) + :to-be-truthy))) + +(it-sequential "cli-dep-graph-format-rejects-unknown-values" + (expect (cl-cc/cli::%parse-dep-graph-format "json") :to-be :json) + (expect (cl-cc/cli::%parse-dep-graph-format "topo") :to-be :topo) + (signals error (cl-cc/cli::%parse-dep-graph-format "yaml"))) + +(it-sequential "cli-dispatch-commands-reject-empty-input-or-have-explicit-valid-empty-form" + (let ((valid-without-arguments + '(("repl" . "interactive input") + ("selfhost" . "profile workload defaults") + ("symbols" . "workspace defaults") + ("compile-commands" . "current-directory defaults") + ("dep-graph" . "current-system defaults") + ("update" . "all packages"))) + (safe-without-arguments '("completion" "docs" "version"))) + (dolist (entry cl-cc/cli::*cli-command-dispatch*) + (let ((command (car entry))) + (cond + ((member command safe-without-arguments :test #'string=) + (let ((output + (with-output-to-string (stream) + (let ((*standard-output* stream) + (*error-output* stream)) + (funcall (cdr entry) + (cl-cc/cli:make-parsed-args :command command)))))) + (expect (plusp (length output)) :to-be-truthy))) + ((assoc command valid-without-arguments :test #'string=) + ;; These commands intentionally have a documented no-argument form; + ;; invoking them here would start REPL I/O or write generated files. + (expect (cdr (assoc command valid-without-arguments :test #'string=)) + :to-be-truthy)) + (t + (let* ((system (cl-boundary-kit:make-test-system-boundary)) + (outcome :returned) + (cl-cc/cli::*cli-boundaries* + (cl-boundary-kit:make-boundary-context :system system))) + (handler-case + (funcall (cdr entry) + (cl-cc/cli:make-parsed-args :command command)) + (error () (setf outcome :error))) + (expect (or (eq outcome :error) + (some #'plusp + (cl-boundary-kit:test-system-exit-codes system))) + :to-be-truthy)))))))) + +(it-sequential "cli-file-commands-reject-missing-input" + (let ((missing "/tmp/cl-cc-cli-missing-input-for-test.lisp") + (commands '("run" "compile" "check" "doc" "show-types" "disasm" + "inspect"))) + (dolist (command commands) + (let* ((entry (assoc command cl-cc/cli::*cli-command-dispatch* :test #'string=)) + (system (cl-boundary-kit:make-test-system-boundary)) + (outcome :returned) + (cl-cc/cli::*cli-boundaries* + (cl-boundary-kit:make-boundary-context :system system))) + (handler-case + (funcall (cdr entry) + (cl-cc/cli:make-parsed-args + :command command :positional (list missing))) + (error () (setf outcome :error))) + (expect (or (eq outcome :error) + (some #'plusp (cl-boundary-kit:test-system-exit-codes system))) + :to-be-truthy))) + (dolist (command '("abi-dump")) + (let* ((entry (assoc command cl-cc/cli::*cli-command-dispatch* + :test #'string=)) + (system (cl-boundary-kit:make-test-system-boundary)) + (outcome :returned) + (cl-cc/cli::*cli-boundaries* + (cl-boundary-kit:make-boundary-context :system system))) + (handler-case + (funcall (cdr entry) + (cl-cc/cli:make-parsed-args + :command command :positional nil)) + (error () (setf outcome :error))) + (expect (or (eq outcome :error) + (some #'plusp (cl-boundary-kit:test-system-exit-codes system))) + :to-be-truthy))) + (let* ((entry (assoc "abi-check" cl-cc/cli::*cli-command-dispatch* + :test #'string=)) + (system (cl-boundary-kit:make-test-system-boundary)) + (outcome :returned) + (cl-cc/cli::*cli-boundaries* + (cl-boundary-kit:make-boundary-context :system system))) + (handler-case + (funcall (cdr entry) + (cl-cc/cli:make-parsed-args + :command "abi-check" :positional (list missing missing))) + (error () (setf outcome :error))) + (expect (or (eq outcome :error) + (some #'plusp (cl-boundary-kit:test-system-exit-codes system))) + :to-be-truthy)))) + (it-sequential "cli-symbol-index-fuzzy-finds-definitions" (uiop:with-temporary-file (:pathname source :type "lisp" :keep t) (with-open-file (out source :direction :output :if-exists :supersede) diff --git a/packages/cli/tests/main-dump-tests.lisp b/packages/cli/tests/main-dump-tests.lisp index 9afb6c20..6f3935eb 100644 --- a/packages/cli/tests/main-dump-tests.lisp +++ b/packages/cli/tests/main-dump-tests.lisp @@ -154,6 +154,14 @@ :print-opt-remarks t :opt-remarks-mode :missed)))) +(it-sequential "cli-compile-opts-strict-no-alloc-reaches-kwargs" + (let* ((parsed (cl-cc/cli:parse-args + '("compile" "f.lisp" "--strict-no-alloc"))) + (opts (cl-cc/cli::%parse-compile-opts parsed)) + (kwargs (cl-cc/cli::%compile-opts-kwargs opts nil))) + (expect (cl-cc/cli::compile-opts-strict-no-alloc opts) :to-be-truthy) + (expect (getf kwargs :strict-no-alloc) :to-be-truthy))) + (it-sequential "cli-dump-ir-phase-invalid-signals-error" (handler-case (progn diff --git a/packages/cli/tests/main-tests.lisp b/packages/cli/tests/main-tests.lisp index da903936..577f34a1 100644 --- a/packages/cli/tests/main-tests.lisp +++ b/packages/cli/tests/main-tests.lisp @@ -331,6 +331,88 @@ (expect captured-language :to-equal :elisp) (expect run-called :to-equal :dummy))))) +(it-sequential "cli-default-eval-falls-back-to-stdlib" + (let ((plain-attempts 0) + (stdlib-attempts 0)) + (%with-cli-function-overrides + ((cl-cc:compile-string (lambda (&rest args) + (declare (ignore args)) + (incf plain-attempts) + (error "stdlib symbol is unresolved"))) + (cl-cc:compile-string-with-stdlib (lambda (&rest args) + (declare (ignore args)) + (incf stdlib-attempts) + (cl-cc/compile:make-compilation-result + :program :stdlib-program))) + (cl-cc/cli::%call-with-runtime-sanitizer-flags + (lambda (opts thunk &rest args) + (declare (ignore opts args)) + (funcall thunk))) + (cl-cc:run-compiled (lambda (program &rest args) + (declare (ignore args)) + (expect program :to-equal :stdlib-program) + 42))) + (expect (cl-cc/cli::%compile-and-run-eval-form + "(stdlib-symbol)" nil nil :lisp nil nil nil) + :to-equal 42) + (expect plain-attempts :to-equal 1) + (expect stdlib-attempts :to-equal 1)))) + +(it-sequential "cli-default-run-falls-back-to-stdlib" + (let ((plain-attempts 0) + (stdlib-attempts 0)) + (%with-cli-function-overrides + ((cl-cc:compile-string (lambda (&rest args) + (declare (ignore args)) + (incf plain-attempts) + (error "stdlib symbol is unresolved"))) + (cl-cc:compile-string-with-stdlib (lambda (&rest args) + (declare (ignore args)) + (incf stdlib-attempts) + :stdlib-result))) + (expect (cl-cc/cli::%compile-lisp-with-auto-stdlib + "(stdlib-symbol)" nil nil nil) + :to-equal :stdlib-result) + (expect plain-attempts :to-equal 1) + (expect stdlib-attempts :to-equal 1)))) + +(it-sequential "cli-default-repl-falls-back-to-stdlib" + (let ((form-attempts 0) + (stdlib-attempts 0)) + (%with-cli-function-overrides + ((uiop:command-line-arguments (lambda () '("repl"))) + (cl-cc:reset-repl-state (lambda () nil)) + (cl-cc:%ensure-repl-state (lambda () nil)) + (cl-cc/cli::%initialize-repl-completeness-globals (lambda () nil)) + (cl-cc/cli::%load-repl-history-file (lambda () nil)) + (cl-cc/cli::%save-repl-history-file (lambda () nil)) + (cl-cc/cli::%update-repl-completeness-globals + (lambda (&rest args) (declare (ignore args)) nil)) + (cl-cc:%repl-record-history + (lambda (&rest args) (declare (ignore args)) nil)) + (cl-cc:repl-edit-input-line (lambda (line) (values line nil nil))) + (cl-cc/vm:vm-values-list (lambda (&rest args) (declare (ignore args)) nil)) + (cl-cc:run-string-repl + (lambda (source &key language) + (declare (ignore language)) + (cond + ((eq source cl-cc:*standard-library-source*) + (incf stdlib-attempts) + nil) + ((zerop form-attempts) + (incf form-attempts) + (error "stdlib symbol is unresolved")) + (t + (incf form-attempts) + 42))))) + (let ((*standard-input* (make-string-input-stream + (format nil "(stdlib-symbol)~%"))) + (*standard-output* (make-string-output-stream)) + (*error-output* (make-string-output-stream))) + (expect (%with-captured-quit (cl-cc/cli:main)) :to-equal 0)) + (expect form-attempts :to-equal 2) + (expect stdlib-attempts :to-equal 1)))) + (it-sequential "cli-do-compile-dump-ir-forwards-elisp-language" (let ((captured-language :unset) (captured-source :unset))