scripts/probe-exec-cwd.sgl

1;;; Probe for process-exec's `cwd:` argument (t-b07e5f).

2;;;

3;;; Prints one line per observable fact. Run under `sigil test <file>`.

4;;; The no-cwd arm is the POSITIVE CONTROL: it proves the probe can see a

5;;; working directory at all, so a wrong answer from the cwd arm cannot

6;;; be blamed on the probe.

7(import (sigil io) (sigil string) (sigil process)

8 (sigil system grant) (sigil system process))

10(define ROOT (getenv "EXEC_CWD_PROBE_ROOT"))

11(define INNER (string-append ROOT "/inner"))

13(define g (make-grants principal: "exec-cwd-probe"))

14(grant-add! g (string-append "fs:rw:" ROOT))

15(grant-add! g "exec:full")

17(define (trimmed s)

18 (let loop ((i (string-length s)))

19 (cond ((= i 0) "")

20 ((char=? (string-ref s (- i 1)) #\newline) (loop (- i 1)))

21 (else (substring s 0 i)))))

23(define (run label thunk)

24 (println "~a ~s" label

25 (guard (e (#t (list 'RAISED (error-object-message e))))

26 (trimmed (dict-ref (thunk) stdout: "")))))

28;; POSITIVE CONTROL FIRST: without cwd:, pwd must report the process's

29;; own directory. If this is not a real path the probe is broken and

30;; nothing below it means anything.

31(run "CONTROL-no-cwd" (lambda () (process-exec g (list "pwd"))))

33;; THE ARM UNDER TEST. "stopped raising" is NOT the bar: a function that

34;; silently ignores cwd: also stops raising, and that is the original

35;; defect wearing a quieter coat. The bar is that pwd reports INNER.

36(run "ARM-with-cwd" (lambda () (process-exec g (list "pwd") cwd: INNER)))

37(println "EXPECTED-cwd ~s" INNER)

39;; The caller's own directory must be UNCHANGED afterwards: the fix

40;; scopes a process-global mutation, so a leak of that mutation would be

41;; a new bug in place of the old one.

42(run "AFTER-no-cwd" (lambda () (process-exec g (list "pwd"))))