diff --git a/test/programs/utf8.flan b/test/programs/utf8.flan new file mode 100644 index 0000000..7e662a8 --- /dev/null +++ b/test/programs/utf8.flan @@ -0,0 +1,248 @@ +;;;; UTF-8 decoding and encoding, the split cursor, and ASCII case. +;;;; +;;;; Every case here is one a plausible wrong decoder passes. A decoder that +;;;; only masks and shifts — takes the top bits of the lead byte for a length +;;;; and the low six of everything after — gets all of the *valid* input right +;;;; and every line of the second group wrong, so the valid decodes prove +;;;; almost nothing on their own and the malformed ones are the test. +;;;; +;;;; The four that matter, each isolating one row of Odin's accept_sizes +;;;; table: +;;;; +;;;; c0 af an overlong two-byte "/". Accepted, it is the encoding +;;;; that smuggles a slash past a check for one. +;;;; e0 80 af an overlong three-byte "/", which the raised second-byte +;;;; floor on 0xe0 is the only thing rejecting. +;;;; ed a0 80 U+D800, a UTF-16 surrogate, which is not a scalar value. +;;;; Only the lowered ceiling on 0xed rejects it. +;;;; f4 90 80 80 U+110000, one past the last code point. +;;;; +;;;; And three more shapes: a lone continuation byte, a lead byte that leads +;;;; nothing (0xf5), and a sequence truncated by the end of the slice — the +;;;; last taken as a slice of a *valid* literal, which is what reading a +;;;; buffer boundary actually hands you. +;;;; +;;;; The invalid sequences are byte arrays because the reader has no \xNN +;;;; escape in either a string or a character literal, and none of them can be +;;;; derived from a valid string. + +(defconst overlong2 [2 u8] [0xc0 0xaf]) +(defconst overlong3 [3 u8] [0xe0 0x80 0xaf]) +(defconst surrogate [3 u8] [0xed 0xa0 0x80]) +(defconst above-max [4 u8] [0xf4 0x90 0x80 0x80]) +(defconst lead-f5 [4 u8] [0xf5 0x80 0x80 0x80]) +(defconst lone-cont [1 u8] [0x80]) +(defconst emoji [4 u8] [0xf0 0x9f 0x98 0x80]) ; U+1F600 +(defconst bad-tail [3 u8] [0x61 0xff 0x62]) ; "a", junk, "b" + +(defvar scratch [4 u8]) + +;; Each array is sliced at the point of use rather than through a +;; (defn whole [a [4 u8]] [u8] (slice a 0 4)) helper. That helper is a +;; use-after-return and the compiler accepts it in silence: a [n T] parameter +;; is a *value* and copies into the callee's frame, so the slice it hands back +;; points at a frame that has already gone. It was written here first, and the +;; emoji line is what caught it — it decoded as malformed because it was +;; reading whatever the next call left on the stack. This is the escaping +;; borrow spec-memory.md leaves to the programmer under "Borrowing", and it is +;; the case a future provenance pass would reject. + +;; code/width/ok, so a wrong answer names which of the three it got wrong +;; rather than just failing. +(defn show-dec [s [u8]] + (let [r (decode-rune s)] + (print-i64 (i64 (.code r))) (print-str "/") + (print-i64 (i64 (.width r))) (print-str "/") + (print-str (if (.ok r) "t" "f")) + (print-str " "))) + +(defn show-bool [b bool] + (print-str (if b "t" "f"))) + +(defn show-opt [o (Option i32)] + (print-i64 (i64 (match o (Some v) v None -1))) + (print-str " ")) + +;; Encode into the scratch buffer and decode straight back out of it. A round +;; trip is the only check that catches an encoder and a decoder that are +;; wrong in the same direction — printing the bytes would not. +(defn round-trip [code i32] i32 + (match (encode-rune! (slice scratch 0 4) code) + None -1 + (Some w) + (let [r (decode-rune (slice scratch 0 w))] + (if (and (.ok r) (= (.width r) w)) (.code r) -1)))) + +(defn show-i32 [x i32] + (print-i64 (i64 x)) + (print-str " ")) + +(defn show-split [s [u8] sep u8] + (let [it (split-on-byte s sep) + going true] + (while going + (match (split-next! (addr it)) + (Some f) (do (print-str "[") (print-bytes f) (print-str "]")) + None (set going false))) + (print-str " "))) + +(defn main [] i32 + ;; Valid, one of each width. The empty slice is width 0 — the only input + ;; that gets a 0, because every loop below advances by width and a 0 on a + ;; malformed byte would hang instead of answering. + (show-dec (bytes "")) ; 0/0/f + (show-dec (bytes "A")) ; 65/1/t + (show-dec (bytes "é")) ; 233/2/t + (show-dec (bytes "日")) ; 26085/3/t + (show-dec (slice emoji 0 4)) ; 128512/4/t + (newline) + + ;; Malformed. Every one is 0/1/f: width 1 so a scan makes progress. + (show-dec (slice lone-cont 0 1)) ; a continuation byte leading + (show-dec (slice overlong2 0 2)) ; overlong "/" + (show-dec (slice overlong3 0 3)) ; overlong "/" again, three bytes + (show-dec (slice surrogate 0 3)) ; U+D800 + (show-dec (slice above-max 0 4)) ; U+110000 + (show-dec (slice lead-f5 0 4)) ; 0xf5 leads nothing + (newline) + + ;; Truncated: a valid character cut short by the end of the slice, at both + ;; possible cut points, and the interior of one taken on its own. + (show-dec (slice (bytes "日") 0 1)) ; lead byte alone + (show-dec (slice (bytes "日") 0 2)) ; lead plus one continuation + (show-dec (slice (bytes "日") 1 3)) ; starts mid-character + (show-dec (slice (bytes "é") 1 2)) ; a lone continuation from a literal + (newline) + + ;; rune-start? is what a caller scans backwards with. + (show-bool (rune-start? (at (bytes "日") 0))) + (show-bool (rune-start? (at (bytes "日") 1))) + (show-bool (rune-start? \A)) + (newline) + + ;; Counting. The empty string is 0 and not 1; the mixed string is 8 runes + ;; in 13 bytes, which is the whole distinction; and a malformed byte counts + ;; as one, so a count never disagrees with what a renderer would draw. + (print-i64 (i64 (rune-count (bytes "")))) (print-str " ") + (print-i64 (i64 (rune-count (bytes "abc")))) (print-str " ") + (print-i64 (i64 (rune-count (bytes "héllo 日本")))) (print-str " ") + (print-i64 (i64 (len (bytes "héllo 日本")))) (print-str " ") + (print-i64 (i64 (rune-count (slice bad-tail 0 3)))) + (newline) + + (show-bool (valid-utf8? (bytes ""))) + (show-bool (valid-utf8? (bytes "héllo 日本"))) + (show-bool (valid-utf8? (slice surrogate 0 3))) + (show-bool (valid-utf8? (slice overlong2 0 2))) + (show-bool (valid-utf8? (slice bad-tail 0 3))) + (show-bool (valid-utf8? (slice emoji 0 4))) + (newline) + + ;; rune-at: on a boundary, off a boundary, and out of range. Off a boundary + ;; is None rather than a replacement character, which is where this is + ;; stricter than Odin's rune_at. + (show-opt (rune-at (bytes "日本") 0)) ; 26085 + (show-opt (rune-at (bytes "日本") 3)) ; 26412 + (show-opt (rune-at (bytes "日本") 1)) ; -1, mid-character + (show-opt (rune-at (bytes "日本") 6)) ; -1, past the end + (show-opt (rune-at (bytes "") 0)) ; -1 + (newline) + + ;; rune-size, at every boundary and on both sides of it. + (show-opt (rune-size -1)) + (show-opt (rune-size 0)) + (show-opt (rune-size 0x7f)) + (show-opt (rune-size 0x80)) + (show-opt (rune-size 0x7ff)) + (show-opt (rune-size 0x800)) + (show-opt (rune-size 0xd7ff)) + (show-opt (rune-size 0xd800)) + (show-opt (rune-size 0xdfff)) + (show-opt (rune-size 0xe000)) + (show-opt (rune-size 0xffff)) + (show-opt (rune-size 0x10000)) + (show-opt (rune-size 0x10ffff)) + (show-opt (rune-size 0x110000)) + (newline) + + ;; Round trips, one per width and at the boundaries. + (show-i32 (round-trip 0)) + (show-i32 (round-trip 0x41)) + (show-i32 (round-trip 0x7f)) + (show-i32 (round-trip 0x80)) + (show-i32 (round-trip 0x7ff)) + (show-i32 (round-trip 0x800)) + (show-i32 (round-trip 0xffff)) + (show-i32 (round-trip 0x10000)) + (show-i32 (round-trip 0x10ffff)) + (newline) + + ;; Refused by encode-rune!, and nothing is written when it refuses. + (show-opt (encode-rune! (slice scratch 0 4) 0xd800)) ; -1, surrogate + (show-opt (encode-rune! (slice scratch 0 4) 0x110000)) ; -1, past the end + (show-opt (encode-rune! (slice scratch 0 4) -1)) ; -1, negative + (show-opt (encode-rune! (slice scratch 0 2) 0x65e5)) ; -1, buffer short + (show-opt (encode-rune! (slice scratch 0 0) 0x41)) ; -1, no room at all + (show-opt (encode-rune! (slice scratch 0 1) 0x41)) ; 1, exactly enough + (newline) + + ;; Splitting. n separators give n+1 fields, always: an interior empty field + ;; survives, a leading and a trailing one do too, and an input with no + ;; separator at all is one field rather than none. The empty input is the + ;; case Odin's own iterator disagrees with its allocating split on — it is + ;; one empty field here. + (show-split (bytes "a,b,c") \,) ; [a][b][c] + (show-split (bytes "a,,b") \,) ; [a][][b] + (show-split (bytes "abc") \,) ; [abc] + (show-split (bytes "") \,) ; [] + (show-split (bytes ",") \,) ; [][] + (show-split (bytes ",a") \,) ; [][a] + (show-split (bytes "a,") \,) ; [a][] + (newline) + + ;; A field is a slice of the input, so trim and parse-i64 work straight off + ;; one with nothing copied in between — which is the entire reason the + ;; cursor shape exists. + (let [it (split-on-byte (bytes " 10 , 20 ,30") \,) + total (i64 0) + going true] + (while going + (match (split-next! (addr it)) + (Some f) (set total (+ total (match (parse-i64 (trim f)) (Some v) v None 0))) + None (set going false))) + (print-i64 total) + (newline)) + + ;; ASCII case. The boundary bytes on both sides of each range are what a + ;; wrong mask gets wrong: '@' and '[' sit either side of A-Z, and '`' and + ;; '{' either side of a-z, so a conversion written as (bit-xor b 32) — + ;; which works for every letter — turns '@' into '`' and is caught here. + (show-i32 (i32 (lower-ascii \A))) + (show-i32 (i32 (lower-ascii \Z))) + (show-i32 (i32 (lower-ascii \a))) + (show-i32 (i32 (lower-ascii \@))) ; 64, just below 'A' + (show-i32 (i32 (lower-ascii \[))) ; 91, just above 'Z' + (show-i32 (i32 (upper-ascii \a))) + (show-i32 (i32 (upper-ascii \z))) + (show-i32 (i32 (upper-ascii \A))) + (show-i32 (i32 (upper-ascii \`))) ; 96, just below 'a' + (show-i32 (i32 (upper-ascii \{))) ; 123, just above 'z' + (show-i32 (i32 (lower-ascii \5))) ; digits are untouched + (newline) + + ;; A non-ASCII byte must pass through both untouched, which is the claim + ;; that "ASCII only" is a rule and not an oversight. + (show-i32 (i32 (lower-ascii (at (bytes "é") 0)))) + (show-i32 (i32 (upper-ascii (at (bytes "é") 0)))) + (newline) + + (show-bool (bytes-ci=? (bytes "Hello") (bytes "hELLO"))) ; t + (show-bool (bytes-ci=? (bytes "Hello") (bytes "hello!"))) ; f length first + (show-bool (bytes-ci=? (bytes "") (bytes ""))) ; t + (show-bool (bytes-ci=? (bytes "a") (bytes "b"))) ; f + ;; '@' is 'A'+32 apart from '`' the way a letter is from its own case, so a + ;; fold written as a bit-xor would call these two equal. They are not. + (show-bool (bytes-ci=? (bytes "@") (bytes "`"))) ; f + (show-bool (bytes-ci=? (bytes "é") (bytes "é"))) ; t bytes match + (newline) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 9d138ff..1fb74f2 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -881,6 +881,48 @@ ERR@7 unexpected token: not the kind the caller was reading outputs "signedness" "programs/signedness.flan" signed_out; outputs ~opt:"-O0" "signedness, -O0" "programs/signedness.flan" signed_out; + (* ── Strings: UTF-8, the split cursor, and ASCII case ────────────── + + The prelude's port of Odin's core/unicode/utf8, which is the only part + of a string library that needs no allocator. The valid decodes prove + almost nothing on their own — a decoder that just masks and shifts gets + every one of them right — so the test is the malformed group: an + overlong two- and three-byte "/", a UTF-16 surrogate, a code point past + U+10FFFF, a lead byte that leads nothing, a lone continuation byte, and + a valid character truncated by the end of its slice. Each isolates one + row of the accept_sizes table, and each answers width 1 so that a scan + makes progress rather than hanging. + + Encoding is checked by round trip rather than against expected bytes, + because an encoder and a decoder that are wrong in the same direction + agree with each other and disagree with nothing else. + + At -O0 as well, for the reason the slice algorithms run there: a slice + is a two-word struct through an alloca, decode-rune returns a struct by + value, and the split cursor is mutated through a (Ptr Split) — mem2reg + is exactly what would hide any of those being copied when it should be + shared. *) + let utf8_out = + "0/0/f 65/1/t 233/2/t 26085/3/t 128512/4/t \n\ + 0/1/f 0/1/f 0/1/f 0/1/f 0/1/f 0/1/f \n\ + 0/1/f 0/1/f 0/1/f 0/1/f \n\ + tft\n\ + 0 3 8 13 3\n\ + ttffft\n\ + 26085 26412 -1 -1 -1 \n\ + -1 1 1 2 2 3 3 -1 -1 3 3 4 4 -1 \n\ + 0 65 127 128 2047 2048 65535 65536 1114111 \n\ + -1 -1 -1 -1 -1 1 \n\ + [a][b][c] [a][][b] [abc] [] [][] [][a] [a][] \n\ + 60\n\ + 97 122 97 64 91 65 90 65 96 123 53 \n\ + 195 195 \n\ + tftfft\n" + in + outputs "utf-8, splitting and ascii case" "programs/utf8.flan" utf8_out; + outputs ~opt:"-O0" "utf-8, splitting and ascii case, -O0" + "programs/utf8.flan" utf8_out; + if !failures = 0 then print_endline "acceptance: all tests passed" else begin Printf.printf "\n%d failure(s)\n" !failures;