1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
|
module E = Colitur_render.Escape
let check = Alcotest.(check string)
let test_latex () =
check "ampersand" "\\&" (E.apply E.Latex "&");
check "percent" "\\%" (E.apply E.Latex "%");
check "underscore" "\\_" (E.apply E.Latex "_");
check "braces" "\\{\\}" (E.apply E.Latex "{}");
check "backslash first" "\\textbackslash{}" (E.apply E.Latex "\\");
(* A real feast name that would otherwise break a .tex build. *)
check "real name" "Ss.mi Nominis Iesu \\& Mari\xc3\xa6"
(E.apply E.Latex "Ss.mi Nominis Iesu & Mari\xc3\xa6")
(* Typst's markup metacharacters, verified against the installed `typst`
0.14.2 binary rather than trusted from a spec list: a probe document
escaping each one individually, `typst compile`'d and `pdftotext`'d
back, confirmed the literal character survives (and, separately, that
the UNescaped form really does something else -- #box[..] consumes a
bare '#', *x* renders bold, @word errors "cannot reference text", a
bare <label> vanishes into label syntax, a~b becomes a non-breaking
join, and a--b/a---b become en/em dashes). Every case below is a
REGRESSION test: run against escape.ml's pre-fix stub (`Typst -> s`,
identity, no escaping at all -- see escape.ml's own TODO comment),
every one of these lines fails, because the stub hands Typst the bare
metacharacter it would then parse as markup instead of the
backslash-escaped literal. *)
let test_typst () =
check "hash" "\\#" (E.apply E.Typst "#");
check "star" "\\*" (E.apply E.Typst "*");
check "underscore" "\\_" (E.apply E.Typst "_");
check "dollar" "\\$" (E.apply E.Typst "$");
check "at" "\\@" (E.apply E.Typst "@");
check "lt" "\\<" (E.apply E.Typst "<");
check "gt" "\\>" (E.apply E.Typst ">");
check "backtick" "\\`" (E.apply E.Typst "`");
check "backslash first" "\\\\" (E.apply E.Typst "\\");
check "tilde" "\\~" (E.apply E.Typst "~");
check "dash" "\\-" (E.apply E.Typst "-");
(* Runs of two/three unescaped hyphens become en/em dashes in live
Typst ("a--b" -> "a\xe2\x80\x93b", "a---b" -> "a\xe2\x80\x94b"). This
escaper has no lookahead (see [expand]'s own comment: one pass, no
re-scan), so it cannot detect "is this hyphen part of a run" -- it
escapes every '-' unconditionally instead, which a live probe
confirmed defangs a run of ANY length too: "\-\-\-" still typesets
as three literal hyphens, never an em dash. *)
check "double dash defanged" "\\-\\-" (E.apply E.Typst "--");
check "triple dash defanged" "\\-\\-\\-" (E.apply E.Typst "---");
(* A real shipped citation (data/ef/lectionary.sexp's 2 Nov Epistle),
not synthetic -- the metacharacter in this list most likely to
actually occur in colitur's own data, since citation ranges are
routinely hyphenated ("11-16") and Latin/English feast names almost
never carry '#'/'*'/'_'/'$'/'@'/'<'/'>'/'`'/'~'. *)
check "real citation" "Ezech 34:11\\-16" (E.apply E.Typst "Ezech 34:11-16");
(* A realistic MISTAKE, not shipped data: this project also ships a
Markdown flavour, so a diocesan overlay author hand-editing a local
feast's `name` field in a text editor typing markdown-habit
asterisks for emphasis is a plausible real input, not a contrived
one -- verified live that unescaped asterisks here would render
bold, and confirmed escaped ones render as the two literal
asterisks the author actually typed. *)
check "overlay author's markdown-habit name" "Our Lady of the \\*Assumption\\*"
(E.apply E.Typst "Our Lady of the *Assumption*")
let test_groff () =
check "backslash" "\\e" (E.apply E.Groff "\\");
(* RG-irrelevant but groff-critical: a leading dot starts a request. *)
check "leading dot" "\\&.Ss" (E.apply E.Groff ".Ss");
check "leading quote" "\\&'tis" (E.apply E.Groff "'tis");
check "interior dot untouched" "Ss.mi" (E.apply E.Groff "Ss.mi")
let test_html_xml () =
check "amp first" "&lt;" (E.apply E.Html "<");
check "angles" "<b>" (E.apply E.Html "<b>");
check "quote" """ (E.apply E.Html "\"");
check "xml same" "<b>" (E.apply E.Xml "<b>")
let test_ics () =
check "comma" "\\," (E.apply E.Ics ",");
check "semicolon" "\\;" (E.apply E.Ics ";");
check "backslash" "\\\\" (E.apply E.Ics "\\");
check "newline" "\\n" (E.apply E.Ics "\n")
let test_none_is_identity () =
check "none" "& < > \\ % {}" (E.apply E.None_ "& < > \\ % {}")
(* CHARACTERISATION, not regression: to_string/of_string/of_extension are
flat data-table lookups with no per-character logic to get subtly
wrong (unlike [typst]/[latex]/[html]/[ics]'s own [expand] functions),
so they were correct the moment the Typst variant and its three table
entries were added -- there was no "stubbed wrong, then fixed" step
for this one to have failed against, unlike test_typst above. Pinned
here, not as its own case, because that is where every other
flavour's mapping already lives. *)
let test_flavour_names () =
List.iter
(fun f -> Alcotest.(check bool) "roundtrip" true (E.of_string (E.to_string f) = Some f))
[ E.Latex; E.Typst; E.Groff; E.Html; E.Xml; E.Ics; E.None_ ];
Alcotest.(check bool) "tex" true (E.of_extension ".tex" = Some E.Latex);
Alcotest.(check bool) "typ" true (E.of_extension ".typ" = Some E.Typst);
Alcotest.(check bool) "ms" true (E.of_extension ".ms" = Some E.Groff);
Alcotest.(check bool) "mom" true (E.of_extension ".mom" = Some E.Groff);
Alcotest.(check bool) "html" true (E.of_extension ".html" = Some E.Html);
Alcotest.(check bool) "md is none" true (E.of_extension ".md" = Some E.None_);
Alcotest.(check bool) "adoc is none" true (E.of_extension ".adoc" = Some E.None_);
Alcotest.(check bool) "txt is none" true (E.of_extension ".txt" = Some E.None_);
(* Spec section 5: an unknown extension is an ERROR, never a silent fallback. *)
Alcotest.(check bool) "unknown is None" true (E.of_extension ".wat" = None)
let test_fold_short_line_unchanged () =
check "short" "SUMMARY:Feast\r\n" (E.fold_ics "SUMMARY:Feast")
let test_fold_long_line () =
let long = "DESCRIPTION:" ^ String.make 200 'x' in
let out = E.fold_ics long in
let lines = String.split_on_char '\n' out in
List.iter
(fun l ->
let l = if l <> "" && l.[String.length l - 1] = '\r' then String.sub l 0 (String.length l - 1) else l in
if String.length l > 75 then Alcotest.failf "line of %d octets exceeds 75" (String.length l))
(List.filter (fun l -> l <> "") lines);
(* Continuation lines begin with exactly one space (RFC 5545 section 3.1). *)
match lines with
| _ :: second :: _ -> Alcotest.(check bool) "continuation starts with space" true (second.[0] = ' ')
| _ -> Alcotest.fail "expected the line to fold"
(* RFC 5545 section 3.1 folds on OCTET boundaries; splitting mid-UTF-8 corrupts
Polish and Latin names, which is the whole reason this is not a template job. *)
let test_fold_never_splits_utf8 () =
let long = "SUMMARY:" ^ String.concat "" (List.init 40 (fun _ -> "\xc4\x99\xc5\x9b\xc4\x87")) in
let out = E.fold_ics long in
let chunks =
List.filter_map
(fun l ->
let l = if l <> "" && l.[String.length l - 1] = '\r' then String.sub l 0 (String.length l - 1) else l in
if l = "" then None else if l.[0] = ' ' then Some (String.sub l 1 (String.length l - 1)) else Some l)
(String.split_on_char '\n' out)
in
(* The named property: no chunk may START with a UTF-8 continuation byte
(0x80-0xBF) -- that would mean the previous fold cut mid-character.
Unfolding losslessly (below) cannot detect this on its own: concatenation
is insensitive to where the cuts fell, so a fold at ANY position still
round-trips. *)
List.iter
(fun c ->
if String.length c > 0 then
Alcotest.(check bool) "chunk does not start mid-UTF-8" true (Char.code c.[0] land 0xC0 <> 0x80))
chunks;
let stripped = String.concat "" chunks in
check "unfolds to the original" long stripped
(* B1 regression: 100 consecutive UTF-8 continuation bytes (0x80-0xBF) is not
producible by valid UTF-8 (whose longest continuation run is 3), but
fold_ics must stay TOTAL on arbitrary octet strings. A backoff loop with no
hard-cut fallback backs `cut` all the way down to `pos`, yielding a
zero-length chunk and recursing on the identical position forever. *)
let test_fold_pathological_input_terminates () =
let pathological = String.make 100 '\x80' in
let out = E.fold_ics pathological in
let lines = String.split_on_char '\n' out in
List.iter
(fun l ->
let l = if l <> "" && l.[String.length l - 1] = '\r' then String.sub l 0 (String.length l - 1) else l in
if String.length l > 75 then Alcotest.failf "line of %d octets exceeds 75" (String.length l))
(List.filter (fun l -> l <> "") lines)
let suite =
( "Escape",
[ Alcotest.test_case "latex" `Quick test_latex;
Alcotest.test_case "typst" `Quick test_typst;
Alcotest.test_case "groff" `Quick test_groff;
Alcotest.test_case "html/xml" `Quick test_html_xml;
Alcotest.test_case "ics" `Quick test_ics;
Alcotest.test_case "none is identity" `Quick test_none_is_identity;
Alcotest.test_case "flavour names" `Quick test_flavour_names;
Alcotest.test_case "fold: short unchanged" `Quick test_fold_short_line_unchanged;
Alcotest.test_case "fold: long line" `Quick test_fold_long_line;
Alcotest.test_case "fold: never splits utf8" `Quick test_fold_never_splits_utf8;
Alcotest.test_case "fold: pathological input terminates" `Quick test_fold_pathological_input_terminates ] )
|
