diff --git a/devel/0075.md b/devel/0075.md index 1891b7cc..ae762292 100644 --- a/devel/0075.md +++ b/devel/0075.md @@ -31,6 +31,10 @@ bin/gf fix -e sld /path/to/dir # 逗号分隔同时指定多个后缀名 bin/gf fmt -e scm,sld /path/to/dir bin/gf fix -e scm,sld /path/to/dir + +# 结合 --changed-since 使用 +bin/gf fmt -e scm,sld --changed-since=main +bin/gf fix -e scm,sld --changed-since=main ``` ## 4. 如何提交 @@ -58,3 +62,23 @@ bin/gf test --changed-since=main 3. 添加 `file-extension-match?` 辅助函数判断文件是否匹配任一扩展名 4. 将 `format-directory`、`fix-directory` 和 `format-changed-since` 中的硬编码 `".scm"` 替换为扩展名列表 5. 修改 `changed-scheme-files-since`，增加可选的扩展名列表参数（保持向后兼容） + +## 6. 2026-05-31 修复与补充 + +### 6.1 What +1. **修复 fmt 工具 bug**：`bin/gf fmt -e scm,sld --changed-since=main` 运行时报错 `string=? first argument is a pair` + - 根因：`format-changed-since` 在无 scope 时调用 `(changed-scheme-files-since since extensions)`，导致 `changed-scheme-files-since` 将 extensions 列表误判为 path + - 修复：`goldfmt.scm` 中改为 `(changed-scheme-files-since since #f extensions)`，使 `changed-scheme-files-since` 正确识别 extensions 参数 +2. **为 fix 工具添加 `--changed-since` 支持** + - 在 `goldfix.scm` 中添加 `--changed-since` 参数解析 + - 新增 `fix-changed-since` 函数，行为与 `format-changed-since` 一致 + - 新增 `fix-file-list` 辅助函数处理文件列表 +3. **补充单元测试**：在 `changed-files-since-test.scm` 中增加 `changed-scheme-files-since` 传入 `#f` 和自定义 extensions 的测试用例 + +### 6.2 Why +- `--changed-since` 与 `-e` 组合使用时，由于 `changed-scheme-files-since` 的可选参数设计（通过 `. maybe-path` 模拟），单参数调用存在歧义 +- fix 工具作为 fmt 的配套工具，应当具备同等的变更文件处理能力 + +### 6.3 How +- `changed-scheme-files-since` 的签名保持不变，调用方在有 extensions 但无 path 时显式传入 `#f` 作为 path 占位符 +- `goldfix.scm` 参照 `goldfmt.scm` 的实现模式，添加 `*load-path*` 设置以导入 `(liii goldtool-changed)` diff --git a/tools/common/tests/liii/goldtool-changed/changed-files-since-test.scm b/tools/common/tests/liii/goldtool-changed/changed-files-since-test.scm index 03a766d6..bd31f5a9 100644 --- a/tools/common/tests/liii/goldtool-changed/changed-files-since-test.scm +++ b/tools/common/tests/liii/goldtool-changed/changed-files-since-test.scm @@ -53,6 +53,7 @@ ) ;define (define original-cwd (getcwd)) + (define repo-dir (path->string (path-join (path-temp-dir) (string-append "goldtool-changed-test-" (number->string (getpid))) @@ -92,6 +93,30 @@ ) ;let (check (changed-scheme-files-since "HEAD" "sub") => '("sub/c.scm")) + + ;; 测试传入 #f 和自定义 extensions + (let ((files (changed-scheme-files-since "HEAD" #f '(".scm")))) + (check (contains? "a.scm" files) => #t) + (check (contains? "b.txt" files) => #f) + (check (contains? "sub/c.scm" files) => #t) + ) ;let + + ;; 创建 .sld 文件并测试只匹配 .sld + (path-write-text (path "d.sld") "(define-library (d))\n") + (must "git add d.sld") + (must "git commit -q -m 'add d.sld'") + (path-write-text (path "d.sld") "(define-library (d2))\n") + + (let ((files (changed-scheme-files-since "HEAD" #f '(".sld")))) + (check (contains? "d.sld" files) => #t) + (check (contains? "a.scm" files) => #f) + ) ;let + + (let ((files (changed-scheme-files-since "HEAD" #f '(".scm" ".sld")))) + (check (contains? "a.scm" files) => #t) + (check (contains? "d.sld" files) => #t) + (check (contains? "b.txt" files) => #f) + ) ;let ) ;lambda (lambda () (chdir original-cwd) (remove-tree repo-dir)) ) ;dynamic-wind diff --git a/tools/fix/liii/goldfix.scm b/tools/fix/liii/goldfix.scm index a0a311ce..4ca60b0a 100644 --- a/tools/fix/liii/goldfix.scm +++ b/tools/fix/liii/goldfix.scm @@ -1,3 +1,24 @@ +(define (%goldfix-common-dirname path-str) + (let loop + ((i (- (string-length path-str) 1))) + (cond ((< i 0) ".") + ((or (char=? (string-ref path-str i) #\/) (char=? (string-ref path-str i) #\\)) + (if (= i 0) "." (substring path-str 0 i)) + ) ; + (else (loop (- i 1))) + ) ;cond + ) ;let +) ;define + +(set! *load-path* + (append (list "../common" "tools/common") + (map (lambda (root) (string-append (%goldfix-common-dirname root) "/common")) + *load-path* + ) ;map + *load-path* + ) ;append +) ;set! + (define-library (liii goldfix) (export main fix-string repair-parentheses parentheses-balanced?) (import (liii base) @@ -10,6 +31,7 @@ (srfi srfi-13) (liii goldfix-repair) (liii goldfix-record) + (liii goldtool-changed) ) ;import (begin @@ -55,7 +77,10 @@ (newline) (display " --dry-run 预览模式（仅支持单个文件）") (newline) - (display " -e, --extension EXT 指定文件后缀名（默认 scm，支持逗号分隔多个）") + (display " -e, --extension EXT 指定文件后缀名（默认 scm，支持逗号分隔多个）" + ) ;display + (newline) + (display " --changed-since REV 仅修正自 REV 以来变更的文件") (newline) (newline) (display "Arguments:") @@ -73,6 +98,8 @@ (newline) (display " gf fix --dry-run file.scm 预览修正结果") (newline) + (display " gf fix --changed-since=HEAD 修正自 HEAD 以来变更的文件") + (newline) (display " gf fix /path/to/dir 递归修正目录下所有 .scm 文件" ) ;display (newline) @@ -152,18 +179,87 @@ (fix-file-core path-str use-cache?) ) ;define* + (define (fix-file-list files dry-run) + (let loop + ((remaining files) (total 0) (updated 0) (cached 0)) + (if (null? remaining) + (values total updated cached) + (let ((file (car remaining))) + (if dry-run + (begin + (display (string-append "Fixing: " file)) + (newline) + (fix-file-dry-run file) + (loop (cdr remaining) (+ total 1) updated cached) + ) ;begin + (let ((result (fix-file file))) + (cond ((eq? result 'cached) (loop (cdr remaining) (+ total 1) updated (+ cached 1))) + (result (display (string-append " Updated: " file)) + (newline) + (loop (cdr remaining) (+ total 1) (+ updated 1) cached) + ) ;result + (else (display (string-append "Fixing: " file)) + (newline) + (loop (cdr remaining) (+ total 1) updated cached) + ) ;else + ) ;cond + ) ;let + ) ;if + ) ;let + ) ;if + ) ;let + ) ;define + (define (file-extension-match? filename extensions) - (let loop ((exts extensions)) + (let loop + ((exts extensions)) (if (null? exts) #f - (if (string-suffix? (car exts) filename) - #t - (loop (cdr exts)) - ) ;if + (if (string-suffix? (car exts) filename) #t (loop (cdr exts))) ) ;if ) ;let ) ;define + (define (fix-changed-since since path-str dry-run extensions) + (let ((scope (if (string=? path-str "") #f path-str))) + (cond ((and scope (not (or (path-file? (path scope)) (path-dir? (path scope))))) + (display (string-append "错误: 路径不存在 - " scope)) + (newline) + (exit 1) + ) ; + (else (let ((files (if scope + (changed-scheme-files-since since scope extensions) + (changed-scheme-files-since since #f extensions) + ) ;if + ) ;files + ) ; + (if (null? files) + (begin + (display (string-append "No changed Scheme files since " since)) + (newline) + #t + ) ;begin + (call-with-values (lambda () (fix-file-list files dry-run)) + (lambda (total updated cached) + (display (string-append "Total files fixed: " + (number->string total) + ", Files updated: " + (number->string updated) + ", Files cached: " + (number->string cached) + ) ;string-append + ) ;display + (newline) + #t + ) ;lambda + ) ;call-with-values + ) ;if + ) ;let + ) ;else + ) ;cond + ) ;let + ) ;define + (define (fix-directory dir-path extensions) (let ((fmt-cmd (string-append (executable) " fmt " dir-path))) (os-call fmt-cmd) @@ -178,14 +274,15 @@ (let ((entry-str (path->string entry))) (if (file-extension-match? entry-str extensions) (let ((result (fix-file-core entry-str))) - (cond ((eq? result 'cached) - (loop (+ i 1) (+ total 1) updated (+ cached 1))) + (cond ((eq? result 'cached) (loop (+ i 1) (+ total 1) updated (+ cached 1))) (result (display (string-append " Updated: " entry-str)) (newline) - (loop (+ i 1) (+ total 1) (+ updated 1) cached)) + (loop (+ i 1) (+ total 1) (+ updated 1) cached) + ) ;result (else (display (string-append "Fixing: " entry-str)) (newline) - (loop (+ i 1) (+ total 1) updated cached)) + (loop (+ i 1) (+ total 1) updated cached) + ) ;else ) ;cond ) ;let (loop (+ i 1) total updated cached) @@ -223,10 +320,13 @@ (short . "h") (action . store-true))) (parser :add-argument '((name . "dry-run") (action . store-true))) - (parser :add-argument '((name . "extension") - (short . "e") - (type . string) - (default . "scm"))) + (parser :add-argument + '((name . "extension") + (short . "e") + (type . string) + (default . "scm")) + ) ;parser + (parser :add-argument '((name . "changed-since") (type . string))) parser ) ;let ) ;define @@ -238,10 +338,10 @@ ) ;define (define (normalize-extension ext) - (if (and (> (string-length ext) 0) - (char=? (string-ref ext 0) #\.)) + (if (and (> (string-length ext) 0) (char=? (string-ref ext 0) #\.)) ext - (string-append "." ext)) + (string-append "." ext) + ) ;if ) ;define (define (parse-extensions raw) @@ -254,9 +354,12 @@ (let* ((help-flag (parser 'help)) (dry-run (parser 'dry-run)) (extensions (parse-extensions (parser 'extension))) + (changed-since (parser 'changed-since)) (path-str (first-positional parser)) ) ; - (cond ((or help-flag (string=? path-str "")) (display-help) #t) + (cond (help-flag (display-help) #t) + (changed-since (fix-changed-since changed-since path-str dry-run extensions)) + ((string=? path-str "") (display-help) #t) ((path-file? (path path-str)) (if dry-run (fix-file-dry-run path-str) @@ -304,7 +407,7 @@ (exit 1) ) ;else ) ;cond - ) ;let + ) ;let* ) ;let ) ;define ) ;begin diff --git a/tools/fmt/liii/goldfmt.scm b/tools/fmt/liii/goldfmt.scm index 36a41b43..05c10f9e 100644 --- a/tools/fmt/liii/goldfmt.scm +++ b/tools/fmt/liii/goldfmt.scm @@ -95,7 +95,8 @@ (display " --dry-run 预览模式（不写回文件；目录路径不支持）" ) ;display (newline) - (display " -e, --extension EXT 指定文件后缀名（默认 scm，支持逗号分隔多个）") + (display " -e, --extension EXT 指定文件后缀名（默认 scm，支持逗号分隔多个）" + ) ;display (newline) (display " --changed-since REV 仅格式化自 REV 以来变更的文件" ) ;display @@ -185,9 +186,7 @@ (loop (cdr remaining) (+ total 1) updated cached) ) ;begin (let ((result (format-file file))) - (cond ((eq? result 'cached) - (loop (cdr remaining) (+ total 1) updated (+ cached 1)) - ) ; + (cond ((eq? result 'cached) (loop (cdr remaining) (+ total 1) updated (+ cached 1))) (result (display (string-append " Updated: " file)) (newline) (loop (cdr remaining) (+ total 1) (+ updated 1) cached) @@ -205,13 +204,11 @@ ) ;define (define (file-extension-match? filename extensions) - (let loop ((exts extensions)) + (let loop + ((exts extensions)) (if (null? exts) #f - (if (string-suffix? (car exts) filename) - #t - (loop (cdr exts)) - ) ;if + (if (string-suffix? (car exts) filename) #t (loop (cdr exts))) ) ;if ) ;let ) ;define @@ -225,7 +222,7 @@ ) ; (else (let ((files (if scope (changed-scheme-files-since since scope extensions) - (changed-scheme-files-since since extensions) + (changed-scheme-files-since since #f extensions) ) ;if ) ;files ) ; @@ -269,9 +266,7 @@ (let ((entry-str (path->string entry))) (if (file-extension-match? entry-str extensions) (let ((result (format-file entry-str))) - (cond ((eq? result 'cached) - (loop (+ i 1) (+ total 1) updated (+ cached 1)) - ) ; + (cond ((eq? result 'cached) (loop (+ i 1) (+ total 1) updated (+ cached 1))) (result (display (string-append " Updated: " entry-str)) (newline) (loop (+ i 1) (+ total 1) (+ updated 1) cached) @@ -317,10 +312,12 @@ (short . "h") (action . store-true))) (parser :add-argument '((name . "dry-run") (action . store-true))) - (parser :add-argument '((name . "extension") - (short . "e") - (type . string) - (default . "scm"))) + (parser :add-argument + '((name . "extension") + (short . "e") + (type . string) + (default . "scm")) + ) ;parser (parser :add-argument '((name . "changed-since") (type . string))) parser ) ;let @@ -333,10 +330,10 @@ ) ;define (define (normalize-extension ext) - (if (and (> (string-length ext) 0) - (char=? (string-ref ext 0) #\.)) + (if (and (> (string-length ext) 0) (char=? (string-ref ext 0) #\.)) ext - (string-append "." ext)) + (string-append "." ext) + ) ;if ) ;define (define (parse-extensions raw) @@ -403,7 +400,7 @@ (exit 1) ) ;else ) ;cond - ) ;let + ) ;let* ) ;let ) ;define ) ;begin