test/test-cold-cache-scheduling.sgl

1;;; Cold parsing must let another request run without caching a raced value.

2(import (sigil test)

3 (sigil fs)

4 (sigil path)

5 (sigil time)

6 (sigil async)

7 (sigil channels)

8 (folio lock)

9 (folio filecache)

10 (folio task))

12(test-group "cold parsing checkpoints"

13 (test "a writer during a cache-fill pause invalidates the computed value"

14 (call-with-temp-directory

15 (lambda (root)

16 (let* ((path (path-join root "value.md"))

17 (cache (make-file-cache))

18 (ready (make-channel 1))

19 (first #f)

20 (size-after-first #f)

21 (writer-ran? #f))

22 (write-file-string path "old")

23 (parameterize ((file-cache-settle-seconds 0))

24 (with-async

25 (go

26 (channel-receive ready)

27 (write-file-atomic path "new")

28 (set! writer-ran? #t))

29 (go

30 ;; Model a native CPU phase; explicit checkpoints must work

31 ;; without relying on the VM's automatic preemption.

32 (set-vm-yield-requested! #f)

33 (set! first

34 (file-cache-ref cache path

35 (lambda (p)

36 (let ((value (read-file-string p))

37 (start (current-jiffy)))

38 (channel-send ready #t)

39 (let busy ()

40 (when (< (- (current-jiffy) start)

41 (/ (jiffies-per-second) 50))

42 (busy)))

43 value))))

44 (set! size-after-first (file-cache-size cache))))

45 (display (format "COLD-CACHE writer-ran=~a first=~a cached=~a\n"

46 writer-ran? first size-after-first))

47 (assert-true writer-ran?)

48 (assert-equal "old" first)

49 (assert-equal 0 size-after-first)

50 (assert-equal "new" (file-cache-ref cache path read-file-string)))))))

52 (test "a sibling runs before a cold task-block parse finishes"

53 (let ((ready (make-channel 1))

54 (finished? #f)

55 (interleaved? #f)

56 (blocks '())

57 (lines

58 (let loop ((n 0) (acc '()))

59 (if (= n 2000)

60 (reverse acc)

61 (loop (+ n 1)

62 (cons (format "- [ ] Task ~a {id: t-~a}" n n) acc))))))

63 (with-async

64 (go

65 (channel-receive ready)

66 (set! interleaved? (not finished?)))

67 (go

68 (set-vm-yield-requested! #f)

69 (channel-send ready #t)

70 (set! blocks (find-task-blocks lines))

71 (set! finished? #t)))

72 (display (format "COLD-PARSE interleaved=~a blocks=~a\n"

73 interleaved? (length blocks)))

74 (assert-true interleaved?)

75 (assert-equal 2000 (length blocks)))))