test/f3a-writer.sgl

1;;; f3a-writer.sgl -- one real Folio-aware writer process for the contention

2;;; arm. Two of these race in gate-f3a.sh's arm G3: both receive the SAME

3;;; expected revision (computed before either starts), both wait for a common

4;;; start file, then both attempt a title edit on the same note. With the

5;;; coordinator sound, the writer that enters the lock second re-reads a moved

6;;; revision and refuses; exactly one WRITER_RESULT OK must appear per round.

7;;;

8;;; Output contract (machine-read by the gate):

9;;; WRITER_RESULT OK value=<v> new-rev=<r>

10;;; WRITER_RESULT REFUSED reason=<sym> current-rev=<r> has-context=<yes/no> has-diff=<yes/no>

11;;; WRITER_RESULT ERROR <text>

12(import (sigil core) (sigil io) (sigil fs) (sigil string) (sigil time)

13 (folio doc revision) (folio doc bounded) (folio doc service)

14 (folio doc coordinator) (folio doc transaction))

16(define (need name)

17 (or (getenv name)

18 (begin (println "WRITER_RESULT ERROR ~a is not set" name) (exit 3))))

20(define root (need "F3A_ROOT"))

21(define note (need "F3A_NOTE"))

22(define expected-rev (need "F3A_EXPECTED_REV"))

23(define value (need "F3A_TITLE"))

24(define start-file (need "F3A_START_FILE"))

25(define lib-dir (or (getenv "F3A_LIB") "build/dev/lib"))

26(define src-dir (or (getenv "F3A_SRC") "src"))

28(define svc (make-service (default-worker-argv lib-dir src-dir) default-limits))

29(define coord (make-coordinator root svc))

31;; Rendezvous: both writers finish coordinator init (which serializes on the

32;; lock), then spin on the start file so their transaction attempts overlap.

33(println "WRITER_READY")

34(let wait ()

35 (unless (file-exists? start-file)

36 (sleep 0.005)

37 (wait)))

39(guard (e (#t (println "WRITER_RESULT ERROR ~a"

40 (if (exception? e) (exception-message e) e))

41 (exit 2)))

42 (let ((r (folio-update-field! coord note "t-alpha" 'title value expected-rev

43 expected-node-kind: 'task)))

44 (cond

45 ((txn-result? r)

46 (println "WRITER_RESULT OK value=~a new-rev=~a" value (txn-result-new-revision r)))

47 (else

48 (println "WRITER_RESULT REFUSED reason=~a current-rev=~a has-context=~a has-diff=~a"

49 (txn-refusal-reason r)

50 (txn-refusal-current-revision r)

51 (if (string? (txn-refusal-target-context r)) "yes" "no")

52 (if (string? (txn-refusal-diff r)) "yes" "no"))))))