test/test-args.sgl — sigil-args

1;;; Test suite for (sigil args)

3(import (sigil test)

4 (sigil args)

5 (sigil string))

7;; ============================================================

8;; Basic Option Parsing

9;; ============================================================

11(test-group "short flags"

12 (test "single short flag"

13 (let* ((cmd (command name: "test"

14 options: (list (option name: 'verbose short: #\v))))

15 (result (parse-args cmd '("-v"))))

16 (assert-equal #t (alist-get 'verbose (parse-result-opts result)))))

18 (test "multiple short flags combined"

19 (let* ((cmd (command name: "test"

20 options: (list (option name: 'verbose short: #\v)

21 (option name: 'force short: #\f))))

22 (result (parse-args cmd '("-vf"))))

23 (assert-equal #t (alist-get 'verbose (parse-result-opts result)))

24 (assert-equal #t (alist-get 'force (parse-result-opts result)))))

26 (test "repeated short flag counts"

27 (let* ((cmd (command name: "test"

28 options: (list (option name: 'verbose short: #\v))))

29 (result (parse-args cmd '("-vvv"))))

30 (assert-equal 3 (alist-get 'verbose (parse-result-opts result))))))

32(test-group "short options with values"

33 (test "short option with separate value"

34 (let* ((cmd (command name: "test"

35 options: (list (option name: 'output short: #\o value: "FILE"))))

36 (result (parse-args cmd '("-o" "out.txt"))))

37 (assert-equal "out.txt" (alist-get 'output (parse-result-opts result)))))

39 (test "short option with attached value"

40 (let* ((cmd (command name: "test"

41 options: (list (option name: 'output short: #\o value: "FILE"))))

42 (result (parse-args cmd '("-oout.txt"))))

43 (assert-equal "out.txt" (alist-get 'output (parse-result-opts result))))))

45(test-group "long flags"

46 (test "single long flag"

47 (let* ((cmd (command name: "test"

48 options: (list (option name: 'verbose long: "verbose"))))

49 (result (parse-args cmd '("--verbose"))))

50 (assert-equal #t (alist-get 'verbose (parse-result-opts result))))))

52(test-group "long options with values"

53 (test "long option with separate value"

54 (let* ((cmd (command name: "test"

55 options: (list (option name: 'output long: "output" value: "FILE"))))

56 (result (parse-args cmd '("--output" "out.txt"))))

57 (assert-equal "out.txt" (alist-get 'output (parse-result-opts result)))))

59 (test "long option with equals"

60 (let* ((cmd (command name: "test"

61 options: (list (option name: 'output long: "output" value: "FILE"))))

62 (result (parse-args cmd '("--output=out.txt"))))

63 (assert-equal "out.txt" (alist-get 'output (parse-result-opts result))))))

65;; ============================================================

66;; Defaults and Required

67;; ============================================================

69(test-group "defaults"

70 (test "option with default"

71 (let* ((cmd (command name: "test"

72 options: (list (option name: 'output long: "output"

73 value: "FILE" default: "default.txt"))))

74 (result (parse-args cmd '())))

75 (assert-equal "default.txt" (alist-get 'output (parse-result-opts result)))))

77 (test "default overridden by argument"

78 (let* ((cmd (command name: "test"

79 options: (list (option name: 'output long: "output"

80 value: "FILE" default: "default.txt"))))

81 (result (parse-args cmd '("--output" "custom.txt"))))

82 (assert-equal "custom.txt" (alist-get 'output (parse-result-opts result))))))

84(test-group "required options"

85 (test "missing required option"

86 (let* ((cmd (command name: "test"

87 options: (list (option name: 'token long: "token"

88 value: "TOKEN" required: #t))))

89 (result (parse-args cmd '())))

90 (assert-false (null? (parse-result-errors result)))))

92 (test "required option provided"

93 (let* ((cmd (command name: "test"

94 options: (list (option name: 'token long: "token"

95 value: "TOKEN" required: #t))))

96 (result (parse-args cmd '("--token" "abc123"))))

97 (assert-null (parse-result-errors result))

98 (assert-equal "abc123" (alist-get 'token (parse-result-opts result))))))

100;; ============================================================

101;; Value Parsing

102;; ============================================================

103

104(test-group "value parser"

105 (test "numeric parser"

106 (let* ((cmd (command name: "test"

107 options: (list (option name: 'count long: "count"

108 value: "N" parse: string->number))))

109 (result (parse-args cmd '("--count" "42"))))

110 (assert-equal 42 (alist-get 'count (parse-result-opts result))))))

111

112;; ============================================================

113;; Positional Arguments

114;; ============================================================

115

116(test-group "positional arguments"

117 (test "args after options"

118 (let* ((cmd (command name: "test"

119 options: (list (option name: 'verbose short: #\v))))

120 (result (parse-args cmd '("-v" "file1.txt" "file2.txt"))))

121 (assert-equal '("file1.txt" "file2.txt") (parse-result-args result))))

122

123 (test "double dash stops parsing"

124 (let* ((cmd (command name: "test"

125 options: (list (option name: 'verbose short: #\v))))

126 (result (parse-args cmd '("--" "-v" "--help"))))

127 (assert-false (alist-get 'verbose (parse-result-opts result)))

128 (assert-equal '("-v" "--help") (parse-result-args result))))

129

130 (test "passthrough command preserves the separator boundary"

131 (let* ((cmd (command name: "runner" passthrough: #t))

132 (result (parse-args cmd '("app" "--" "-q" "--verbose"))))

133 (assert-equal '("app") (parse-result-args result))

134 (assert-equal '("-q" "--verbose")

135 (parse-result-passthrough result))))

136

137 (test "passthrough distinguishes absent and empty tails"

138 (let ((cmd (command name: "runner" passthrough: #t)))

139 (assert-false (parse-result-passthrough (parse-args cmd '("app"))))

140 (assert-equal '()

141 (parse-result-passthrough (parse-args cmd '("app" "--"))))))

142

143 (test "passthrough tail does not select a subcommand"

144 (let* ((child (command name: "child"))

145 (cmd (command name: "runner" passthrough: #t

146 subcommands: (list child)))

147 (result (parse-args cmd '("--" "child" "--" "again"))))

148 (assert-false (parse-result-subcommand result))

149 (assert-null (parse-result-args result))

150 (assert-equal '("child" "--" "again")

151 (parse-result-passthrough result)))))

152

153;; ============================================================

154;; Subcommands

155;; ============================================================

156

157(test-group "subcommands"

158 (test "subcommand matched"

159 (let* ((sub (command name: "build"

160 options: (list (option name: 'config short: #\c value: "NAME"))))

161 (cmd (command name: "test" subcommands: (list sub)))

162 (result (parse-args cmd '("build" "-c" "release"))))

163 (assert-true (parse-result-subcommand result))

164 (assert-equal "release" (alist-get 'config (parse-result-opts result)))))

165

166 (test "unknown subcommand is positional"

167 (let* ((sub (command name: "build"))

168 (cmd (command name: "test" subcommands: (list sub)))

169 (result (parse-args cmd '("unknown"))))

170 (assert-false (parse-result-subcommand result))

171 (assert-equal '("unknown") (parse-result-args result)))))

172

173;; ============================================================

174;; Negatable Flags

175;; ============================================================

176

177(test-group "negatable flags"

178 (test "positive form"

179 (let* ((cmd (command name: "test"

180 options: (list (option name: 'color long: "color" negatable: #t))))

181 (result (parse-args cmd '("--color"))))

182 (assert-equal #t (alist-get 'color (parse-result-opts result)))))

183

184 (test "negative form"

185 (let* ((cmd (command name: "test"

186 options: (list (option name: 'color long: "color" negatable: #t))))

187 (result (parse-args cmd '("--no-color"))))

188 (assert-equal #f (alist-get 'color (parse-result-opts result)))))

189

190 (test "non-negatable flag rejects --no-"

191 (let* ((cmd (command name: "test"

192 options: (list (option name: 'verbose long: "verbose"))))

193 (result (parse-args cmd '("--no-verbose"))))

194 (assert-false (null? (parse-result-errors result))))))

195

196;; ============================================================

197;; Multi-Value Options

198;; ============================================================

199

200(test-group "multi-value options"

201 (test "repeated option accumulates"

202 (let* ((cmd (command name: "test"

203 options: (list (option name: 'include short: #\I

204 long: "include" value: "PATH" multi: #t))))

205 (result (parse-args cmd '("-I" "foo" "--include" "bar" "-Ibaz"))))

206 (assert-equal '("foo" "bar" "baz")

207 (alist-get 'include (parse-result-opts result))))))

208

209;; ============================================================

210;; Choice Validation

211;; ============================================================

212

213(test-group "choice validation"

214 (test "valid choice accepted"

215 (let* ((cmd (command name: "test"

216 options: (list (option name: 'level long: "level" value: "LEVEL"

217 choices: '("debug" "info" "warn")))))

218 (result (parse-args cmd '("--level" "info"))))

219 (assert-null (parse-result-errors result))

220 (assert-equal "info" (alist-get 'level (parse-result-opts result)))))

221

222 (test "invalid choice rejected"

223 (let* ((cmd (command name: "test"

224 options: (list (option name: 'level long: "level" value: "LEVEL"

225 choices: '("debug" "info" "warn")))))

226 (result (parse-args cmd '("--level" "trace"))))

227 (assert-false (null? (parse-result-errors result))))))

228

229;; ============================================================

230;; Error Handling

231;; ============================================================

232

233(test-group "error handling"

234 (test "unknown short option"

235 (let* ((cmd (command name: "test" options: '()))

236 (result (parse-args cmd '("-x"))))

237 (assert-false (null? (parse-result-errors result)))))

238

239 (test "unknown long option"

240 (let* ((cmd (command name: "test" options: '()))

241 (result (parse-args cmd '("--unknown"))))

242 (assert-false (null? (parse-result-errors result)))))

243

244 (test "missing value for short option"

245 (let* ((cmd (command name: "test"

246 options: (list (option name: 'output short: #\o value: "FILE"))))

247 (result (parse-args cmd '("-o"))))

248 (assert-false (null? (parse-result-errors result)))))

249

250 (test "missing value for long option"

251 (let* ((cmd (command name: "test"

252 options: (list (option name: 'output long: "output" value: "FILE"))))

253 (result (parse-args cmd '("--output"))))

254 (assert-false (null? (parse-result-errors result))))))

255

256;; ============================================================

257;; Help Generation

258;; ============================================================

259

260(test-group "help generation"

261 (test "help includes command name"

262 (let* ((cmd (command name: "my-tool" description: "A great tool"))

263 (help (generate-help cmd)))

264 (assert-true (string-find help "my-tool"))))

265

266 (test "help includes description"

267 (let* ((cmd (command name: "my-tool" description: "A great tool"))

268 (help (generate-help cmd)))

269 (assert-true (string-find help "A great tool"))))

270

271 (test "help includes options"

272 (let* ((cmd (command name: "test"

273 options: (list (option name: 'verbose short: #\v long: "verbose"

274 description: "Enable verbose output"))))

275 (help (generate-help cmd)))

276 (assert-true (string-find help "-v"))

277 (assert-true (string-find help "--verbose"))))

278

279 (test "help shows negatable syntax"

280 (let* ((cmd (command name: "test"

281 options: (list (option name: 'color long: "color" negatable: #t))))

282 (help (generate-help cmd)))

283 (assert-true (string-find help "--[no-]color"))))

284

285 (test "help shows choices"

286 (let* ((cmd (command name: "test"

287 options: (list (option name: 'level long: "level" value: "L"

288 choices: '("a" "b" "c")))))

289 (help (generate-help cmd)))

290 (assert-true (string-find help "[a|b|c]")))))

291

292(test "help shows passthrough argv"

293 (let ((help (generate-help (command name: "run" passthrough: #t))))

294 (assert-true (string-find help "[-- args...]"))))

295

296(test "nested subcommands preserve the deepest matched command"

297 (let* ((run (command name: "run" passthrough: #t))

298 (project (command name: "project" subcommands: (list run)))

299 (root (command name: "sigil" subcommands: (list project)))

300 (result (parse-args root '("project" "run" "build" "--" "-v"))))

301 (assert-null (parse-result-errors result))

302 (assert-equal "run" (command-name (parse-result-subcommand result)))

303 (assert-equal '("build") (parse-result-args result))

304 (assert-equal '("-v") (parse-result-passthrough result))))

305

306(test-group "bare dash is a positional argument"

307 ;; A lone "-" used to be silently dropped by the short-option parser, so

308 ;; `tool -` parsed identically to `tool` — help and exit 0 instead of an

309 ;; honest result (sigil exit-contract audit, 2026-07-31).

310 (test "lone dash survives as a positional"

311 (let* ((cmd (command name: "test"

312 options: (list (option name: 'verbose short: #\v))))

313 (result (parse-args cmd '("-"))))

314 (assert-null (parse-result-errors result))

315 (assert-equal '("-") (parse-result-args result))))

316

317 (test "dash mixes with other positionals in order"

318 (let* ((cmd (command name: "test"))

319 (result (parse-args cmd '("a" "-" "b"))))

320 (assert-null (parse-result-errors result))

321 (assert-equal '("a" "-" "b") (parse-result-args result))))

322

323 (test "dash does not swallow a following flag"

324 (let* ((cmd (command name: "test"

325 options: (list (option name: 'verbose short: #\v))))

326 (result (parse-args cmd '("-" "-v"))))

327 (assert-null (parse-result-errors result))

328 (assert-equal '("-") (parse-result-args result))

329 (assert-equal #t (alist-get 'verbose (parse-result-opts result)))))

330

331 ;; Control: the change must not have loosened real short options.

332 (test "unknown short option still errors"

333 (let* ((cmd (command name: "test"

334 options: (list (option name: 'verbose short: #\v))))

335 (result (parse-args cmd '("-Z"))))

336 (assert-true (pair? (parse-result-errors result))))))

337

338(test-group "unmatched word under a handler-less subcommand"

339 ;; run-command now turns this shape into an error + exit 1 (it used to

340 ;; print help and exit 0: `sigil channel not-a-real-sub` reported

341 ;; success on every backend). run-command itself calls exit, so what is

342 ;; unit-testable in-process is the parse shape it dispatches on: the

343 ;; matched handler-less subcommand with a leftover positional word.

344 (test "leftover word lands in args of the matched subcommand"

345 (let* ((pub (command name: "publish"))

346 (chan (command name: "channel" subcommands: (list pub)))

347 (root (command name: "sigil" subcommands: (list chan)))

348 (result (parse-args root '("channel" "not-a-real-sub"))))

349 (assert-null (parse-result-errors result))

350 (assert-equal "channel" (command-name (parse-result-subcommand result)))

351 (assert-equal '("not-a-real-sub") (parse-result-args result)))))

352

353(run-tests)