test/test-harfbuzz.sgl — sigil-harfbuzz

1;;; HarfBuzz test suite

2;;; Requires libharfbuzz, libfreetype, and a TrueType font.

4(import (sigil core)

5 (sigil test)

6 (sigil fs)

7 (sigil ffi)

8 (sigil io)

9 (sigil process)

10 (freetype)

11 (harfbuzz))

13;; Find a test font using fc-match

14(define (find-test-font)

15 (let ((env-font (getenv "SIGIL_TEST_FONT")))

16 (if env-font

17 env-font

18 (let ((fc-path (guard (exn (#t #f))

19 (call-with-process "fc-match" '("--format=%{file}" "sans")

20 (lambda (p)

21 (let ((line (read-line (process-stdout p))))

22 (if (eof-object? line) #f line)))))))

23 (if (and fc-path (file-exists? fc-path))

24 fc-path

25 (error "No test font found — set SIGIL_TEST_FONT or install fontconfig"))))))

27(define test-font-path (find-test-font))

29(test-group "harfbuzz"

31 (test-group "Buffer lifecycle"

32 (test "create and destroy buffer"

33 (let ((buf (hb-buffer-create)))

34 (assert-true (pointer? buf))

35 (hb-buffer-destroy buf))))

37 (test-group "Tag helpers"

38 (test "hb-tag creates correct value"

39 (let ((tag (hb-tag-string "Latn")))

40 (assert-true (integer? tag))

41 (assert-true (> tag 0))))

43 (test "script constants are valid"

44 (assert-true (integer? HB_SCRIPT_LATIN))

45 (assert-true (integer? HB_SCRIPT_ARABIC))

46 (assert-true (not (= HB_SCRIPT_LATIN HB_SCRIPT_ARABIC)))))

48 (test-group "Text shaping"

49 (test "shape Latin text"

50 (let* ((lib (ft-init))

51 (face (ft-new-face lib test-font-path)))

52 (ft-set-char-size face (* 16 64) 0 72 72)

53 (let ((font (hb-ft-font-create face))

54 (buf (hb-buffer-create)))

55 (hb-buffer-add-utf8 buf "Hello")

56 (hb-buffer-set-direction buf HB_DIRECTION_LTR)

57 (hb-buffer-set-script buf HB_SCRIPT_LATIN)

58 (hb-buffer-set-language buf "en")

59 (hb-shape font buf)

61 (assert-equal 5 (hb-buffer-get-length buf))

63 (let ((infos (hb-buffer-get-glyph-infos buf))

64 (positions (hb-buffer-get-glyph-positions buf)))

65 (assert-equal 5 (length infos))

66 (assert-equal 5 (length positions))

67 ;; Each info should have a codepoint (glyph index)

68 (assert-true (> (dict-ref (car infos) codepoint:) 0))

69 ;; Each position should have an x-advance

70 (assert-true (> (dict-ref (car positions) x-advance:) 0)))

72 (hb-buffer-destroy buf)

73 (hb-font-destroy font))

74 (ft-done-face face)

75 (ft-done-freetype lib)))

77 (test "guess segment properties"

78 (let* ((lib (ft-init))

79 (face (ft-new-face lib test-font-path)))

80 (ft-set-char-size face (* 16 64) 0 72 72)

81 (let ((font (hb-ft-font-create face))

82 (buf (hb-buffer-create)))

83 (hb-buffer-add-utf8 buf "Test")

84 (hb-buffer-guess-segment-properties buf)

85 (hb-shape font buf)

87 (assert-true (> (hb-buffer-get-length buf) 0))

89 (hb-buffer-destroy buf)

90 (hb-font-destroy font))

91 (ft-done-face face)

92 (ft-done-freetype lib)))

94 (test "glyph positions have structure"

95 (let* ((lib (ft-init))

96 (face (ft-new-face lib test-font-path)))

97 (ft-set-char-size face (* 12 64) 0 96 96)

98 (let ((font (hb-ft-font-create face))

99 (buf (hb-buffer-create)))

100 (hb-buffer-add-utf8 buf "AB")

101 (hb-buffer-set-direction buf HB_DIRECTION_LTR)

102 (hb-buffer-set-script buf HB_SCRIPT_LATIN)

103 (hb-shape font buf)

104

105 (let ((positions (hb-buffer-get-glyph-positions buf)))

106 (assert-equal 2 (length positions))

107 ;; Both glyphs should have x-advance > 0

108 (assert-true (> (dict-ref (car positions) x-advance:) 0))

109 (assert-true (> (dict-ref (cadr positions) x-advance:) 0))

110 ;; y-offset should be 0 for simple Latin

111 (assert-equal 0 (dict-ref (car positions) y-offset:)))

112

113 (hb-buffer-destroy buf)

114 (hb-font-destroy font))

115 (ft-done-face face)

116 (ft-done-freetype lib)))))