test/test-store-walk.sgl

1;;; Regression coverage for the note walk's stack depth.

2;;;

3;;; `find-md-files-recursive` once folded a directory's entries with

4;;; `fold-right`, which is not tail recursive: it burned one Sigil stack frame

5;;; per file. That made the maximum size of a folio a function of the

6;;; interpreter's stack rather than of anything folio chose. Past roughly 1011

7;;; entries in a single directory the walk blew the stack, and since every tool

8;;; that enumerates notes starts here, the whole server went down with it -- a

9;;; fresh `folio serve` could not finish starting, and a warm one lost the

10;;; request fiber mid-call and simply never answered.

11;;;

12;;; The corpus that found this had 1016 files in one directory. These tests

13;;; walk well past that so the margin is real and not a coincidence, and so the

14;;; failure returns as a red test rather than as a server that will not boot.

16(import (sigil test)

17 (sigil string)

18 (sigil list)

19 (sigil fs)

20 (sigil path)

21 (folio store))

23;; Write n trivial .md files into dir, named so lexical and creation order differ.

24(define (populate! dir n)

25 (let loop ((i 0))

26 (when (< i n)

27 (write-file-string (path-join dir (string-append "note-" (number->string i) ".md"))

28 "---\ntags: []\n---\n\nBody.\n")

29 (loop (+ i 1)))))

31;; ============================================================

32;; Depth: one flat directory, far past the old ~1011 ceiling

33;; ============================================================

35(test-group "store-note-files handles a large flat directory"

36 (test "walks 3000 notes in one directory without exhausting the stack"

37 (call-with-temp-directory

38 (lambda (dir)

39 (let ((store (make-folio-store dir)))

40 ;; 3000 is ~3x the depth that killed the old fold. Before the fix

41 ;; this did not fail an assertion, it aborted the process with

42 ;; "stack overflow" -- which is exactly why it needed a test.

43 (populate! (store-notes-dir store) 3000)

44 (assert-equal 3000 (length (store-note-files store))))))))

46;; ============================================================

47;; Depth is per-directory, so nesting must not reintroduce it

48;; ============================================================

50(test-group "store-note-files handles large nested directories"

51 (test "walks large sibling and nested directories"

52 (call-with-temp-directory

53 (lambda (dir)

54 (let* ((store (make-folio-store dir))

55 (notes (store-notes-dir store))

56 (topics (path-join notes "topics"))

57 (deep (path-join topics "deep")))

58 (ensure-directory topics)

59 (ensure-directory deep)

60 (populate! notes 1200)

61 (populate! topics 1200)

62 (populate! deep 1200)

63 (assert-equal 3600 (length (store-note-files store))))))))

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

66;; Correctness, not just liveness: a fast wrong answer is worse

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

69(test-group "store-note-files walk correctness"

70 (test "returns every .md exactly once, and nothing else"

71 (call-with-temp-directory

72 (lambda (dir)

73 (let* ((store (make-folio-store dir))

74 (notes (store-notes-dir store))

75 (sub (path-join notes "sub")))

76 (ensure-directory sub)

77 (write-file-string (path-join notes "alpha.md") "a")

78 (write-file-string (path-join sub "beta.md") "b")

79 ;; Non-.md files are not notes.

80 (write-file-string (path-join notes "README.txt") "x")

81 (write-file-string (path-join sub "notes.org") "x")

82 (let ((files (store-note-files store)))

83 (assert-equal 2 (length files))

84 (assert-true (member (path-join notes "alpha.md") files))

85 (assert-true (member (path-join sub "beta.md") files)))))))

87 (test "still filters dotfiles at depth, and keeps the REAL notes"

88 (call-with-temp-directory

89 (lambda (dir)

90 (let* ((store (make-folio-store dir))

91 (notes (store-notes-dir store))

92 (sub (path-join notes "sub")))

93 (ensure-directory sub)

94 (write-file-string (path-join notes "real.md") "a")

95 (write-file-string (path-join sub "nested.md") "b")

96 ;; Emacs lock and Vim swap shapes, at both levels.

97 (write-file-string (path-join notes ".#real.md") "lock")

98 (write-file-string (path-join sub ".#nested.md") "lock")

99 (write-file-string (path-join notes ".DS_Store") "junk")

100 (let ((files (store-note-files store)))

101 ;; Counting alone would pass if the walk returned the two LOCK

102 ;; files instead of the two notes. Name them.

103 (assert-equal 2 (length files))

104 (assert-true (member (path-join notes "real.md") files))

105 (assert-true (member (path-join sub "nested.md") files)))))))

106

107 (test "a dot-directory is skipped whole"

108 (call-with-temp-directory

109 (lambda (dir)

110 (let* ((store (make-folio-store dir))

111 (notes (store-notes-dir store))

112 (hidden (path-join notes ".hidden")))

113 (ensure-directory hidden)

114 (write-file-string (path-join notes "real.md") "a")

115 (write-file-string (path-join hidden "buried.md") "b")

116 (let ((files (store-note-files store)))

117 (assert-equal 1 (length files))

118 (assert-true (member (path-join notes "real.md") files)))))))

119

120 (test "an empty subdirectory does not disturb the walk"

121 (call-with-temp-directory

122 (lambda (dir)

123 (let* ((store (make-folio-store dir))

124 (notes (store-notes-dir store)))

125 (ensure-directory (path-join notes "empty"))

126 (write-file-string (path-join notes "real.md") "a")

127 (assert-equal 1 (length (store-note-files store))))))))

