test/f2a-witness-probe.sgl

1;;; F2a no-execution witness probe.

2;;;

3;;; Inspects `test/fixtures/f2a-witness.sgd`, whose author code TRIPS OBSERVABLE

4;;; TRIPWIRES WHEN IT RUNS, and imports nothing but the passive inspector. If

5;;; inspection evaluates an author expression, calls an author-defined command,

6;;; or evaluates a field's argument syntax, the fixture's markers appear on this

7;;; process's stdout and its sentinel files appear in $F2A_WITNESS_DIR.

8;;;

9;;; THE GATE ARM RUNS THIS TOGETHER WITH A POSITIVE CONTROL that evaluates the

10;;; SAME manuscript through the real `#lang` path and REQUIRES every tripwire to

11;;; fire. That ordering is not politeness: the healthy answer here is empty on

12;;; every channel at once, and an all-empty result from four broken channels

13;;; looks exactly like an all-empty result from four working ones.

14;;;

15;;; AND IT REPORTS THAT IT REACHED THE DANGEROUS CODE PATH. A witness that

16;;; observed no execution because it never extracted a field would be a control

17;;; too small to fail. The `ARGUMENT-FIELD` line below is the proof that the

18;;; per-field extraction -- the one thing this phase adds that could newly

19;;; execute author code -- actually ran on an argument that is an expression,

20;;; and read it as DATA.

21(import (sigil core) (sigil fs) (sigil language) (folio doc inspect))

23(define path

24 (let ((v (getenv "F2A_WITNESS_FIXTURE")))

25 (if (and v (> (string-length v) 0)) v "test/fixtures/f2a-witness.sgd")))

27(define source (read-file-string path))

28(define descriptor

29 (inspect-folio-source

30 source path (string-append "sha256:" (make-string 64 #\0))

31 (let ((header (inspect-language-source source path)))

32 (and (language-header? header) (language-header-end header)))))

34(define nodes 0)

35(define commands 0)

36(define expressions 0)

37(define fields 0)

38(define argument-field-head 'NONE)

39(define argument-field-length -1)

41(let walk ((pending (descriptor-nodes descriptor)))

42 (if (pair? pending)

43 (let ((n (car pending)))

44 (set! nodes (+ nodes 1))

45 (cond ((eq? (inspected-node-kind n) 'command) (set! commands (+ commands 1)))

46 ((eq? (inspected-node-kind n) 'expr) (set! expressions (+ expressions 1))))

47 (for-each

48 (lambda (f)

49 (set! fields (+ fields 1))

50 ;; The field whose VALUE IS AN EXPRESSION. Recording its datum here

51 ;; is what demonstrates the extraction path ran without evaluating.

52 (if (and (eq? (inspected-node-name n) 'argument-tripwire-command)

53 (eq? (field-name f) 'status))

54 (let ((v (field-value f)))

55 ;; THE VALUE ITSELF IS NEVER PRINTED, AND THAT IS NOT TIDINESS.

56 ;; This field's datum CONTAINS the fixture's own stdout marker

57 ;; as a string literal, so writing it here would put

58 ;; "F2A-WITNESS-ARG-RAN" on this process's stdout -- and the

59 ;; gate's detector greps this very stream for exactly that.

60 ;; The probe would have impersonated the execution it exists

61 ;; to detect, and the arm would have gone red on a manuscript

62 ;; nothing had executed. Taxonomy shape 3 arriving from the

63 ;; unusual direction: not a check matching its own text, but a

64 ;; REPORT matching the detector's text. Head and length prove

65 ;; the extraction happened and echo nothing.

66 (set! argument-field-head (if (pair? v) (car v) 'not-a-pair))

67 (set! argument-field-length (if (list? v) (length v) -1)))))

68 (inspected-node-fields n))

69 (walk (append (inspected-node-children n) (cdr pending))))))

71(display "F2A_WITNESS_PROBE_INSPECTED nodes=")

72(display nodes)

73(display " commands=")

74(display commands)

75(display " author-expressions=")

76(display expressions)

77(display " fields=")

78(display fields)

79(newline)

80(display "F2A_WITNESS_PROBE_ARGUMENT_FIELD head=")

81(display argument-field-head)

82(display " length=")

83(display argument-field-length)

84(newline)