128

129;; ============================================================

130;; The ORDERING contract, which the count assertions cannot see

131;; ============================================================

132;;

133;; store.sgl documents the walk's order as unchanged from the old fold:

134;; `directory-list` order, depth-first, each subdirectory expanded in place.

135;; Without an assertion on order, a rewrite that returned the right files

136;; reversed -- or breadth-first -- would pass every test above. That matters

137;; because `store-project-files` sorts explicitly and this one deliberately

138;; does not, so callers see raw order and a silent change would propagate.

139

140;; The OLD `fold-right` walk, preserved verbatim as the ordering ORACLE.

141;;

142;; It is unsafe on a real corpus -- that is this entire bug -- but it is

143;; perfectly correct on the small trees below, which makes it the exact

144;; specification of the order the rewrite promised to preserve. Comparing

145;; against it is a true differential test: any reordering, any change to

146;; depth-first placement, any change to the dotfile rule shows up as a diff

147;; rather than as a count that still happens to match.

148(define (fold-right-walk dir)

149 (let ((entries (or (directory-list dir) '())))

150 (fold-right (lambda (name acc)

151 (let ((full (path-join dir name)))

152 (cond

153 ((string-starts-with? name ".") acc)

154 ((directory? full) (append (fold-right-walk full) acc))

155 ((string-ends-with? name ".md") (cons full acc))

156 (else acc))))

157 '()

158 entries)))

159

160(test-group "store-note-files ordering"

161 (test "order matches the old fold exactly, on a mixed tree"

162 (call-with-temp-directory

163 (lambda (dir)

164 (let* ((store (make-folio-store dir))

165 (notes (store-notes-dir store))

166 (sub-a (path-join notes "aaa-sub"))

167 (sub-z (path-join notes "zzz-sub"))

168 (deep (path-join sub-a "deeper")))

169 ;; Subdirectories both before and after top-level files in any

170 ;; plausible ordering, plus a nested level, plus noise to skip.

171 (ensure-directory sub-a)

172 (ensure-directory sub-z)

173 (ensure-directory deep)

174 (ensure-directory (path-join notes "empty-sub"))

175 (for-each (lambda (p) (write-file-string p "x"))

176 (list (path-join notes "mmm.md")

177 (path-join notes "zzz.md")

178 (path-join notes "aaa.md")

179 (path-join notes "README.txt")

180 (path-join notes ".#lock.md")

181 (path-join sub-a "one.md")

182 (path-join sub-a "two.md")

183 (path-join sub-z "three.md")

184 (path-join deep "four.md")))

185 (let ((expected (fold-right-walk notes))

186 (actual (store-note-files store)))

187 (assert-equal 7 (length expected)) ;; oracle sees what we expect

188 (assert-equal expected actual)))))) ;; and the walk agrees exactly

189

190 (test "repeated walks of an unchanged tree return an identical list"

191 ;; Order must be stable, not merely correct once.

192 (call-with-temp-directory

193 (lambda (dir)

194 (let* ((store (make-folio-store dir))

195 (notes (store-notes-dir store))

196 (sub (path-join notes "sub")))

197 (ensure-directory sub)

198 (populate! notes 40)

199 (populate! sub 40)

200 (assert-equal (store-note-files store)

201 (store-note-files store)))))))