From 7e84e21995b0cd26bf209248e61bc336e4f90db1 Mon Sep 17 00:00:00 2001 From: Dag Brattli Date: Sun, 27 Sep 2026 15:51:23 +0200 Subject: [PATCH] chore: update Fantomas and format sources --- .config/dotnet-tools.json | 2 +- .github/workflows/build-and-test.yml | 4 +- src/otp/File.fs | 6 +- src/otp/GenTcp.fs | 7 +- src/otp/Port.fs | 44 +- src/otp/Supervisor.fs | 12 +- test/Main.fs | 58 +-- test/TestBase64.fs | 102 +++-- test/TestBinary.fs | 356 ++++++++------- test/TestCalendar.fs | 518 +++++++++++---------- test/TestCallbacks.fs | 94 ++-- test/TestDynamic.fs | 326 ++++++------- test/TestErlang.fs | 660 ++++++++++++++------------- test/TestEts.fs | 106 ++--- test/TestFile.fs | 303 ++++++------ test/TestGenServer.fs | 232 +++++----- test/TestIo.fs | 12 +- test/TestIoLib.fs | 23 +- test/TestJsx.fs | 212 ++++----- test/TestLists.fs | 616 ++++++++++++------------- test/TestLogger.fs | 270 +++++------ test/TestMaps.fs | 294 ++++++------ test/TestMath.fs | 84 ++-- test/TestOs.fs | 170 +++---- test/TestPort.fs | 496 ++++++++++---------- test/TestProplists.fs | 216 ++++----- test/TestQueue.fs | 460 +++++++++---------- test/TestRand.fs | 136 +++--- test/TestRe.fs | 476 +++++++++---------- test/TestString.fs | 442 +++++++++--------- test/TestSupervisor.fs | 92 ++-- test/TestTimer.fs | 10 +- test/TestUriString.fs | 299 ++++++------ 33 files changed, 3608 insertions(+), 3530 deletions(-) diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index c54aa0e..f811ff7 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -17,7 +17,7 @@ "rollForward": false }, "fantomas": { - "version": "8.0.4", + "version": "8.0.5", "commands": [ "fantomas" ], diff --git a/.github/workflows/build-and-test.yml b/.github/workflows/build-and-test.yml index 403d400..3429d5b 100644 --- a/.github/workflows/build-and-test.yml +++ b/.github/workflows/build-and-test.yml @@ -41,8 +41,8 @@ jobs: just setup just restore - #- name: Check formatting - # run: just format-check + - name: Check formatting + run: just format-check - name: Build run: just build diff --git a/src/otp/File.fs b/src/otp/File.fs index 8912eeb..288c4a3 100644 --- a/src/otp/File.fs +++ b/src/otp/File.fs @@ -134,12 +134,14 @@ let delDir (path: string) : Result = nativeOnly let listDir (path: string) : Result = nativeOnly /// Reads metadata for a filesystem entry, following symbolic links. -let readFileInfo (path: string) : Result = readFileInfoRaw path |> mapFileInfoResult +let readFileInfo (path: string) : Result = + readFileInfoRaw path |> mapFileInfoResult /// Reads metadata for a filesystem entry without following a symbolic link. /// A missing path is returned as `Error "enoent"`, consistently with the other /// typed file functions. -let readLinkInfo (path: string) : Result = readLinkInfoRaw path |> mapFileInfoResult +let readLinkInfo (path: string) : Result = + readLinkInfoRaw path |> mapFileInfoResult /// Renames (moves) a file. Handles binary_to_list conversion for both paths. [ case file:rename(binary_to_list($0), binary_to_list($1)) of ok -> {ok, ok}; {error, FileRenameReason__} -> {error, erlang:atom_to_binary(FileRenameReason__)} end end)()")>] diff --git a/src/otp/GenTcp.fs b/src/otp/GenTcp.fs index 99c82dc..63efa5a 100644 --- a/src/otp/GenTcp.fs +++ b/src/otp/GenTcp.fs @@ -40,8 +40,7 @@ module ConnectOptions = } [] -let private connectDefaultRaw (host: string) (port: int) (packetMode: PacketMode) : Result = - nativeOnly +let private connectDefaultRaw (host: string) (port: int) (packetMode: PacketMode) : Result = nativeOnly [] let private connectTimeoutRaw @@ -59,7 +58,9 @@ let private formatError (reason: Dynamic) : string = nativeOnly let connect (host: string) (port: int) (options: ConnectOptions) : Result = match options.connectTimeoutMs with | Some timeoutMs when timeoutMs < 0 -> Error "connect timeout must be non-negative" - | Some timeoutMs -> connectTimeoutRaw host port options.packetMode timeoutMs |> Result.mapError formatError + | Some timeoutMs -> + connectTimeoutRaw host port options.packetMode timeoutMs + |> Result.mapError formatError | None -> connectDefaultRaw host port options.packetMode |> Result.mapError formatError /// Connects a passive binary, line-delimited client using OTP's default timeout. diff --git a/src/otp/Port.fs b/src/otp/Port.fs index cf2eda9..d8c16d1 100644 --- a/src/otp/Port.fs +++ b/src/otp/Port.fs @@ -25,26 +25,30 @@ type PortMonitor = private PortMonitor of obj /// opts into OTP link semantics; it is false by default so an unexpected child /// exit cannot terminate the caller. type PortOptions = - { arguments: string list - maxLineLength: int - exitStatus: bool - useStdio: bool - stderrToStdout: bool - workingDirectory: string option - environment: (string * string) list - linkOwner: bool } + { + arguments: string list + maxLineLength: int + exitStatus: bool + useStdio: bool + stderrToStdout: bool + workingDirectory: string option + environment: (string * string) list + linkOwner: bool + } /// Safe defaults for a line-oriented stdin/stdout process connection. module PortOptions = let defaultOptions = - { arguments = [] - maxLineLength = 8192 - exitStatus = true - useStdio = true - stderrToStdout = false - workingDirectory = None - environment = [] - linkOwner = false } + { + arguments = [] + maxLineLength = 8192 + exitStatus = true + useStdio = true + stderrToStdout = false + workingDirectory = None + environment = [] + linkOwner = false + } /// A message delivered by a port opened with line mode. `ExitStatus` is /// delivered when `PortOptions.exitStatus` is enabled. @@ -112,9 +116,11 @@ let private launchOptions (options: PortOptions) = | Some path -> [ workingDirectoryOption path ] | None -> [] - [ binaryOption - lineOption options.maxLineLength - argumentsOption options.arguments ] + [ + binaryOption + lineOption options.maxLineLength + argumentsOption options.arguments + ] @ optional options.exitStatus exitStatusOption @ optional options.useStdio useStdioOption @ optional options.stderrToStdout stderrToStdoutOption diff --git a/src/otp/Supervisor.fs b/src/otp/Supervisor.fs index 81652c2..614e048 100644 --- a/src/otp/Supervisor.fs +++ b/src/otp/Supervisor.fs @@ -44,11 +44,13 @@ let shutdownInfinity: Shutdown = nativeOnly /// A child specification (map form). `Start` is the `{Module, Function, Args}` /// entry point that returns `{ok, Pid}`. Compiles to an Erlang child-spec map. type ChildSpec = - { Id: Atom - Start: Atom * Atom * obj list - Restart: Restart - Shutdown: Shutdown - Type: ChildType } + { + Id: Atom + Start: Atom * Atom * obj list + Restart: Restart + Shutdown: Shutdown + Type: ChildType + } // ============================================================================ // Supervisor reference diff --git a/test/Main.fs b/test/Main.fs index 121d804..07e3c20 100644 --- a/test/Main.fs +++ b/test/Main.fs @@ -10,31 +10,33 @@ open type Scriptorium.Quill.Runner [] let main _ = runTests - [ Timer.tests - Maps.tests - GenServer.tests - Base64.tests - Math.tests - Io.tests - IoLib.tests - Rand.tests - Proplists.tests - Binary.tests - Calendar.tests - GenTcp.tests - Distribution.tests - Queue.tests - Lists.tests - String.tests - Erlang.tests - Re.tests - Dynamic.tests - UriString.tests - Callbacks.tests - Os.tests - Port.tests - Supervisor.tests - Logger.tests - File.tests - Ets.tests - Jsx.tests ] + [ + Timer.tests + Maps.tests + GenServer.tests + Base64.tests + Math.tests + Io.tests + IoLib.tests + Rand.tests + Proplists.tests + Binary.tests + Calendar.tests + GenTcp.tests + Distribution.tests + Queue.tests + Lists.tests + String.tests + Erlang.tests + Re.tests + Dynamic.tests + UriString.tests + Callbacks.tests + Os.tests + Port.tests + Supervisor.tests + Logger.tests + File.tests + Ets.tests + Jsx.tests + ] diff --git a/test/TestBase64.fs b/test/TestBase64.fs index 85bbf1b..93602fa 100644 --- a/test/TestBase64.fs +++ b/test/TestBase64.fs @@ -12,63 +12,65 @@ module BBase64 = Fable.Beam.Base64 let tests = testList ( "Base64", - [ test ( - "encode produces non-empty string", - fun _ -> - let encoded = BBase64.encode "hello" - assertThat (encoded.Length > 0) (isTrue) - ) + [ + test ( + "encode produces non-empty string", + fun _ -> + let encoded = BBase64.encode "hello" + assertThat (encoded.Length > 0) (isTrue) + ) - test ("encode of hello", fun _ -> assertThat (BBase64.encode "hello") (isEqualTo "aGVsbG8=")) + test ("encode of hello", fun _ -> assertThat (BBase64.encode "hello") (isEqualTo "aGVsbG8=")) - test ("encode of empty string", fun _ -> assertThat (BBase64.encode "") (isEqualTo "")) + test ("encode of empty string", fun _ -> assertThat (BBase64.encode "") (isEqualTo "")) - test ( - "decode reverses encode", - fun _ -> - let original = "hello world" - let encoded = BBase64.encode original - let decoded = BBase64.decode encoded - assertThat decoded (isEqualTo original) - ) + test ( + "decode reverses encode", + fun _ -> + let original = "hello world" + let encoded = BBase64.encode original + let decoded = BBase64.decode encoded + assertThat decoded (isEqualTo original) + ) - test ("decode of known value", fun _ -> assertThat (BBase64.decode "aGVsbG8=") (isEqualTo "hello")) + test ("decode of known value", fun _ -> assertThat (BBase64.decode "aGVsbG8=") (isEqualTo "hello")) - test ( - "encode decode roundtrip with binary data", - fun _ -> - let data = "Fable.Beam rocks!" - let encoded = BBase64.encode data - let decoded = BBase64.decode encoded - assertThat decoded (isEqualTo data) - ) + test ( + "encode decode roundtrip with binary data", + fun _ -> + let data = "Fable.Beam rocks!" + let encoded = BBase64.encode data + let decoded = BBase64.decode encoded + assertThat decoded (isEqualTo data) + ) - test ( - "mime_decode handles whitespace", - fun _ -> - let encoded = BBase64.encode "hello" - let decoded = BBase64.mimeDecode encoded - assertThat decoded (isEqualTo "hello") - ) + test ( + "mime_decode handles whitespace", + fun _ -> + let encoded = BBase64.encode "hello" + let decoded = BBase64.mimeDecode encoded + assertThat decoded (isEqualTo "hello") + ) - test ( - "tryDecode returns Some for valid base64", - fun _ -> - let result = BBase64.tryDecode "aGVsbG8=" - assertThat result (isEqualTo (Some "hello")) - ) + test ( + "tryDecode returns Some for valid base64", + fun _ -> + let result = BBase64.tryDecode "aGVsbG8=" + assertThat result (isEqualTo (Some "hello")) + ) - test ( - "tryDecode returns None for invalid base64", - fun _ -> - let result = BBase64.tryDecode "not!valid@base64#" - assertThat result (isEqualTo None) - ) + test ( + "tryDecode returns None for invalid base64", + fun _ -> + let result = BBase64.tryDecode "not!valid@base64#" + assertThat result (isEqualTo None) + ) - test ( - "tryMimeDecode returns Some for valid input", - fun _ -> - let result = BBase64.tryMimeDecode "aGVsbG8=" - assertThat result (isEqualTo (Some "hello")) - ) ] + test ( + "tryMimeDecode returns Some for valid input", + fun _ -> + let result = BBase64.tryMimeDecode "aGVsbG8=" + assertThat result (isEqualTo (Some "hello")) + ) + ] ) diff --git a/test/TestBinary.fs b/test/TestBinary.fs index e524829..3fa53b4 100644 --- a/test/TestBinary.fs +++ b/test/TestBinary.fs @@ -15,181 +15,183 @@ module BLists = Fable.Beam.Lists let tests = testList ( "Binary", - [ test ( - "copy makes a copy", - fun _ -> - let b = "hello" - assertThat (BBinary.copy b) (isEqualTo "hello") - ) - - test ("copy N times concatenates", fun _ -> assertThat (BBinary.copyN "ab" 3) (isEqualTo "ababab")) - - test ( - "at returns byte at position", - fun _ -> - // 'A' = 65, 'B' = 66 - assertThat (BBinary.at "AB" 0) (isEqualTo 65) - assertThat (BBinary.at "AB" 1) (isEqualTo 66) - ) - - test ( - "first returns first byte", - fun _ -> - // 'h' = 104 - assertThat (BBinary.first "hello") (isEqualTo 104) - ) - - test ( - "last returns last byte", - fun _ -> - // 'o' = 111 - assertThat (BBinary.last "hello") (isEqualTo 111) - ) - - test ("part extracts subbinary", fun _ -> assertThat (BBinary.part "hello world" 6 5) (isEqualTo "world")) - - test ( - "matchFirst returns Some on match", - fun _ -> assertThat (BBinary.matchFirst "hello" "ll") (isEqualTo (Some(2, 2))) - ) - - test ( - "matchFirst returns None when not found", - fun _ -> assertThat (BBinary.matchFirst "hello" "xyz") (isEqualTo None) - ) - - test ( - "matchAll returns all occurrences", - fun _ -> - let results = BBinary.matchAll "abcabc" "b" - assertThat (Array.length results) (isEqualTo 2) - ) - - test ( - "splitFirst splits on first occurrence", - fun _ -> - let parts = BBinary.splitFirst "hello world" " " - assertThat (Array.length parts) (isEqualTo 2) - assertThat (parts.[0]) (isEqualTo "hello") - assertThat (parts.[1]) (isEqualTo "world") - ) - - test ( - "splitAll splits on all occurrences", - fun _ -> - let parts = BBinary.splitAll "a,b,c" "," - assertThat (Array.length parts) (isEqualTo 3) - assertThat (parts.[0]) (isEqualTo "a") - assertThat (parts.[1]) (isEqualTo "b") - assertThat (parts.[2]) (isEqualTo "c") - ) - - test ( - "replaceFirst replaces first occurrence", - fun _ -> assertThat (BBinary.replaceFirst "aabbaa" "aa" "XX") (isEqualTo "XXbbaa") - ) - - test ( - "replaceAll replaces all occurrences", - fun _ -> assertThat (BBinary.replaceAll "aabbaa" "aa" "XX") (isEqualTo "XXbbXX") - ) - - test ( - "longest_common_prefix", - fun _ -> - // "foo" is the longest prefix common to *all three* ("foobar"/"foobaz" share "fooba", - // but "fooqux" diverges at the 4th byte). - assertThat (BBinary.longestCommonPrefix [ "foobar"; "foobaz"; "fooqux" ]) (isEqualTo 3) - ) - - test ( - "longest_common_suffix", - fun _ -> assertThat (BBinary.longestCommonSuffix [ "foobar"; "bazbar"; "quuxbar" ]) (isEqualTo 3) - ) - - test ( - "bin_to_list returns list of bytes", - fun _ -> - // "ABC" = [65, 66, 67] - let bytes = BBinary.toByteList "ABC" - assertThat (BLists.nth 1 bytes) (isEqualTo 65) - assertThat (BLists.nth 2 bytes) (isEqualTo 66) - assertThat (BLists.nth 3 bytes) (isEqualTo 67) - ) - - test ( - "list_to_bin converts bytes to binary", - fun _ -> - // [104, 105] = "hi" - let bytes: BLists.BeamList = emitErlExpr () "[104, 105]" - assertThat (BBinary.ofByteList bytes) (isEqualTo "hi") - ) - - test ( - "bin_to_list and list_to_bin roundtrip", - fun _ -> - let original = "hello" - let bytes = BBinary.toByteList original - assertThat (BBinary.ofByteList bytes) (isEqualTo original) - ) - - test ( - "encode_unsigned and decode_unsigned roundtrip", - fun _ -> - let n = 12345 - let encoded = BBinary.encodeUnsigned n - assertThat (BBinary.decodeUnsigned encoded) (isEqualTo n) - ) - - test ( - "encode_unsigned of zero roundtrips", - fun _ -> - let encoded = BBinary.encodeUnsigned 0 - assertThat (BBinary.decodeUnsigned encoded) (isEqualTo 0) - ) - - test ( - "decode_unsigned with little endian", - fun _ -> - let little = Erlang.binaryToAtom "little" - let big = Erlang.binaryToAtom "big" - // Big-endian encoding of 256 is <<1, 0>>. - // Decoded as little-endian, those bytes read as 1. - let encoded_big = BBinary.encodeUnsignedWithEndianness 256 big - assertThat (BBinary.decodeUnsignedWithEndianness encoded_big little) (isEqualTo 1) - // Roundtrip via little endian preserves the value. - let encoded_little = BBinary.encodeUnsignedWithEndianness 256 little - assertThat (BBinary.decodeUnsignedWithEndianness encoded_little little) (isEqualTo 256) - ) - - test ( - "referenced_byte_size is at least the logical size", - fun _ -> - // referenced_byte_size reports the size of the *underlying* memory a (sub-)binary points into, - // which OTP's own docs call "a hint for optimization, not exact": for a plain binary it varies - // with how the binary was constructed and the OTP release (5 on OTP 25, 40 on OTP 27, 256 for a - // shell literal). The only portable guarantee is that it references at least what it contains. - let s = "hello" - assertThat (BBinary.referencedByteSize s >= Erlang.byteSize s) (isTrue) - assertThat (BBinary.referencedByteSize "" >= 0) (isTrue) - ) - - test ( - "splitAllRaw returns the native list form of splitAll", - fun _ -> - let parts: BLists.BeamList = BBinary.splitAllRaw "a-b-c" "-" - - let expected: BLists.BeamList = - emitErlExpr () "[<<\"a\">>, <<\"b\">>, <<\"c\">>]" - - assertThat parts (isEqualTo expected) - ) - - test ( - "splitFirstRaw returns the native list form of splitFirst", - fun _ -> - let parts: BLists.BeamList = BBinary.splitFirstRaw "a-b-c" "-" - let expected: BLists.BeamList = emitErlExpr () "[<<\"a\">>, <<\"b-c\">>]" - assertThat parts (isEqualTo expected) - ) ] + [ + test ( + "copy makes a copy", + fun _ -> + let b = "hello" + assertThat (BBinary.copy b) (isEqualTo "hello") + ) + + test ("copy N times concatenates", fun _ -> assertThat (BBinary.copyN "ab" 3) (isEqualTo "ababab")) + + test ( + "at returns byte at position", + fun _ -> + // 'A' = 65, 'B' = 66 + assertThat (BBinary.at "AB" 0) (isEqualTo 65) + assertThat (BBinary.at "AB" 1) (isEqualTo 66) + ) + + test ( + "first returns first byte", + fun _ -> + // 'h' = 104 + assertThat (BBinary.first "hello") (isEqualTo 104) + ) + + test ( + "last returns last byte", + fun _ -> + // 'o' = 111 + assertThat (BBinary.last "hello") (isEqualTo 111) + ) + + test ("part extracts subbinary", fun _ -> assertThat (BBinary.part "hello world" 6 5) (isEqualTo "world")) + + test ( + "matchFirst returns Some on match", + fun _ -> assertThat (BBinary.matchFirst "hello" "ll") (isEqualTo (Some(2, 2))) + ) + + test ( + "matchFirst returns None when not found", + fun _ -> assertThat (BBinary.matchFirst "hello" "xyz") (isEqualTo None) + ) + + test ( + "matchAll returns all occurrences", + fun _ -> + let results = BBinary.matchAll "abcabc" "b" + assertThat (Array.length results) (isEqualTo 2) + ) + + test ( + "splitFirst splits on first occurrence", + fun _ -> + let parts = BBinary.splitFirst "hello world" " " + assertThat (Array.length parts) (isEqualTo 2) + assertThat (parts.[0]) (isEqualTo "hello") + assertThat (parts.[1]) (isEqualTo "world") + ) + + test ( + "splitAll splits on all occurrences", + fun _ -> + let parts = BBinary.splitAll "a,b,c" "," + assertThat (Array.length parts) (isEqualTo 3) + assertThat (parts.[0]) (isEqualTo "a") + assertThat (parts.[1]) (isEqualTo "b") + assertThat (parts.[2]) (isEqualTo "c") + ) + + test ( + "replaceFirst replaces first occurrence", + fun _ -> assertThat (BBinary.replaceFirst "aabbaa" "aa" "XX") (isEqualTo "XXbbaa") + ) + + test ( + "replaceAll replaces all occurrences", + fun _ -> assertThat (BBinary.replaceAll "aabbaa" "aa" "XX") (isEqualTo "XXbbXX") + ) + + test ( + "longest_common_prefix", + fun _ -> + // "foo" is the longest prefix common to *all three* ("foobar"/"foobaz" share "fooba", + // but "fooqux" diverges at the 4th byte). + assertThat (BBinary.longestCommonPrefix [ "foobar"; "foobaz"; "fooqux" ]) (isEqualTo 3) + ) + + test ( + "longest_common_suffix", + fun _ -> assertThat (BBinary.longestCommonSuffix [ "foobar"; "bazbar"; "quuxbar" ]) (isEqualTo 3) + ) + + test ( + "bin_to_list returns list of bytes", + fun _ -> + // "ABC" = [65, 66, 67] + let bytes = BBinary.toByteList "ABC" + assertThat (BLists.nth 1 bytes) (isEqualTo 65) + assertThat (BLists.nth 2 bytes) (isEqualTo 66) + assertThat (BLists.nth 3 bytes) (isEqualTo 67) + ) + + test ( + "list_to_bin converts bytes to binary", + fun _ -> + // [104, 105] = "hi" + let bytes: BLists.BeamList = emitErlExpr () "[104, 105]" + assertThat (BBinary.ofByteList bytes) (isEqualTo "hi") + ) + + test ( + "bin_to_list and list_to_bin roundtrip", + fun _ -> + let original = "hello" + let bytes = BBinary.toByteList original + assertThat (BBinary.ofByteList bytes) (isEqualTo original) + ) + + test ( + "encode_unsigned and decode_unsigned roundtrip", + fun _ -> + let n = 12345 + let encoded = BBinary.encodeUnsigned n + assertThat (BBinary.decodeUnsigned encoded) (isEqualTo n) + ) + + test ( + "encode_unsigned of zero roundtrips", + fun _ -> + let encoded = BBinary.encodeUnsigned 0 + assertThat (BBinary.decodeUnsigned encoded) (isEqualTo 0) + ) + + test ( + "decode_unsigned with little endian", + fun _ -> + let little = Erlang.binaryToAtom "little" + let big = Erlang.binaryToAtom "big" + // Big-endian encoding of 256 is <<1, 0>>. + // Decoded as little-endian, those bytes read as 1. + let encoded_big = BBinary.encodeUnsignedWithEndianness 256 big + assertThat (BBinary.decodeUnsignedWithEndianness encoded_big little) (isEqualTo 1) + // Roundtrip via little endian preserves the value. + let encoded_little = BBinary.encodeUnsignedWithEndianness 256 little + assertThat (BBinary.decodeUnsignedWithEndianness encoded_little little) (isEqualTo 256) + ) + + test ( + "referenced_byte_size is at least the logical size", + fun _ -> + // referenced_byte_size reports the size of the *underlying* memory a (sub-)binary points into, + // which OTP's own docs call "a hint for optimization, not exact": for a plain binary it varies + // with how the binary was constructed and the OTP release (5 on OTP 25, 40 on OTP 27, 256 for a + // shell literal). The only portable guarantee is that it references at least what it contains. + let s = "hello" + assertThat (BBinary.referencedByteSize s >= Erlang.byteSize s) (isTrue) + assertThat (BBinary.referencedByteSize "" >= 0) (isTrue) + ) + + test ( + "splitAllRaw returns the native list form of splitAll", + fun _ -> + let parts: BLists.BeamList = BBinary.splitAllRaw "a-b-c" "-" + + let expected: BLists.BeamList = + emitErlExpr () "[<<\"a\">>, <<\"b\">>, <<\"c\">>]" + + assertThat parts (isEqualTo expected) + ) + + test ( + "splitFirstRaw returns the native list form of splitFirst", + fun _ -> + let parts: BLists.BeamList = BBinary.splitFirstRaw "a-b-c" "-" + let expected: BLists.BeamList = emitErlExpr () "[<<\"a\">>, <<\"b-c\">>]" + assertThat parts (isEqualTo expected) + ) + ] ) diff --git a/test/TestCalendar.fs b/test/TestCalendar.fs index 024d338..dafb388 100644 --- a/test/TestCalendar.fs +++ b/test/TestCalendar.fs @@ -13,264 +13,262 @@ module BCalendar = Fable.Beam.Calendar let tests = testList ( "Calendar", - [ test ("is_leap_year returns true for 2000", fun _ -> assertThat (BCalendar.isLeapYear 2000) (isTrue)) - - test ("is_leap_year returns true for 2024", fun _ -> assertThat (BCalendar.isLeapYear 2024) (isTrue)) - - test ( - "is_leap_year returns false for 1900", - fun _ -> - // 1900 is divisible by 100 but not 400 — not a leap year - assertThat (BCalendar.isLeapYear 1900) (isFalse) - ) - - test ("is_leap_year returns false for 2023", fun _ -> assertThat (BCalendar.isLeapYear 2023) (isFalse)) - - test ( - "last_day_of_the_month returns 31 for January", - fun _ -> assertThat (BCalendar.lastDayOfMonth 2024 1) (isEqualTo 31) - ) - - test ( - "last_day_of_the_month returns 29 for February in leap year", - fun _ -> assertThat (BCalendar.lastDayOfMonth 2024 2) (isEqualTo 29) - ) - - test ( - "last_day_of_the_month returns 28 for February in non-leap year", - fun _ -> assertThat (BCalendar.lastDayOfMonth 2023 2) (isEqualTo 28) - ) - - test ( - "last_day_of_the_month returns 30 for April", - fun _ -> assertThat (BCalendar.lastDayOfMonth 2024 4) (isEqualTo 30) - ) - - test ( - "day_of_the_week returns 1 for Monday", - fun _ -> - // 2024-01-01 is a Monday - assertThat (BCalendar.dayOfWeek 2024 1 1) (isEqualTo 1) - ) - - test ( - "day_of_the_week returns 7 for Sunday", - fun _ -> - // 2024-01-07 is a Sunday - assertThat (BCalendar.dayOfWeek 2024 1 7) (isEqualTo 7) - ) - - test ( - "day_of_the_week returns 5 for Friday", - fun _ -> - // 2024-01-05 is a Friday - assertThat (BCalendar.dayOfWeek 2024 1 5) (isEqualTo 5) - ) - - test ( - "date_to_gregorian_days for known date", - fun _ -> - // Erlang epoch: 0000-01-01. Days to 2000-01-01 = 730485 - assertThat (BCalendar.dateToGregorianDays 2000 1 1) (isEqualTo 730485) - ) - - test ( - "gregorian_days_to_date roundtrip", - fun _ -> - let days = BCalendar.dateToGregorianDays 2024 3 15 - let (y, m, d) = BCalendar.gregorianDaysToDate days - assertThat y (isEqualTo 2024) - assertThat m (isEqualTo 3) - assertThat d (isEqualTo 15) - ) - - test ( - "gregorian_days_to_date for known days", - fun _ -> - let (y, m, d) = BCalendar.gregorianDaysToDate 730485 - assertThat y (isEqualTo 2000) - assertThat m (isEqualTo 1) - assertThat d (isEqualTo 1) - ) - - test ("timeToSeconds midnight is zero", fun _ -> assertThat (BCalendar.timeToSeconds (0, 0, 0)) (isEqualTo 0)) - - test ( - "timeToSeconds for noon", - fun _ -> - // 12:00:00 = 12 * 3600 = 43200 seconds - assertThat (BCalendar.timeToSeconds (12, 0, 0)) (isEqualTo 43200) - ) - - test ( - "timeToSeconds for 1:30:30", - fun _ -> - // 1*3600 + 30*60 + 30 = 5430 - assertThat (BCalendar.timeToSeconds (1, 30, 30)) (isEqualTo 5430) - ) - - test ( - "secondsToTime roundtrip", - fun _ -> - let (h, m, s) = BCalendar.secondsToTime 5430 - assertThat h (isEqualTo 1) - assertThat m (isEqualTo 30) - assertThat s (isEqualTo 30) - ) - - test ( - "secondsToTime for noon", - fun _ -> - let (h, m, s) = BCalendar.secondsToTime 43200 - assertThat h (isEqualTo 12) - assertThat m (isEqualTo 0) - assertThat s (isEqualTo 0) - ) - - test ( - "datetimeToGregorianSeconds and back roundtrip", - fun _ -> - let dt: BCalendar.DateTime = (2024, 3, 15), (10, 30, 0) - let secs = BCalendar.datetimeToGregorianSeconds dt - let ((y, mo, d), (h, mi, s)) = BCalendar.gregorianSecondsToDateTime secs - assertThat y (isEqualTo 2024) - assertThat mo (isEqualTo 3) - assertThat d (isEqualTo 15) - assertThat h (isEqualTo 10) - assertThat mi (isEqualTo 30) - assertThat s (isEqualTo 0) - ) - - test ( - "datetimeToGregorianSeconds for known value", - fun _ -> - // 2000-01-01 00:00:00 = 730485 days * 86400 s/day = 63113904000 - let secs = BCalendar.datetimeToGregorianSeconds ((2000, 1, 1), (0, 0, 0)) - assertThat secs (isEqualTo 63113904000L) - ) - - test ( - "local_time returns plausible datetime", - fun _ -> - let ((y, mo, d), (h, mi, s)) = BCalendar.localTime () - assertThat (y >= 2024) (isTrue) - assertThat (mo >= 1 && mo <= 12) (isTrue) - assertThat (d >= 1 && d <= 31) (isTrue) - assertThat (h >= 0 && h <= 23) (isTrue) - assertThat (mi >= 0 && mi <= 59) (isTrue) - assertThat (s >= 0 && s <= 60) (isTrue) - ) - - test ( - "universal_time returns plausible datetime", - fun _ -> - let ((y, _, _), _) = BCalendar.universalTime () - assertThat (y >= 2024) (isTrue) - ) - - test ( - "localTimeToUniversalTime returns plausible datetime", - fun _ -> - let ((y, mo, d), (h, mi, s)) = - BCalendar.localTimeToUniversalTime ((2024, 6, 15), (12, 0, 0)) - // Crossing tz can shift the date by one day, so we allow the year to differ by 1. - assertThat (y >= 2023 && y <= 2025) (isTrue) - assertThat (mo >= 1 && mo <= 12) (isTrue) - assertThat (d >= 1 && d <= 31) (isTrue) - assertThat (h >= 0 && h <= 23) (isTrue) - assertThat (mi >= 0 && mi <= 59) (isTrue) - assertThat (s >= 0 && s <= 60) (isTrue) - ) - - test ( - "universalTimeToLocalTime returns plausible datetime", - fun _ -> - let ((y, mo, d), (h, mi, s)) = - BCalendar.universalTimeToLocalTime ((2024, 6, 15), (12, 0, 0)) - - assertThat (y >= 2023 && y <= 2025) (isTrue) - assertThat (mo >= 1 && mo <= 12) (isTrue) - assertThat (d >= 1 && d <= 31) (isTrue) - assertThat (h >= 0 && h <= 23) (isTrue) - assertThat (mi >= 0 && mi <= 59) (isTrue) - assertThat (s >= 0 && s <= 60) (isTrue) - ) - - test ( - "localTimeToUniversalTime then back roundtrips", - fun _ -> - let original: BCalendar.DateTime = (2024, 6, 15), (12, 0, 0) - let utc = BCalendar.localTimeToUniversalTime original - let roundtrip = BCalendar.universalTimeToLocalTime utc - assertThat roundtrip (isEqualTo original) - ) - - test ( - "system_time_to_universal_time for unix epoch", - fun _ -> - // Unix epoch 0 seconds = 1970-01-01 00:00:00 UTC - let ((y, mo, d), (h, mi, s)) = - BCalendar.systemTimeToUniversalTime 0L TimeUnit.Second - - assertThat y (isEqualTo 1970) - assertThat mo (isEqualTo 1) - assertThat d (isEqualTo 1) - assertThat h (isEqualTo 0) - assertThat mi (isEqualTo 0) - assertThat s (isEqualTo 0) - ) - - test ( - "system_time_to_universal_time for known second", - fun _ -> - // 1700000000 seconds since the Unix epoch = 2023-11-14 22:13:20 UTC - let ((y, mo, d), (h, mi, s)) = - BCalendar.systemTimeToUniversalTime 1700000000L TimeUnit.Second - - assertThat y (isEqualTo 2023) - assertThat mo (isEqualTo 11) - assertThat d (isEqualTo 14) - assertThat h (isEqualTo 22) - assertThat mi (isEqualTo 13) - assertThat s (isEqualTo 20) - ) - - test ( - "system_time_to_local_time returns plausible datetime", - fun _ -> - // Local time depends on the system time zone, so only assert structural validity. - let ((y, mo, d), (h, mi, s)) = - BCalendar.systemTimeToLocalTime 1700000000L TimeUnit.Second - - assertThat (y >= 2023 && y <= 2024) (isTrue) - assertThat (mo >= 1 && mo <= 12) (isTrue) - assertThat (d >= 1 && d <= 31) (isTrue) - assertThat (h >= 0 && h <= 23) (isTrue) - assertThat (mi >= 0 && mi <= 59) (isTrue) - assertThat (s >= 0 && s <= 60) (isTrue) - ) - - test ( - "localTimeToUniversalTimeDst represents gaps and overlaps", - fun _ -> - // The test runner starts the VM in Europe/Oslo because the - // runtime resolves its time zone when the VM starts. - let gap = - BCalendar.localTimeToUniversalTimeDst ((2024, 3, 31), (2, 30, 0)) - - let ordinary = - BCalendar.localTimeToUniversalTimeDst ((2024, 1, 15), (12, 0, 0)) - - let overlap = - BCalendar.localTimeToUniversalTimeDst ((2024, 10, 27), (2, 30, 0)) - - assertThat gap (isEqualTo []) - assertThat ordinary (isEqualTo [ ((2024, 1, 15), (11, 0, 0)) ]) - - assertThat - overlap - (isEqualTo - [ ((2024, 10, 27), (0, 30, 0)) - ((2024, 10, 27), (1, 30, 0)) ]) - ) ] + [ + test ("is_leap_year returns true for 2000", fun _ -> assertThat (BCalendar.isLeapYear 2000) (isTrue)) + + test ("is_leap_year returns true for 2024", fun _ -> assertThat (BCalendar.isLeapYear 2024) (isTrue)) + + test ( + "is_leap_year returns false for 1900", + fun _ -> + // 1900 is divisible by 100 but not 400 — not a leap year + assertThat (BCalendar.isLeapYear 1900) (isFalse) + ) + + test ("is_leap_year returns false for 2023", fun _ -> assertThat (BCalendar.isLeapYear 2023) (isFalse)) + + test ( + "last_day_of_the_month returns 31 for January", + fun _ -> assertThat (BCalendar.lastDayOfMonth 2024 1) (isEqualTo 31) + ) + + test ( + "last_day_of_the_month returns 29 for February in leap year", + fun _ -> assertThat (BCalendar.lastDayOfMonth 2024 2) (isEqualTo 29) + ) + + test ( + "last_day_of_the_month returns 28 for February in non-leap year", + fun _ -> assertThat (BCalendar.lastDayOfMonth 2023 2) (isEqualTo 28) + ) + + test ( + "last_day_of_the_month returns 30 for April", + fun _ -> assertThat (BCalendar.lastDayOfMonth 2024 4) (isEqualTo 30) + ) + + test ( + "day_of_the_week returns 1 for Monday", + fun _ -> + // 2024-01-01 is a Monday + assertThat (BCalendar.dayOfWeek 2024 1 1) (isEqualTo 1) + ) + + test ( + "day_of_the_week returns 7 for Sunday", + fun _ -> + // 2024-01-07 is a Sunday + assertThat (BCalendar.dayOfWeek 2024 1 7) (isEqualTo 7) + ) + + test ( + "day_of_the_week returns 5 for Friday", + fun _ -> + // 2024-01-05 is a Friday + assertThat (BCalendar.dayOfWeek 2024 1 5) (isEqualTo 5) + ) + + test ( + "date_to_gregorian_days for known date", + fun _ -> + // Erlang epoch: 0000-01-01. Days to 2000-01-01 = 730485 + assertThat (BCalendar.dateToGregorianDays 2000 1 1) (isEqualTo 730485) + ) + + test ( + "gregorian_days_to_date roundtrip", + fun _ -> + let days = BCalendar.dateToGregorianDays 2024 3 15 + let (y, m, d) = BCalendar.gregorianDaysToDate days + assertThat y (isEqualTo 2024) + assertThat m (isEqualTo 3) + assertThat d (isEqualTo 15) + ) + + test ( + "gregorian_days_to_date for known days", + fun _ -> + let (y, m, d) = BCalendar.gregorianDaysToDate 730485 + assertThat y (isEqualTo 2000) + assertThat m (isEqualTo 1) + assertThat d (isEqualTo 1) + ) + + test ( + "timeToSeconds midnight is zero", + fun _ -> assertThat (BCalendar.timeToSeconds (0, 0, 0)) (isEqualTo 0) + ) + + test ( + "timeToSeconds for noon", + fun _ -> + // 12:00:00 = 12 * 3600 = 43200 seconds + assertThat (BCalendar.timeToSeconds (12, 0, 0)) (isEqualTo 43200) + ) + + test ( + "timeToSeconds for 1:30:30", + fun _ -> + // 1*3600 + 30*60 + 30 = 5430 + assertThat (BCalendar.timeToSeconds (1, 30, 30)) (isEqualTo 5430) + ) + + test ( + "secondsToTime roundtrip", + fun _ -> + let (h, m, s) = BCalendar.secondsToTime 5430 + assertThat h (isEqualTo 1) + assertThat m (isEqualTo 30) + assertThat s (isEqualTo 30) + ) + + test ( + "secondsToTime for noon", + fun _ -> + let (h, m, s) = BCalendar.secondsToTime 43200 + assertThat h (isEqualTo 12) + assertThat m (isEqualTo 0) + assertThat s (isEqualTo 0) + ) + + test ( + "datetimeToGregorianSeconds and back roundtrip", + fun _ -> + let dt: BCalendar.DateTime = (2024, 3, 15), (10, 30, 0) + let secs = BCalendar.datetimeToGregorianSeconds dt + let ((y, mo, d), (h, mi, s)) = BCalendar.gregorianSecondsToDateTime secs + assertThat y (isEqualTo 2024) + assertThat mo (isEqualTo 3) + assertThat d (isEqualTo 15) + assertThat h (isEqualTo 10) + assertThat mi (isEqualTo 30) + assertThat s (isEqualTo 0) + ) + + test ( + "datetimeToGregorianSeconds for known value", + fun _ -> + // 2000-01-01 00:00:00 = 730485 days * 86400 s/day = 63113904000 + let secs = BCalendar.datetimeToGregorianSeconds ((2000, 1, 1), (0, 0, 0)) + assertThat secs (isEqualTo 63113904000L) + ) + + test ( + "local_time returns plausible datetime", + fun _ -> + let ((y, mo, d), (h, mi, s)) = BCalendar.localTime () + assertThat (y >= 2024) (isTrue) + assertThat (mo >= 1 && mo <= 12) (isTrue) + assertThat (d >= 1 && d <= 31) (isTrue) + assertThat (h >= 0 && h <= 23) (isTrue) + assertThat (mi >= 0 && mi <= 59) (isTrue) + assertThat (s >= 0 && s <= 60) (isTrue) + ) + + test ( + "universal_time returns plausible datetime", + fun _ -> + let ((y, _, _), _) = BCalendar.universalTime () + assertThat (y >= 2024) (isTrue) + ) + + test ( + "localTimeToUniversalTime returns plausible datetime", + fun _ -> + let ((y, mo, d), (h, mi, s)) = + BCalendar.localTimeToUniversalTime ((2024, 6, 15), (12, 0, 0)) + // Crossing tz can shift the date by one day, so we allow the year to differ by 1. + assertThat (y >= 2023 && y <= 2025) (isTrue) + assertThat (mo >= 1 && mo <= 12) (isTrue) + assertThat (d >= 1 && d <= 31) (isTrue) + assertThat (h >= 0 && h <= 23) (isTrue) + assertThat (mi >= 0 && mi <= 59) (isTrue) + assertThat (s >= 0 && s <= 60) (isTrue) + ) + + test ( + "universalTimeToLocalTime returns plausible datetime", + fun _ -> + let ((y, mo, d), (h, mi, s)) = + BCalendar.universalTimeToLocalTime ((2024, 6, 15), (12, 0, 0)) + + assertThat (y >= 2023 && y <= 2025) (isTrue) + assertThat (mo >= 1 && mo <= 12) (isTrue) + assertThat (d >= 1 && d <= 31) (isTrue) + assertThat (h >= 0 && h <= 23) (isTrue) + assertThat (mi >= 0 && mi <= 59) (isTrue) + assertThat (s >= 0 && s <= 60) (isTrue) + ) + + test ( + "localTimeToUniversalTime then back roundtrips", + fun _ -> + let original: BCalendar.DateTime = (2024, 6, 15), (12, 0, 0) + let utc = BCalendar.localTimeToUniversalTime original + let roundtrip = BCalendar.universalTimeToLocalTime utc + assertThat roundtrip (isEqualTo original) + ) + + test ( + "system_time_to_universal_time for unix epoch", + fun _ -> + // Unix epoch 0 seconds = 1970-01-01 00:00:00 UTC + let ((y, mo, d), (h, mi, s)) = + BCalendar.systemTimeToUniversalTime 0L TimeUnit.Second + + assertThat y (isEqualTo 1970) + assertThat mo (isEqualTo 1) + assertThat d (isEqualTo 1) + assertThat h (isEqualTo 0) + assertThat mi (isEqualTo 0) + assertThat s (isEqualTo 0) + ) + + test ( + "system_time_to_universal_time for known second", + fun _ -> + // 1700000000 seconds since the Unix epoch = 2023-11-14 22:13:20 UTC + let ((y, mo, d), (h, mi, s)) = + BCalendar.systemTimeToUniversalTime 1700000000L TimeUnit.Second + + assertThat y (isEqualTo 2023) + assertThat mo (isEqualTo 11) + assertThat d (isEqualTo 14) + assertThat h (isEqualTo 22) + assertThat mi (isEqualTo 13) + assertThat s (isEqualTo 20) + ) + + test ( + "system_time_to_local_time returns plausible datetime", + fun _ -> + // Local time depends on the system time zone, so only assert structural validity. + let ((y, mo, d), (h, mi, s)) = + BCalendar.systemTimeToLocalTime 1700000000L TimeUnit.Second + + assertThat (y >= 2023 && y <= 2024) (isTrue) + assertThat (mo >= 1 && mo <= 12) (isTrue) + assertThat (d >= 1 && d <= 31) (isTrue) + assertThat (h >= 0 && h <= 23) (isTrue) + assertThat (mi >= 0 && mi <= 59) (isTrue) + assertThat (s >= 0 && s <= 60) (isTrue) + ) + + test ( + "localTimeToUniversalTimeDst represents gaps and overlaps", + fun _ -> + // The test runner starts the VM in Europe/Oslo because the + // runtime resolves its time zone when the VM starts. + let gap = BCalendar.localTimeToUniversalTimeDst ((2024, 3, 31), (2, 30, 0)) + + let ordinary = BCalendar.localTimeToUniversalTimeDst ((2024, 1, 15), (12, 0, 0)) + + let overlap = BCalendar.localTimeToUniversalTimeDst ((2024, 10, 27), (2, 30, 0)) + + assertThat gap (isEqualTo []) + assertThat ordinary (isEqualTo [ ((2024, 1, 15), (11, 0, 0)) ]) + + assertThat overlap (isEqualTo [ ((2024, 10, 27), (0, 30, 0)); ((2024, 10, 27), (1, 30, 0)) ]) + ) + ] ) diff --git a/test/TestCallbacks.fs b/test/TestCallbacks.fs index a74cd2f..7cd1a25 100644 --- a/test/TestCallbacks.fs +++ b/test/TestCallbacks.fs @@ -52,50 +52,52 @@ let private nums () : Lists.BeamList = emitErlExpr () "[1, 2, 3]" let tests = testList ( "Callbacks", - [ test ( - "curried lambda literal reaches foldl as a 2-arity fun", - fun _ -> assertThat (foldlCurried (fun x acc -> x + acc) 0 (nums ())) (isEqualTo 6) - ) - - test ( - "System.Func callback behaves identically to the curried form", - fun _ -> assertThat (foldlFunc (System.Func<_, _, _>(fun x acc -> x + acc)) 0 (nums ())) (isEqualTo 6) - ) - - test ( - "named curried function reaches foldl as a 2-arity fun", - fun _ -> assertThat (foldlCurried addFn 0 (nums ())) (isEqualTo 6) - ) - - test ( - "curried function returned from a function keeps its arity", - fun _ -> - // Arity is not syntactically visible at the call site. - assertThat (foldlCurried (makeAdder ()) 0 (nums ())) (isEqualTo 6) - ) - - test ( - "partially applied function passes its remaining arity", - fun _ -> - // add3 10 has two arguments left, so it must arrive as a 2-arity fun. - assertThat (foldlCurried (add3 10) 0 (nums ())) (isEqualTo 36) - ) - - test ( - "callback boxed through an obj-typed parameter keeps its arity", - fun _ -> assertThat (foldlObj (box (fun x acc -> x + acc)) 0 (nums ())) (isEqualTo 6) - ) - - test ( - "ImportAll interface member takes a curried 2-arg callback", - fun _ -> assertThat (probeLists.foldl ((fun x acc -> x + acc), 0, nums ())) (isEqualTo 6) - ) - - test ( - "ImportAll interface member takes a curried 1-arg callback", - fun _ -> - let kept = probeLists.filter ((fun x -> x > 1), nums ()) - let n: int = emitErlExpr kept "erlang:length($0)" - assertThat n (isEqualTo 2) - ) ] + [ + test ( + "curried lambda literal reaches foldl as a 2-arity fun", + fun _ -> assertThat (foldlCurried (fun x acc -> x + acc) 0 (nums ())) (isEqualTo 6) + ) + + test ( + "System.Func callback behaves identically to the curried form", + fun _ -> assertThat (foldlFunc (System.Func<_, _, _>(fun x acc -> x + acc)) 0 (nums ())) (isEqualTo 6) + ) + + test ( + "named curried function reaches foldl as a 2-arity fun", + fun _ -> assertThat (foldlCurried addFn 0 (nums ())) (isEqualTo 6) + ) + + test ( + "curried function returned from a function keeps its arity", + fun _ -> + // Arity is not syntactically visible at the call site. + assertThat (foldlCurried (makeAdder ()) 0 (nums ())) (isEqualTo 6) + ) + + test ( + "partially applied function passes its remaining arity", + fun _ -> + // add3 10 has two arguments left, so it must arrive as a 2-arity fun. + assertThat (foldlCurried (add3 10) 0 (nums ())) (isEqualTo 36) + ) + + test ( + "callback boxed through an obj-typed parameter keeps its arity", + fun _ -> assertThat (foldlObj (box (fun x acc -> x + acc)) 0 (nums ())) (isEqualTo 6) + ) + + test ( + "ImportAll interface member takes a curried 2-arg callback", + fun _ -> assertThat (probeLists.foldl ((fun x acc -> x + acc), 0, nums ())) (isEqualTo 6) + ) + + test ( + "ImportAll interface member takes a curried 1-arg callback", + fun _ -> + let kept = probeLists.filter ((fun x -> x > 1), nums ()) + let n: int = emitErlExpr kept "erlang:length($0)" + assertThat n (isEqualTo 2) + ) + ] ) diff --git a/test/TestDynamic.fs b/test/TestDynamic.fs index 2a3de64..b75d8a5 100644 --- a/test/TestDynamic.fs +++ b/test/TestDynamic.fs @@ -11,166 +11,168 @@ open Fable.Beam let tests = testList ( "Dynamic", - [ test ( - "Decode.int succeeds on integer", - fun _ -> - let d: Dynamic = emitErlExpr () "42" - - match Decode.int d with - | Ok v -> assertThat v (isEqualTo 42) - | Error e -> failwithf "expected Ok, got Error %s" e - ) - - test ( - "Decode.int fails on non-integer", - fun _ -> - let d: Dynamic = emitErlExpr () "<<\"hello\">>" - - match Decode.int d with - | Ok _ -> failwith "expected Error" - | Error _ -> assertThat true (isTrue) - ) - - test ( - "Decode.string succeeds on binary", - fun _ -> - let d: Dynamic = emitErlExpr () "<<\"hello\">>" - - match Decode.string d with - | Ok v -> assertThat v (isEqualTo "hello") - | Error e -> failwithf "expected Ok, got Error %s" e - ) - - test ( - "Decode.atom succeeds on atom", - fun _ -> - let d: Dynamic = emitErlExpr () "ok" - - match Decode.atom d with - // don't compare Atom values across the boundary, just ensure decode succeeded - | Ok _ -> assertThat true (isTrue) - | Error e -> failwithf "expected Ok, got Error %s" e - ) - - test ( - "Decode.bool succeeds on true", - fun _ -> - let d: Dynamic = emitErlExpr () "true" - - match Decode.bool d with - | Ok v -> assertThat v (isEqualTo true) - | Error e -> failwithf "expected Ok, got Error %s" e - ) - - test ( - "Decode.field extracts map value", - fun _ -> - let d: Dynamic = emitErlExpr () "#{name => <<\"alice\">>, age => 30}" - let nameKey = Erlang.binaryToAtom "name" - let ageKey = Erlang.binaryToAtom "age" - - match Decode.field nameKey Decode.string d with - | Ok name -> assertThat name (isEqualTo "alice") - | Error e -> failwithf "expected Ok name, got Error %s" e - - match Decode.field ageKey Decode.int d with - | Ok age -> assertThat age (isEqualTo 30) - | Error e -> failwithf "expected Ok age, got Error %s" e - ) - - test ( - "Decode.field errors on missing key", - fun _ -> - let d: Dynamic = emitErlExpr () "#{name => <<\"alice\">>}" - let missingKey = Erlang.binaryToAtom "nonexistent" - - match Decode.field missingKey Decode.string d with - | Ok _ -> failwith "expected Error on missing field" - | Error _ -> assertThat true (isTrue) - ) - - test ( - "Decode.list decodes homogeneous list", - fun _ -> - let d: Dynamic = emitErlExpr () "[1, 2, 3, 4]" - - match Decode.list Decode.int d with - | Ok arr -> - assertThat (Array.length arr) (isEqualTo 4) - assertThat arr.[0] (isEqualTo 1) - assertThat arr.[3] (isEqualTo 4) - | Error e -> failwithf "expected Ok, got Error %s" e - ) - - test ( - "Decode.list short-circuits on first decode error", - fun _ -> - let d: Dynamic = emitErlExpr () "[1, 2, <<\"not_int\">>, 4]" - - match Decode.list Decode.int d with - | Ok _ -> failwith "expected Error" - | Error _ -> assertThat true (isTrue) - ) - - test ( - "Decode.optional returns None for undefined", - fun _ -> - let d: Dynamic = emitErlExpr () "undefined" - - match Decode.optional Decode.int d with - | Ok None -> assertThat true (isTrue) - | Ok(Some v) -> failwithf "expected None, got Some %d" v - | Error e -> failwithf "expected Ok None, got Error %s" e - ) - - test ( - "Decode.optional returns Some for value", - fun _ -> - let d: Dynamic = emitErlExpr () "42" - - match Decode.optional Decode.int d with - | Ok(Some v) -> assertThat v (isEqualTo 42) - | Ok None -> failwith "expected Some" - | Error e -> failwithf "expected Ok, got Error %s" e - ) - - test ( - "Decode.tuple2 decodes a pair", - fun _ -> - let d: Dynamic = emitErlExpr () "{<<\"alice\">>, 30}" - - match Decode.tuple2 Decode.string Decode.int d with - | Ok(name, age) -> - assertThat name (isEqualTo "alice") - assertThat age (isEqualTo 30) - | Error e -> failwithf "expected Ok, got Error %s" e - ) - - test ( - "Decode.field with Atom.ofString key finds an atom-keyed field", - fun _ -> - // Regression for the documented decoder example: the key must be a real atom. - // A binary key (what `Atom "name"` used to produce) never matches #{name => ...}. - let d: Dynamic = emitErlExpr () "#{name => <<\"alice\">>, age => 30}" - - match Decode.field (Atom.ofString "name") Decode.string d with - | Ok name -> assertThat name (isEqualTo "alice") - | Error e -> failwithf "expected Ok name, got Error %s" e - ) - - test ( - "Decode combinators accept a plain lambda decoder", - fun _ -> - // No System.Func wrapper: a single-argument F# function compiles to the - // 1-arity Erlang fun the Emit applies. - let d: Dynamic = emitErlExpr () "[1, 2, 3]" - let doubled = fun (x: Dynamic) -> Decode.int x |> Result.map (fun n -> n * 2) - - match Decode.list doubled d with - | Ok arr -> - assertThat (Array.length arr) (isEqualTo 3) - assertThat arr.[0] (isEqualTo 2) - assertThat arr.[2] (isEqualTo 6) - | Error e -> failwithf "expected Ok, got Error %s" e - ) ] + [ + test ( + "Decode.int succeeds on integer", + fun _ -> + let d: Dynamic = emitErlExpr () "42" + + match Decode.int d with + | Ok v -> assertThat v (isEqualTo 42) + | Error e -> failwithf "expected Ok, got Error %s" e + ) + + test ( + "Decode.int fails on non-integer", + fun _ -> + let d: Dynamic = emitErlExpr () "<<\"hello\">>" + + match Decode.int d with + | Ok _ -> failwith "expected Error" + | Error _ -> assertThat true (isTrue) + ) + + test ( + "Decode.string succeeds on binary", + fun _ -> + let d: Dynamic = emitErlExpr () "<<\"hello\">>" + + match Decode.string d with + | Ok v -> assertThat v (isEqualTo "hello") + | Error e -> failwithf "expected Ok, got Error %s" e + ) + + test ( + "Decode.atom succeeds on atom", + fun _ -> + let d: Dynamic = emitErlExpr () "ok" + + match Decode.atom d with + // don't compare Atom values across the boundary, just ensure decode succeeded + | Ok _ -> assertThat true (isTrue) + | Error e -> failwithf "expected Ok, got Error %s" e + ) + + test ( + "Decode.bool succeeds on true", + fun _ -> + let d: Dynamic = emitErlExpr () "true" + + match Decode.bool d with + | Ok v -> assertThat v (isEqualTo true) + | Error e -> failwithf "expected Ok, got Error %s" e + ) + + test ( + "Decode.field extracts map value", + fun _ -> + let d: Dynamic = emitErlExpr () "#{name => <<\"alice\">>, age => 30}" + let nameKey = Erlang.binaryToAtom "name" + let ageKey = Erlang.binaryToAtom "age" + + match Decode.field nameKey Decode.string d with + | Ok name -> assertThat name (isEqualTo "alice") + | Error e -> failwithf "expected Ok name, got Error %s" e + + match Decode.field ageKey Decode.int d with + | Ok age -> assertThat age (isEqualTo 30) + | Error e -> failwithf "expected Ok age, got Error %s" e + ) + + test ( + "Decode.field errors on missing key", + fun _ -> + let d: Dynamic = emitErlExpr () "#{name => <<\"alice\">>}" + let missingKey = Erlang.binaryToAtom "nonexistent" + + match Decode.field missingKey Decode.string d with + | Ok _ -> failwith "expected Error on missing field" + | Error _ -> assertThat true (isTrue) + ) + + test ( + "Decode.list decodes homogeneous list", + fun _ -> + let d: Dynamic = emitErlExpr () "[1, 2, 3, 4]" + + match Decode.list Decode.int d with + | Ok arr -> + assertThat (Array.length arr) (isEqualTo 4) + assertThat arr.[0] (isEqualTo 1) + assertThat arr.[3] (isEqualTo 4) + | Error e -> failwithf "expected Ok, got Error %s" e + ) + + test ( + "Decode.list short-circuits on first decode error", + fun _ -> + let d: Dynamic = emitErlExpr () "[1, 2, <<\"not_int\">>, 4]" + + match Decode.list Decode.int d with + | Ok _ -> failwith "expected Error" + | Error _ -> assertThat true (isTrue) + ) + + test ( + "Decode.optional returns None for undefined", + fun _ -> + let d: Dynamic = emitErlExpr () "undefined" + + match Decode.optional Decode.int d with + | Ok None -> assertThat true (isTrue) + | Ok(Some v) -> failwithf "expected None, got Some %d" v + | Error e -> failwithf "expected Ok None, got Error %s" e + ) + + test ( + "Decode.optional returns Some for value", + fun _ -> + let d: Dynamic = emitErlExpr () "42" + + match Decode.optional Decode.int d with + | Ok(Some v) -> assertThat v (isEqualTo 42) + | Ok None -> failwith "expected Some" + | Error e -> failwithf "expected Ok, got Error %s" e + ) + + test ( + "Decode.tuple2 decodes a pair", + fun _ -> + let d: Dynamic = emitErlExpr () "{<<\"alice\">>, 30}" + + match Decode.tuple2 Decode.string Decode.int d with + | Ok(name, age) -> + assertThat name (isEqualTo "alice") + assertThat age (isEqualTo 30) + | Error e -> failwithf "expected Ok, got Error %s" e + ) + + test ( + "Decode.field with Atom.ofString key finds an atom-keyed field", + fun _ -> + // Regression for the documented decoder example: the key must be a real atom. + // A binary key (what `Atom "name"` used to produce) never matches #{name => ...}. + let d: Dynamic = emitErlExpr () "#{name => <<\"alice\">>, age => 30}" + + match Decode.field (Atom.ofString "name") Decode.string d with + | Ok name -> assertThat name (isEqualTo "alice") + | Error e -> failwithf "expected Ok name, got Error %s" e + ) + + test ( + "Decode combinators accept a plain lambda decoder", + fun _ -> + // No System.Func wrapper: a single-argument F# function compiles to the + // 1-arity Erlang fun the Emit applies. + let d: Dynamic = emitErlExpr () "[1, 2, 3]" + let doubled = fun (x: Dynamic) -> Decode.int x |> Result.map (fun n -> n * 2) + + match Decode.list doubled d with + | Ok arr -> + assertThat (Array.length arr) (isEqualTo 3) + assertThat arr.[0] (isEqualTo 2) + assertThat arr.[2] (isEqualTo 6) + | Error e -> failwithf "expected Ok, got Error %s" e + ) + ] ) diff --git a/test/TestErlang.fs b/test/TestErlang.fs index 5b9e46e..d1f0355 100644 --- a/test/TestErlang.fs +++ b/test/TestErlang.fs @@ -16,333 +16,335 @@ type RecvMsg = let tests = testList ( "Erlang", - [ test ( - "self returns a pid", - fun _ -> - let pid = Erlang.self () - let isAlive = Erlang.isProcessAlive pid - assertThat isAlive (isTrue) - ) - - test ( - "makeRef returns unique references", - fun _ -> - let ref1 = Erlang.makeRef () - let ref2 = Erlang.makeRef () - assertThat (Erlang.exactEquals ref1 ref2) (isFalse) - ) - - test ( - "exactEquals on same ref", - fun _ -> - let ref1 = Erlang.makeRef () - assertThat (Erlang.exactEquals ref1 ref1) (isTrue) - ) - - test ( - "spawn creates a process", - fun _ -> - let pid = Erlang.spawn (fun () -> ()) - assertThat (Erlang.isProcessAlive pid) (isTrue) - ) - - test ( - "spawnLink creates a linked process", - fun _ -> - let pid = Erlang.spawnLink (fun () -> ()) - assertThat (Erlang.isProcessAlive pid) (isTrue) - ) - - test ( - "isProcessAlive on self", - fun _ -> - let pid = Erlang.self () - assertThat (Erlang.isProcessAlive pid) (isTrue) - ) - - test ( - "process dictionary get/put/erase", - fun _ -> - let key = Erlang.makeRef () - Erlang.put key (box 42) |> ignore - - match Erlang.get key with - | Some v -> assertThat v (isEqualTo (box 42)) - | None -> failwith "process dict key should be set" - - Erlang.erase key |> ignore - ) - - test ( - "send and receive", - fun _ -> - // A nullary DU case compiles to a bare atom (`ping`), not a 1-tuple (`{ping}`) -- only a - // case *with* fields becomes a tagged tuple, e.g. `Data 42` -> `{data, 42}`. Sending - // `{ping}` here never matched the generated receive clause, so this test used to sit out - // the full 1000ms timeout and take the None branch. - emitErlExpr () "erlang:self() ! ping" - - match Erlang.receive 1000 with - | Some Ping -> assertThat true (isTrue) - | _ -> failwith "expected to receive the ping message" - ) - - test ( - "receive with timeout returns None", - fun _ -> - match Erlang.receive 0 with - | None -> assertThat true (isTrue) - | Some _ -> failwith "expected a timeout" - ) - - test ( - "receive with data", - fun _ -> - emitErlExpr () "erlang:self() ! {data, 42}" - - match Erlang.receive 1000 with - | Some(Data v) -> assertThat v (isEqualTo 42) - | _ -> failwith "expected to receive the data message" - ) - - test ( - "sendAfter and cancelTimer", - fun _ -> - let timerRef = Erlang.sendAfter 60000 (box "should_not_arrive") - - match Erlang.cancelTimer timerRef with - | Some remaining -> assertThat (remaining > 0) (isTrue) - | None -> failwith "expected cancelTimer to return the remaining time" - ) - - test ( - "atomToBinary and binaryToAtom roundtrip", - fun _ -> - let atom = Erlang.binaryToAtom "test_atom" - let str = Erlang.atomToBinary atom - assertThat str (isEqualTo "test_atom") - ) - - test ( - "monitor and demonitor", - fun _ -> - let pid = Erlang.spawn (fun () -> Fable.Beam.Timer.sleep 60000) - let ref = Erlang.monitor pid - Erlang.demonitorFlush ref - Erlang.exitPid pid (box "kill") - ) - - test ( - "register and whereis", - fun _ -> - let name = Erlang.binaryToAtom "fable_beam_test_proc" - let pid = Erlang.self () - Erlang.register name pid - - match Erlang.whereis name with - | Some found -> assertThat (Erlang.exactEquals pid found) (isTrue) - | None -> failwith "whereis should find the registered process" - ) - - test ( - "date returns valid year month day", - fun _ -> - let (year, month, day) = Erlang.date () - assertThat (year >= 2025) (isTrue) - assertThat (month >= 1 && month <= 12) (isTrue) - assertThat (day >= 1 && day <= 31) (isTrue) - ) - - test ( - "dateYear dateMonth dateDay match date", - fun _ -> - let (year, month, day) = Erlang.date () - assertThat (Erlang.dateYear ()) (isEqualTo year) - assertThat (Erlang.dateMonth ()) (isEqualTo month) - assertThat (Erlang.dateDay ()) (isEqualTo day) - ) - - test ( - "time returns valid hour minute second", - fun _ -> - let (hour, minute, second) = Erlang.time () - assertThat (hour >= 0 && hour <= 23) (isTrue) - assertThat (minute >= 0 && minute <= 59) (isTrue) - assertThat (second >= 0 && second <= 59) (isTrue) - ) - - test ( - "localtime returns valid date and time", - fun _ -> - let ((year, month, day), (hour, minute, second)) = Erlang.localtime () - assertThat (year >= 2025) (isTrue) - assertThat (month >= 1 && month <= 12) (isTrue) - assertThat (day >= 1 && day <= 31) (isTrue) - assertThat (hour >= 0 && hour <= 23) (isTrue) - assertThat (minute >= 0 && minute <= 59) (isTrue) - assertThat (second >= 0 && second <= 59) (isTrue) - ) - - test ( - "universaltime returns valid date and time", - fun _ -> - let ((year, month, day), (hour, minute, second)) = Erlang.universaltime () - assertThat (year >= 2025) (isTrue) - assertThat (month >= 1 && month <= 12) (isTrue) - assertThat (day >= 1 && day <= 31) (isTrue) - assertThat (hour >= 0 && hour <= 23) (isTrue) - assertThat (minute >= 0 && minute <= 59) (isTrue) - assertThat (second >= 0 && second <= 59) (isTrue) - ) - - test ( - "monotonicTimeMs returns positive", - fun _ -> - let t1 = Erlang.monotonicTimeMs () - let t2 = Erlang.monotonicTimeMs () - assertThat (t2 >= t1) (isTrue) - ) - - test ( - "whereis returns None for unregistered name", - fun _ -> - let name = Erlang.binaryToAtom "fable_beam_nonexistent_12345" - assertThat (Erlang.whereis name) (isEqualTo None) - ) - - test ( - "trapExit returns old value", - fun _ -> - let old1 = Erlang.trapExit () - // Second call should return true since we just set it - let old2 = Erlang.trapExit () - assertThat old2 (isTrue) - // Reset: set trap_exit back to false - Erlang.processFlag (Erlang.binaryToAtom "trap_exit") (box false) |> ignore - ) - - test ( - "cancelTimer returns None for invalid ref", - fun _ -> - let fakeRef = Erlang.makeRef () - // cancelTimer on a non-timer ref returns None (false in Erlang). - let timerRef = Erlang.sendAfter 60000 (box "test") - - match Erlang.cancelTimer timerRef with - | Some ms -> assertThat (ms >= 0) (isTrue) - | None -> failwith "expected cancelTimer to return the remaining time" - // Cancelling again should return None - assertThat (Erlang.cancelTimer timerRef) (isEqualTo None) - ) - - test ( - "sendAfterTo sends to specific pid", - fun _ -> - let pid = Erlang.self () - let timerRef = Erlang.sendAfterTo 60000 pid (box "msg") - - match Erlang.cancelTimer timerRef with - | Some _ -> assertThat true (isTrue) - | None -> failwith "expected cancelTimer to succeed" - ) - - test ( - "byteSize returns correct size", - fun _ -> - assertThat (Erlang.byteSize "hello") (isEqualTo 5) - assertThat (Erlang.byteSize "") (isEqualTo 0) - assertThat (Erlang.byteSize "abc") (isEqualTo 3) - ) - - test ( - "atomToList returns charlist not binary", - fun _ -> - let atom = Erlang.binaryToAtom "test" - let charlist = Erlang.atomToList atom - // atomToList returns a charlist (Erlang list of integers), - // which is not the same as an F# string (binary). - // We verify by round-tripping through listToAtom. - let atom2 = Erlang.listToAtom charlist - assertThat (Erlang.atomToBinary atom2) (isEqualTo "test") - ) - - test ( - "binaryToList returns list of bytes", - fun _ -> - let bytes = Erlang.binaryToList "ABC" - assertThat (Erlang.length bytes) (isEqualTo 3) - assertThat (Erlang.head bytes) (isEqualTo 65) - ) - - test ( - "binaryToList and listToBinary roundtrip", - fun _ -> - let original = "hello" - let bytes = Erlang.binaryToList original - assertThat (Erlang.listToBinary bytes) (isEqualTo original) - ) - - test ( - "isEmpty returns true for empty list", - fun _ -> - let empty: BeamList = emitErlExpr () "[]" - assertThat (Erlang.isEmpty empty) (isTrue) - ) - - test ( - "isEmpty returns false for non-empty list", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3]" - assertThat (Erlang.isEmpty xs) (isFalse) - ) - - test ( - "head returns first element", - fun _ -> - let xs: BeamList = emitErlExpr () "[42, 2, 3]" - assertThat (Erlang.head xs) (isEqualTo 42) - ) - - test ( - "head preserves element type with tuples", - fun _ -> - let xs: BeamList = emitErlExpr () "[{1, <<\"a\">>}, {2, <<\"b\">>}]" - let (n, s) = Erlang.head xs - assertThat n (isEqualTo 1) - assertThat s (isEqualTo "a") - ) - - test ( - "tail returns rest of list", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3]" - let tl = Erlang.tail xs - assertThat (Erlang.head tl) (isEqualTo 2) - assertThat (Erlang.isEmpty (Erlang.tail tl |> Erlang.tail)) (isTrue) - ) - - test ( - "head raises on empty list", - fun _ -> - let empty: BeamList = emitErlExpr () "[]" - assertThat (fun () -> Erlang.head empty |> ignore) throws - ) - - test ( - "tail raises on empty list", - fun _ -> - let empty: BeamList = emitErlExpr () "[]" - assertThat (fun () -> Erlang.tail empty |> ignore) throws - ) - - test ( - "Atom.ofString builds a real atom, not a binary", - fun _ -> - // Regression: the erased `Atom` constructor used to be public, so `Atom "x"` - // compiled to the binary <<"x">> and silently failed to match atom-keyed terms. - let a = Atom.ofString "test_real_atom" - let isAtom: bool = emitErlExpr a "erlang:is_atom($0)" - assertThat isAtom (isTrue) - assertThat (Atom.toString a) (isEqualTo "test_real_atom") - ) ] + [ + test ( + "self returns a pid", + fun _ -> + let pid = Erlang.self () + let isAlive = Erlang.isProcessAlive pid + assertThat isAlive (isTrue) + ) + + test ( + "makeRef returns unique references", + fun _ -> + let ref1 = Erlang.makeRef () + let ref2 = Erlang.makeRef () + assertThat (Erlang.exactEquals ref1 ref2) (isFalse) + ) + + test ( + "exactEquals on same ref", + fun _ -> + let ref1 = Erlang.makeRef () + assertThat (Erlang.exactEquals ref1 ref1) (isTrue) + ) + + test ( + "spawn creates a process", + fun _ -> + let pid = Erlang.spawn (fun () -> ()) + assertThat (Erlang.isProcessAlive pid) (isTrue) + ) + + test ( + "spawnLink creates a linked process", + fun _ -> + let pid = Erlang.spawnLink (fun () -> ()) + assertThat (Erlang.isProcessAlive pid) (isTrue) + ) + + test ( + "isProcessAlive on self", + fun _ -> + let pid = Erlang.self () + assertThat (Erlang.isProcessAlive pid) (isTrue) + ) + + test ( + "process dictionary get/put/erase", + fun _ -> + let key = Erlang.makeRef () + Erlang.put key (box 42) |> ignore + + match Erlang.get key with + | Some v -> assertThat v (isEqualTo (box 42)) + | None -> failwith "process dict key should be set" + + Erlang.erase key |> ignore + ) + + test ( + "send and receive", + fun _ -> + // A nullary DU case compiles to a bare atom (`ping`), not a 1-tuple (`{ping}`) -- only a + // case *with* fields becomes a tagged tuple, e.g. `Data 42` -> `{data, 42}`. Sending + // `{ping}` here never matched the generated receive clause, so this test used to sit out + // the full 1000ms timeout and take the None branch. + emitErlExpr () "erlang:self() ! ping" + + match Erlang.receive 1000 with + | Some Ping -> assertThat true (isTrue) + | _ -> failwith "expected to receive the ping message" + ) + + test ( + "receive with timeout returns None", + fun _ -> + match Erlang.receive 0 with + | None -> assertThat true (isTrue) + | Some _ -> failwith "expected a timeout" + ) + + test ( + "receive with data", + fun _ -> + emitErlExpr () "erlang:self() ! {data, 42}" + + match Erlang.receive 1000 with + | Some(Data v) -> assertThat v (isEqualTo 42) + | _ -> failwith "expected to receive the data message" + ) + + test ( + "sendAfter and cancelTimer", + fun _ -> + let timerRef = Erlang.sendAfter 60000 (box "should_not_arrive") + + match Erlang.cancelTimer timerRef with + | Some remaining -> assertThat (remaining > 0) (isTrue) + | None -> failwith "expected cancelTimer to return the remaining time" + ) + + test ( + "atomToBinary and binaryToAtom roundtrip", + fun _ -> + let atom = Erlang.binaryToAtom "test_atom" + let str = Erlang.atomToBinary atom + assertThat str (isEqualTo "test_atom") + ) + + test ( + "monitor and demonitor", + fun _ -> + let pid = Erlang.spawn (fun () -> Fable.Beam.Timer.sleep 60000) + let ref = Erlang.monitor pid + Erlang.demonitorFlush ref + Erlang.exitPid pid (box "kill") + ) + + test ( + "register and whereis", + fun _ -> + let name = Erlang.binaryToAtom "fable_beam_test_proc" + let pid = Erlang.self () + Erlang.register name pid + + match Erlang.whereis name with + | Some found -> assertThat (Erlang.exactEquals pid found) (isTrue) + | None -> failwith "whereis should find the registered process" + ) + + test ( + "date returns valid year month day", + fun _ -> + let (year, month, day) = Erlang.date () + assertThat (year >= 2025) (isTrue) + assertThat (month >= 1 && month <= 12) (isTrue) + assertThat (day >= 1 && day <= 31) (isTrue) + ) + + test ( + "dateYear dateMonth dateDay match date", + fun _ -> + let (year, month, day) = Erlang.date () + assertThat (Erlang.dateYear ()) (isEqualTo year) + assertThat (Erlang.dateMonth ()) (isEqualTo month) + assertThat (Erlang.dateDay ()) (isEqualTo day) + ) + + test ( + "time returns valid hour minute second", + fun _ -> + let (hour, minute, second) = Erlang.time () + assertThat (hour >= 0 && hour <= 23) (isTrue) + assertThat (minute >= 0 && minute <= 59) (isTrue) + assertThat (second >= 0 && second <= 59) (isTrue) + ) + + test ( + "localtime returns valid date and time", + fun _ -> + let ((year, month, day), (hour, minute, second)) = Erlang.localtime () + assertThat (year >= 2025) (isTrue) + assertThat (month >= 1 && month <= 12) (isTrue) + assertThat (day >= 1 && day <= 31) (isTrue) + assertThat (hour >= 0 && hour <= 23) (isTrue) + assertThat (minute >= 0 && minute <= 59) (isTrue) + assertThat (second >= 0 && second <= 59) (isTrue) + ) + + test ( + "universaltime returns valid date and time", + fun _ -> + let ((year, month, day), (hour, minute, second)) = Erlang.universaltime () + assertThat (year >= 2025) (isTrue) + assertThat (month >= 1 && month <= 12) (isTrue) + assertThat (day >= 1 && day <= 31) (isTrue) + assertThat (hour >= 0 && hour <= 23) (isTrue) + assertThat (minute >= 0 && minute <= 59) (isTrue) + assertThat (second >= 0 && second <= 59) (isTrue) + ) + + test ( + "monotonicTimeMs returns positive", + fun _ -> + let t1 = Erlang.monotonicTimeMs () + let t2 = Erlang.monotonicTimeMs () + assertThat (t2 >= t1) (isTrue) + ) + + test ( + "whereis returns None for unregistered name", + fun _ -> + let name = Erlang.binaryToAtom "fable_beam_nonexistent_12345" + assertThat (Erlang.whereis name) (isEqualTo None) + ) + + test ( + "trapExit returns old value", + fun _ -> + let old1 = Erlang.trapExit () + // Second call should return true since we just set it + let old2 = Erlang.trapExit () + assertThat old2 (isTrue) + // Reset: set trap_exit back to false + Erlang.processFlag (Erlang.binaryToAtom "trap_exit") (box false) |> ignore + ) + + test ( + "cancelTimer returns None for invalid ref", + fun _ -> + let fakeRef = Erlang.makeRef () + // cancelTimer on a non-timer ref returns None (false in Erlang). + let timerRef = Erlang.sendAfter 60000 (box "test") + + match Erlang.cancelTimer timerRef with + | Some ms -> assertThat (ms >= 0) (isTrue) + | None -> failwith "expected cancelTimer to return the remaining time" + // Cancelling again should return None + assertThat (Erlang.cancelTimer timerRef) (isEqualTo None) + ) + + test ( + "sendAfterTo sends to specific pid", + fun _ -> + let pid = Erlang.self () + let timerRef = Erlang.sendAfterTo 60000 pid (box "msg") + + match Erlang.cancelTimer timerRef with + | Some _ -> assertThat true (isTrue) + | None -> failwith "expected cancelTimer to succeed" + ) + + test ( + "byteSize returns correct size", + fun _ -> + assertThat (Erlang.byteSize "hello") (isEqualTo 5) + assertThat (Erlang.byteSize "") (isEqualTo 0) + assertThat (Erlang.byteSize "abc") (isEqualTo 3) + ) + + test ( + "atomToList returns charlist not binary", + fun _ -> + let atom = Erlang.binaryToAtom "test" + let charlist = Erlang.atomToList atom + // atomToList returns a charlist (Erlang list of integers), + // which is not the same as an F# string (binary). + // We verify by round-tripping through listToAtom. + let atom2 = Erlang.listToAtom charlist + assertThat (Erlang.atomToBinary atom2) (isEqualTo "test") + ) + + test ( + "binaryToList returns list of bytes", + fun _ -> + let bytes = Erlang.binaryToList "ABC" + assertThat (Erlang.length bytes) (isEqualTo 3) + assertThat (Erlang.head bytes) (isEqualTo 65) + ) + + test ( + "binaryToList and listToBinary roundtrip", + fun _ -> + let original = "hello" + let bytes = Erlang.binaryToList original + assertThat (Erlang.listToBinary bytes) (isEqualTo original) + ) + + test ( + "isEmpty returns true for empty list", + fun _ -> + let empty: BeamList = emitErlExpr () "[]" + assertThat (Erlang.isEmpty empty) (isTrue) + ) + + test ( + "isEmpty returns false for non-empty list", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3]" + assertThat (Erlang.isEmpty xs) (isFalse) + ) + + test ( + "head returns first element", + fun _ -> + let xs: BeamList = emitErlExpr () "[42, 2, 3]" + assertThat (Erlang.head xs) (isEqualTo 42) + ) + + test ( + "head preserves element type with tuples", + fun _ -> + let xs: BeamList = emitErlExpr () "[{1, <<\"a\">>}, {2, <<\"b\">>}]" + let (n, s) = Erlang.head xs + assertThat n (isEqualTo 1) + assertThat s (isEqualTo "a") + ) + + test ( + "tail returns rest of list", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3]" + let tl = Erlang.tail xs + assertThat (Erlang.head tl) (isEqualTo 2) + assertThat (Erlang.isEmpty (Erlang.tail tl |> Erlang.tail)) (isTrue) + ) + + test ( + "head raises on empty list", + fun _ -> + let empty: BeamList = emitErlExpr () "[]" + assertThat (fun () -> Erlang.head empty |> ignore) throws + ) + + test ( + "tail raises on empty list", + fun _ -> + let empty: BeamList = emitErlExpr () "[]" + assertThat (fun () -> Erlang.tail empty |> ignore) throws + ) + + test ( + "Atom.ofString builds a real atom, not a binary", + fun _ -> + // Regression: the erased `Atom` constructor used to be public, so `Atom "x"` + // compiled to the binary <<"x">> and silently failed to match atom-keyed terms. + let a = Atom.ofString "test_real_atom" + let isAtom: bool = emitErlExpr a "erlang:is_atom($0)" + assertThat isAtom (isTrue) + assertThat (Atom.toString a) (isEqualTo "test_real_atom") + ) + ] ) diff --git a/test/TestEts.fs b/test/TestEts.fs index 1915857..3b73e65 100644 --- a/test/TestEts.fs +++ b/test/TestEts.fs @@ -13,67 +13,69 @@ module BEts = Fable.Beam.Ets let tests = testList ( "Ets", - [ test ( - "ets create and delete", - fun _ -> - let table = - BEts.create (Erlang.binaryToAtom "test_table") [ Erlang.binaryToAtom "set" ] + [ + test ( + "ets create and delete", + fun _ -> + let table = + BEts.create (Erlang.binaryToAtom "test_table") [ Erlang.binaryToAtom "set" ] - BEts.delete table - ) + BEts.delete table + ) - test ( - "ets insert and lookup", - fun _ -> - let table = - BEts.create (Erlang.binaryToAtom "lookup_table") [ Erlang.binaryToAtom "set" ] + test ( + "ets insert and lookup", + fun _ -> + let table = + BEts.create (Erlang.binaryToAtom "lookup_table") [ Erlang.binaryToAtom "set" ] - let tuple: obj = emitErlExpr () "{1, <<\"hello\">>}" - assertThat (BEts.insert table tuple) (isTrue) - let result = BEts.lookup table (box 1) - assertThat (Array.length result) (isEqualTo 1) - BEts.delete table - ) + let tuple: obj = emitErlExpr () "{1, <<\"hello\">>}" + assertThat (BEts.insert table tuple) (isTrue) + let result = BEts.lookup table (box 1) + assertThat (Array.length result) (isEqualTo 1) + BEts.delete table + ) - test ( - "ets tab2list", - fun _ -> - let table = - BEts.create (Erlang.binaryToAtom "list_table") [ Erlang.binaryToAtom "set" ] + test ( + "ets tab2list", + fun _ -> + let table = + BEts.create (Erlang.binaryToAtom "list_table") [ Erlang.binaryToAtom "set" ] - let t1: obj = emitErlExpr () "{1, <<\"a\">>}" - let t2: obj = emitErlExpr () "{2, <<\"b\">>}" - BEts.insert table t1 |> ignore - BEts.insert table t2 |> ignore - let all = BEts.toArray table - assertThat (Array.length all) (isEqualTo 2) - BEts.delete table - ) + let t1: obj = emitErlExpr () "{1, <<\"a\">>}" + let t2: obj = emitErlExpr () "{2, <<\"b\">>}" + BEts.insert table t1 |> ignore + BEts.insert table t2 |> ignore + let all = BEts.toArray table + assertThat (Array.length all) (isEqualTo 2) + BEts.delete table + ) - test ( - "ets typed info accessors", - fun _ -> - let table = - BEts.create (Erlang.binaryToAtom "info_table") [ Erlang.binaryToAtom "set" ] + test ( + "ets typed info accessors", + fun _ -> + let table = + BEts.create (Erlang.binaryToAtom "info_table") [ Erlang.binaryToAtom "set" ] - let tuple: obj = emitErlExpr () "{1, <<\"hello\">>}" - BEts.insert table tuple |> ignore + let tuple: obj = emitErlExpr () "{1, <<\"hello\">>}" + BEts.insert table tuple |> ignore - assertThat (BEts.size table) (isEqualTo 1) - assertThat (BEts.tableType table) (isEqualTo BEts.Set) - assertThat (BEts.access table) (isEqualTo BEts.Protected) // default access - assertThat (BEts.keypos table) (isEqualTo 1) // default keypos + assertThat (BEts.size table) (isEqualTo 1) + assertThat (BEts.tableType table) (isEqualTo BEts.Set) + assertThat (BEts.access table) (isEqualTo BEts.Protected) // default access + assertThat (BEts.keypos table) (isEqualTo 1) // default keypos - BEts.delete table - ) + BEts.delete table + ) - test ( - "ets typed info with ordered_set CompiledName", - fun _ -> - let table = - BEts.create (Erlang.binaryToAtom "ordered_table") [ Erlang.binaryToAtom "ordered_set" ] + test ( + "ets typed info with ordered_set CompiledName", + fun _ -> + let table = + BEts.create (Erlang.binaryToAtom "ordered_table") [ Erlang.binaryToAtom "ordered_set" ] - assertThat (BEts.tableType table) (isEqualTo BEts.OrderedSet) - BEts.delete table - ) ] + assertThat (BEts.tableType table) (isEqualTo BEts.OrderedSet) + BEts.delete table + ) + ] ) diff --git a/test/TestFile.fs b/test/TestFile.fs index 0fbfd07..6ab7cef 100644 --- a/test/TestFile.fs +++ b/test/TestFile.fs @@ -14,155 +14,156 @@ let private makeSymlink (target: string) (link: string) : Result = let tests = testList ( "File", - [ test ( - "readFile and writeFile roundtrip", - fun _ -> - let path = "/tmp/fable_beam_typed_test.txt" - let writeResult = BFile.writeFile path "typed hello" - assertThat writeResult (isEqualTo (Ok())) - let readResult = BFile.readFile path - assertThat readResult (isEqualTo (Ok "typed hello")) - BFile.delete path |> ignore - ) - - test ( - "readFile returns Error for missing file", - fun _ -> - let result = BFile.readFile "/tmp/fable_beam_nonexistent_file.txt" - assertThat result (isEqualTo (Error "enoent")) - ) - - test ( - "writeFile and delete roundtrip", - fun _ -> - let path = "/tmp/fable_beam_delete_test.txt" - BFile.writeFile path "to delete" |> ignore - let delResult = BFile.delete path - assertThat delResult (isEqualTo (Ok())) - let readResult = BFile.readFile path - assertThat readResult (isEqualTo (Error "enoent")) - ) - - test ( - "delete returns Error for missing file", - fun _ -> - let result = BFile.delete "/tmp/fable_beam_nonexistent_delete.txt" - assertThat result (isEqualTo (Error "enoent")) - ) - - test ( - "makeDir and delDir", - fun _ -> - let path = "/tmp/fable_beam_test_dir" - let mkResult = BFile.makeDir path - assertThat mkResult (isEqualTo (Ok())) - let delResult = BFile.delDir path - assertThat delResult (isEqualTo (Ok())) - ) - - test ( - "listDir returns files", - fun _ -> - let dir = "/tmp/fable_beam_listdir_test" - BFile.makeDir dir |> ignore - BFile.writeFile (dir + "/a.txt") "a" |> ignore - BFile.writeFile (dir + "/b.txt") "b" |> ignore - let result = BFile.listDir dir - - match result with - | Ok files -> assertThat ((List.length files >= 2)) (isTrue) - | Error e -> failwith "ok" - // cleanup - BFile.delete (dir + "/a.txt") |> ignore - BFile.delete (dir + "/b.txt") |> ignore - BFile.delDir dir |> ignore - ) - - test ( - "listDir returns Error for missing dir", - fun _ -> - let result = BFile.listDir "/tmp/fable_beam_no_such_dir" - assertThat result (isEqualTo (Error "enoent")) - ) - - test ( - "rename moves a file", - fun _ -> - let src = "/tmp/fable_beam_rename_src.txt" - let dst = "/tmp/fable_beam_rename_dst.txt" - BFile.writeFile src "rename me" |> ignore - let result = BFile.rename src dst - assertThat result (isEqualTo (Ok())) - assertThat (BFile.readFile dst) (isEqualTo (Ok "rename me")) - assertThat (BFile.readFile src) (isEqualTo (Error "enoent")) - BFile.delete dst |> ignore - ) - - test ( - "getCwd returns a path", - fun _ -> - match BFile.getCwd () with - | Ok dir -> assertThat ((String.length dir > 0)) (isTrue) - | Error e -> failwith "ok" - ) - - test ( - "exists returns true for existing file", - fun _ -> - let path = "/tmp/fable_beam_exists_test.txt" - BFile.writeFile path "exists" |> ignore - assertThat (BFile.exists path) (isTrue) - BFile.delete path |> ignore - ) - - test ( - "exists returns false for missing file", - fun _ -> assertThat (BFile.exists "/tmp/fable_beam_no_such_file.txt") (isFalse) - ) - - test ( - "readFileInfo exposes kind, mode, and stable identity fields", - fun _ -> - let path = "/tmp/fable_beam_file_info_test.txt" - BFile.writeFile path "metadata" |> ignore - - match BFile.readFileInfo path with - | Ok info -> - assertThat info.kind (isEqualTo BFile.FileKind.Regular) - assertThat info.mode.IsSome (isTrue) - assertThat info.majorDevice.IsSome (isTrue) - assertThat info.minorDevice.IsSome (isTrue) - assertThat info.inode.IsSome (isTrue) - | Error reason -> failwithf "readFileInfo failed: %s" reason - - BFile.delete path |> ignore - ) - - test ( - "readLinkInfo distinguishes symbolic links without following them", - fun _ -> - let target = "/tmp/fable_beam_link_target.txt" - let link = "/tmp/fable_beam_link_info_test" - BFile.delete link |> ignore - BFile.writeFile target "target" |> ignore - - match makeSymlink target link with - | Error reason -> failwithf "could not create symlink fixture: %s" reason - | Ok() -> - match BFile.readLinkInfo link with - | Ok info -> assertThat info.kind (isEqualTo BFile.FileKind.Symlink) - | Error reason -> failwithf "readLinkInfo failed: %s" reason - - BFile.delete link |> ignore - BFile.delete target |> ignore - ) - - test ( - "readLinkInfo preserves missing-path errors", - fun _ -> - let result = - BFile.readLinkInfo "/tmp/fable_beam_no_such_link_info_entry" - - assertThat result (isEqualTo (Error "enoent")) - ) ] + [ + test ( + "readFile and writeFile roundtrip", + fun _ -> + let path = "/tmp/fable_beam_typed_test.txt" + let writeResult = BFile.writeFile path "typed hello" + assertThat writeResult (isEqualTo (Ok())) + let readResult = BFile.readFile path + assertThat readResult (isEqualTo (Ok "typed hello")) + BFile.delete path |> ignore + ) + + test ( + "readFile returns Error for missing file", + fun _ -> + let result = BFile.readFile "/tmp/fable_beam_nonexistent_file.txt" + assertThat result (isEqualTo (Error "enoent")) + ) + + test ( + "writeFile and delete roundtrip", + fun _ -> + let path = "/tmp/fable_beam_delete_test.txt" + BFile.writeFile path "to delete" |> ignore + let delResult = BFile.delete path + assertThat delResult (isEqualTo (Ok())) + let readResult = BFile.readFile path + assertThat readResult (isEqualTo (Error "enoent")) + ) + + test ( + "delete returns Error for missing file", + fun _ -> + let result = BFile.delete "/tmp/fable_beam_nonexistent_delete.txt" + assertThat result (isEqualTo (Error "enoent")) + ) + + test ( + "makeDir and delDir", + fun _ -> + let path = "/tmp/fable_beam_test_dir" + let mkResult = BFile.makeDir path + assertThat mkResult (isEqualTo (Ok())) + let delResult = BFile.delDir path + assertThat delResult (isEqualTo (Ok())) + ) + + test ( + "listDir returns files", + fun _ -> + let dir = "/tmp/fable_beam_listdir_test" + BFile.makeDir dir |> ignore + BFile.writeFile (dir + "/a.txt") "a" |> ignore + BFile.writeFile (dir + "/b.txt") "b" |> ignore + let result = BFile.listDir dir + + match result with + | Ok files -> assertThat ((List.length files >= 2)) (isTrue) + | Error e -> failwith "ok" + // cleanup + BFile.delete (dir + "/a.txt") |> ignore + BFile.delete (dir + "/b.txt") |> ignore + BFile.delDir dir |> ignore + ) + + test ( + "listDir returns Error for missing dir", + fun _ -> + let result = BFile.listDir "/tmp/fable_beam_no_such_dir" + assertThat result (isEqualTo (Error "enoent")) + ) + + test ( + "rename moves a file", + fun _ -> + let src = "/tmp/fable_beam_rename_src.txt" + let dst = "/tmp/fable_beam_rename_dst.txt" + BFile.writeFile src "rename me" |> ignore + let result = BFile.rename src dst + assertThat result (isEqualTo (Ok())) + assertThat (BFile.readFile dst) (isEqualTo (Ok "rename me")) + assertThat (BFile.readFile src) (isEqualTo (Error "enoent")) + BFile.delete dst |> ignore + ) + + test ( + "getCwd returns a path", + fun _ -> + match BFile.getCwd () with + | Ok dir -> assertThat ((String.length dir > 0)) (isTrue) + | Error e -> failwith "ok" + ) + + test ( + "exists returns true for existing file", + fun _ -> + let path = "/tmp/fable_beam_exists_test.txt" + BFile.writeFile path "exists" |> ignore + assertThat (BFile.exists path) (isTrue) + BFile.delete path |> ignore + ) + + test ( + "exists returns false for missing file", + fun _ -> assertThat (BFile.exists "/tmp/fable_beam_no_such_file.txt") (isFalse) + ) + + test ( + "readFileInfo exposes kind, mode, and stable identity fields", + fun _ -> + let path = "/tmp/fable_beam_file_info_test.txt" + BFile.writeFile path "metadata" |> ignore + + match BFile.readFileInfo path with + | Ok info -> + assertThat info.kind (isEqualTo BFile.FileKind.Regular) + assertThat info.mode.IsSome (isTrue) + assertThat info.majorDevice.IsSome (isTrue) + assertThat info.minorDevice.IsSome (isTrue) + assertThat info.inode.IsSome (isTrue) + | Error reason -> failwithf "readFileInfo failed: %s" reason + + BFile.delete path |> ignore + ) + + test ( + "readLinkInfo distinguishes symbolic links without following them", + fun _ -> + let target = "/tmp/fable_beam_link_target.txt" + let link = "/tmp/fable_beam_link_info_test" + BFile.delete link |> ignore + BFile.writeFile target "target" |> ignore + + match makeSymlink target link with + | Error reason -> failwithf "could not create symlink fixture: %s" reason + | Ok() -> + match BFile.readLinkInfo link with + | Ok info -> assertThat info.kind (isEqualTo BFile.FileKind.Symlink) + | Error reason -> failwithf "readLinkInfo failed: %s" reason + + BFile.delete link |> ignore + BFile.delete target |> ignore + ) + + test ( + "readLinkInfo preserves missing-path errors", + fun _ -> + let result = BFile.readLinkInfo "/tmp/fable_beam_no_such_link_info_entry" + + assertThat result (isEqualTo (Error "enoent")) + ) + ] ) diff --git a/test/TestGenServer.fs b/test/TestGenServer.fs index 3129fb1..54bce26 100644 --- a/test/TestGenServer.fs +++ b/test/TestGenServer.fs @@ -13,119 +13,121 @@ module BGenServer = Fable.Beam.GenServer let tests = testList ( "GenServer", - [ test ( - "stop on non-existent catches error", - fun _ -> - try - BGenServer.stop (BGenServer.ServerRef "nonexistent_process_xyz") - with _ -> - () - ) - - test ( - "start_link returns ok with pid", - fun _ -> - let result = - BGenServer.startLink (Erlang.binaryToAtom "test_counter_server") (box 0) [] - - match result with - | Ok pid -> assertThat (Erlang.isProcessAlive pid) (isEqualTo true) - | Error _ -> failwith "start_link should succeed" - ) - - test ( - "start returns ok with pid", - fun _ -> - let result = BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 0) [] - - match result with - | Ok pid -> - assertThat (Erlang.isProcessAlive pid) (isEqualTo true) - BGenServer.stop (BGenServer.ServerRef pid) - | Error _ -> failwith "start should succeed" - ) - - test ( - "call gets state", - fun _ -> - let result = - BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 42) [] - - match result with - | Ok pid -> - let value = - BGenServer.call (BGenServer.ServerRef pid) (box (Erlang.binaryToAtom "get")) - - assertThat (Erlang.exactEquals value (box 42)) (isEqualTo true) - BGenServer.stop (BGenServer.ServerRef pid) - | Error _ -> failwith "start should succeed" - ) - - test ( - "call increment", - fun _ -> - let result = BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 0) [] - - match result with - | Ok pid -> - let ref = BGenServer.ServerRef pid - let v1 = BGenServer.call ref (box (Erlang.binaryToAtom "increment")) - assertThat (Erlang.exactEquals v1 (box 1)) (isEqualTo true) - let v2 = BGenServer.call ref (box (Erlang.binaryToAtom "increment")) - assertThat (Erlang.exactEquals v2 (box 2)) (isEqualTo true) - BGenServer.stop ref - | Error _ -> failwith "start should succeed" - ) - - test ( - "call with timeout", - fun _ -> - let result = - BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 10) [] - - match result with - | Ok pid -> - let ref = BGenServer.ServerRef pid - - let value = - BGenServer.callWithTimeout ref (box (Erlang.binaryToAtom "get")) (U2.Case1 5000) - - assertThat (Erlang.exactEquals value (box 10)) (isEqualTo true) - BGenServer.stop ref - | Error _ -> failwith "start should succeed" - ) - - test ( - "cast updates state", - fun _ -> - let result = BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 0) [] - - match result with - | Ok pid -> - let ref = BGenServer.ServerRef pid - let setMsg: obj = emitErlExpr () "{set, 99}" - BGenServer.cast ref setMsg - // Small delay to let cast process - Fable.Beam.Timer.sleep 10 - let value = BGenServer.call ref (box (Erlang.binaryToAtom "get")) - assertThat (Erlang.exactEquals value (box 99)) (isEqualTo true) - BGenServer.stop ref - | Error _ -> failwith "start should succeed" - ) - - test ( - "stop with reason and timeout", - fun _ -> - let result = BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 0) [] - - match result with - | Ok pid -> - let ref = BGenServer.ServerRef pid - assertThat (Erlang.isProcessAlive pid) (isEqualTo true) - BGenServer.stopWith ref (Erlang.binaryToAtom "normal") (U2.Case1 5000) - // Process should be dead after stop - Fable.Beam.Timer.sleep 10 - assertThat (Erlang.isProcessAlive pid) (isEqualTo false) - | Error _ -> failwith "start should succeed" - ) ] + [ + test ( + "stop on non-existent catches error", + fun _ -> + try + BGenServer.stop (BGenServer.ServerRef "nonexistent_process_xyz") + with _ -> + () + ) + + test ( + "start_link returns ok with pid", + fun _ -> + let result = + BGenServer.startLink (Erlang.binaryToAtom "test_counter_server") (box 0) [] + + match result with + | Ok pid -> assertThat (Erlang.isProcessAlive pid) (isEqualTo true) + | Error _ -> failwith "start_link should succeed" + ) + + test ( + "start returns ok with pid", + fun _ -> + let result = BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 0) [] + + match result with + | Ok pid -> + assertThat (Erlang.isProcessAlive pid) (isEqualTo true) + BGenServer.stop (BGenServer.ServerRef pid) + | Error _ -> failwith "start should succeed" + ) + + test ( + "call gets state", + fun _ -> + let result = + BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 42) [] + + match result with + | Ok pid -> + let value = + BGenServer.call (BGenServer.ServerRef pid) (box (Erlang.binaryToAtom "get")) + + assertThat (Erlang.exactEquals value (box 42)) (isEqualTo true) + BGenServer.stop (BGenServer.ServerRef pid) + | Error _ -> failwith "start should succeed" + ) + + test ( + "call increment", + fun _ -> + let result = BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 0) [] + + match result with + | Ok pid -> + let ref = BGenServer.ServerRef pid + let v1 = BGenServer.call ref (box (Erlang.binaryToAtom "increment")) + assertThat (Erlang.exactEquals v1 (box 1)) (isEqualTo true) + let v2 = BGenServer.call ref (box (Erlang.binaryToAtom "increment")) + assertThat (Erlang.exactEquals v2 (box 2)) (isEqualTo true) + BGenServer.stop ref + | Error _ -> failwith "start should succeed" + ) + + test ( + "call with timeout", + fun _ -> + let result = + BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 10) [] + + match result with + | Ok pid -> + let ref = BGenServer.ServerRef pid + + let value = + BGenServer.callWithTimeout ref (box (Erlang.binaryToAtom "get")) (U2.Case1 5000) + + assertThat (Erlang.exactEquals value (box 10)) (isEqualTo true) + BGenServer.stop ref + | Error _ -> failwith "start should succeed" + ) + + test ( + "cast updates state", + fun _ -> + let result = BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 0) [] + + match result with + | Ok pid -> + let ref = BGenServer.ServerRef pid + let setMsg: obj = emitErlExpr () "{set, 99}" + BGenServer.cast ref setMsg + // Small delay to let cast process + Fable.Beam.Timer.sleep 10 + let value = BGenServer.call ref (box (Erlang.binaryToAtom "get")) + assertThat (Erlang.exactEquals value (box 99)) (isEqualTo true) + BGenServer.stop ref + | Error _ -> failwith "start should succeed" + ) + + test ( + "stop with reason and timeout", + fun _ -> + let result = BGenServer.start (Erlang.binaryToAtom "test_counter_server") (box 0) [] + + match result with + | Ok pid -> + let ref = BGenServer.ServerRef pid + assertThat (Erlang.isProcessAlive pid) (isEqualTo true) + BGenServer.stopWith ref (Erlang.binaryToAtom "normal") (U2.Case1 5000) + // Process should be dead after stop + Fable.Beam.Timer.sleep 10 + assertThat (Erlang.isProcessAlive pid) (isEqualTo false) + | Error _ -> failwith "start should succeed" + ) + ] ) diff --git a/test/TestIo.fs b/test/TestIo.fs index 47a52fe..0482f83 100644 --- a/test/TestIo.fs +++ b/test/TestIo.fs @@ -9,10 +9,12 @@ module BIo = Fable.Beam.Io let tests = testList ( "Io", - [ test ("putChars does not crash", fun _ -> assertThat (fun () -> BIo.putChars "test output\n") doesNotThrow) + [ + test ("putChars does not crash", fun _ -> assertThat (fun () -> BIo.putChars "test output\n") doesNotThrow) - test ( - "format does not crash", - fun _ -> assertThat (fun () -> BIo.format "hello ~s~n" [ box "beam" ]) doesNotThrow - ) ] + test ( + "format does not crash", + fun _ -> assertThat (fun () -> BIo.format "hello ~s~n" [ box "beam" ]) doesNotThrow + ) + ] ) diff --git a/test/TestIoLib.fs b/test/TestIoLib.fs index 0309d36..2c3a3d5 100644 --- a/test/TestIoLib.fs +++ b/test/TestIoLib.fs @@ -11,14 +11,19 @@ open Fable.Beam.IoLib let tests = testList ( "IoLib", - [ test ("format renders a string", fun _ -> assertThat (format "~s-~p" [ box "x"; box 42 ]) (isEqualTo "x-42")) + [ + test ( + "format renders a string", + fun _ -> assertThat (format "~s-~p" [ box "x"; box 42 ]) (isEqualTo "x-42") + ) - test ( - "formatRaw returns unflattened chardata that flattens to format", - fun _ -> - let raw = formatRaw "~s-~p" [ box "x"; box 42 ] - assertThat (Erlang.isList raw) (isTrue) - assertThat (BeamChardata.toString raw) (isEqualTo "x-42") - assertThat (BeamChardata.toString raw) (isEqualTo (format "~s-~p" [ box "x"; box 42 ])) - ) ] + test ( + "formatRaw returns unflattened chardata that flattens to format", + fun _ -> + let raw = formatRaw "~s-~p" [ box "x"; box 42 ] + assertThat (Erlang.isList raw) (isTrue) + assertThat (BeamChardata.toString raw) (isEqualTo "x-42") + assertThat (BeamChardata.toString raw) (isEqualTo (format "~s-~p" [ box "x"; box 42 ])) + ) + ] ) diff --git a/test/TestJsx.fs b/test/TestJsx.fs index d14fef7..ed907fb 100644 --- a/test/TestJsx.fs +++ b/test/TestJsx.fs @@ -24,109 +24,111 @@ let private firstKeyIsBinary (m: obj) : bool = nativeOnly let tests = testList ( "Jsx", - [ test ( - "jsx encode integer", - fun _ -> - let json = BJsx.encode 42 - assertThat json (isEqualTo "42") - ) - - test ( - "jsx encode string", - fun _ -> - let json = BJsx.encode "hello" - assertThat json (isEqualTo "\"hello\"") - ) - - test ( - "jsx decode string", - fun _ -> - let result: string = BJsx.decode "\"hello\"" - assertThat result (isEqualTo "hello") - ) - - test ("jsx is_json valid", fun _ -> assertThat (BJsx.isJson """{"key": "value"}""") (isTrue)) - - test ("jsx is_json invalid", fun _ -> assertThat (BJsx.isJson "not json") (isFalse)) - - test ( - "jsx minify", - fun _ -> - let result = BJsx.minify """{ "key" : "value" }""" - assertThat result (isEqualTo """{"key":"value"}""") - ) - - test ( - "jsx prettify and minify roundtrip", - fun _ -> - let json = """{"key":"value"}""" - let pretty = BJsx.prettify json - let mini = BJsx.minify pretty - assertThat mini (isEqualTo json) - ) - - test ( - "jsx is_json with strict rejects trailing comma", - fun _ -> assertThat (BJsx.isJsonWith """{"key": "value",}""" [ BJsx.strict ]) (isFalse) - ) - - test ( - "jsx format with indent", - fun _ -> - let result = BJsx.formatWith """{"key":"value"}""" [ BJsx.indent 2 ] - // Formatted output should be longer than minified - assertThat ((String.length result > String.length """{"key":"value"}""")) (isTrue) - ) - - test ( - "jsx labels Binary keeps keys as binaries", - fun _ -> - let decoded: obj = - BJsx.decodeWith """{"key":"value"}""" [ BJsx.labels BJsx.LabelMode.Binary ] - - assertThat (firstKeyIsBinary decoded) (isTrue) - ) - - test ( - "jsx labels Atom converts keys to atoms", - fun _ -> - let decoded: obj = - BJsx.decodeWith """{"key":"value"}""" [ BJsx.labels BJsx.LabelMode.Atom ] - - assertThat (firstKeyIsAtom decoded) (isTrue) - ) - - test ( - "jsx labels Atom probe emits raw atom option", - fun _ -> - let decoded: obj = - BJsx.decodeWith """{"atom_key_probe_xyz":"value"}""" [ BJsx.labels BJsx.LabelMode.Atom ] - - assertThat (firstKeyIsAtom decoded) (isTrue) - ) - - test ( - "jsx labels ExistingAtom rejects unknown atoms", - fun _ -> - // existing_atom uses binary_to_existing_atom, so a key whose atom was never created - // raises badarg rather than silently interning it. That rejection *is* the behaviour. - assertThat - (fun () -> - BJsx.decodeWith - """{"never_interned_key_qqq":"value"}""" - [ BJsx.labels BJsx.LabelMode.ExistingAtom ] - |> ignore) - throws - ) - - test ( - "jsx labels AttemptAtom is accepted", - fun _ -> - // attempt_atom converts the key when the atom already exists and leaves it a binary - // otherwise. "key" is interned by the decode above, so it comes back as an atom. - let decoded: obj = - BJsx.decodeWith """{"key":"value"}""" [ BJsx.labels BJsx.LabelMode.AttemptAtom ] - - assertThat (firstKeyIsAtom decoded) (isTrue) - ) ] + [ + test ( + "jsx encode integer", + fun _ -> + let json = BJsx.encode 42 + assertThat json (isEqualTo "42") + ) + + test ( + "jsx encode string", + fun _ -> + let json = BJsx.encode "hello" + assertThat json (isEqualTo "\"hello\"") + ) + + test ( + "jsx decode string", + fun _ -> + let result: string = BJsx.decode "\"hello\"" + assertThat result (isEqualTo "hello") + ) + + test ("jsx is_json valid", fun _ -> assertThat (BJsx.isJson """{"key": "value"}""") (isTrue)) + + test ("jsx is_json invalid", fun _ -> assertThat (BJsx.isJson "not json") (isFalse)) + + test ( + "jsx minify", + fun _ -> + let result = BJsx.minify """{ "key" : "value" }""" + assertThat result (isEqualTo """{"key":"value"}""") + ) + + test ( + "jsx prettify and minify roundtrip", + fun _ -> + let json = """{"key":"value"}""" + let pretty = BJsx.prettify json + let mini = BJsx.minify pretty + assertThat mini (isEqualTo json) + ) + + test ( + "jsx is_json with strict rejects trailing comma", + fun _ -> assertThat (BJsx.isJsonWith """{"key": "value",}""" [ BJsx.strict ]) (isFalse) + ) + + test ( + "jsx format with indent", + fun _ -> + let result = BJsx.formatWith """{"key":"value"}""" [ BJsx.indent 2 ] + // Formatted output should be longer than minified + assertThat ((String.length result > String.length """{"key":"value"}""")) (isTrue) + ) + + test ( + "jsx labels Binary keeps keys as binaries", + fun _ -> + let decoded: obj = + BJsx.decodeWith """{"key":"value"}""" [ BJsx.labels BJsx.LabelMode.Binary ] + + assertThat (firstKeyIsBinary decoded) (isTrue) + ) + + test ( + "jsx labels Atom converts keys to atoms", + fun _ -> + let decoded: obj = + BJsx.decodeWith """{"key":"value"}""" [ BJsx.labels BJsx.LabelMode.Atom ] + + assertThat (firstKeyIsAtom decoded) (isTrue) + ) + + test ( + "jsx labels Atom probe emits raw atom option", + fun _ -> + let decoded: obj = + BJsx.decodeWith """{"atom_key_probe_xyz":"value"}""" [ BJsx.labels BJsx.LabelMode.Atom ] + + assertThat (firstKeyIsAtom decoded) (isTrue) + ) + + test ( + "jsx labels ExistingAtom rejects unknown atoms", + fun _ -> + // existing_atom uses binary_to_existing_atom, so a key whose atom was never created + // raises badarg rather than silently interning it. That rejection *is* the behaviour. + assertThat + (fun () -> + BJsx.decodeWith + """{"never_interned_key_qqq":"value"}""" + [ BJsx.labels BJsx.LabelMode.ExistingAtom ] + |> ignore) + throws + ) + + test ( + "jsx labels AttemptAtom is accepted", + fun _ -> + // attempt_atom converts the key when the atom already exists and leaves it a binary + // otherwise. "key" is interned by the decode above, so it comes back as an atom. + let decoded: obj = + BJsx.decodeWith """{"key":"value"}""" [ BJsx.labels BJsx.LabelMode.AttemptAtom ] + + assertThat (firstKeyIsAtom decoded) (isTrue) + ) + ] ) diff --git a/test/TestLists.fs b/test/TestLists.fs index 435493e..ae4f9b2 100644 --- a/test/TestLists.fs +++ b/test/TestLists.fs @@ -16,311 +16,313 @@ let erlLength (xs: BeamList<'T>) : int = nativeOnly let tests = testList ( "Lists", - [ test ( - "reverse works", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3]" - let expected: BeamList = emitErlExpr () "[3, 2, 1]" - assertThat (BLists.reverse xs) (isEqualTo expected) - ) - - test ( - "member works", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3]" - assertThat (BLists.``member`` 2 xs) (isTrue) - assertThat (BLists.``member`` 4 xs) (isFalse) - ) - - test ( - "sort works", - fun _ -> - let xs: BeamList = emitErlExpr () "[3, 1, 2]" - let expected: BeamList = emitErlExpr () "[1, 2, 3]" - assertThat (BLists.sort xs) (isEqualTo expected) - ) - - test ( - "append works", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2]" - let ys: BeamList = emitErlExpr () "[3, 4]" - let expected: BeamList = emitErlExpr () "[1, 2, 3, 4]" - assertThat (BLists.append xs ys) (isEqualTo expected) - ) - - test ( - "last works", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3]" - assertThat (BLists.last xs) (isEqualTo 3) - ) - - test ( - "nth works", - fun _ -> - // Erlang lists:nth is 1-based - let xs: BeamList = emitErlExpr () "[10, 20, 30]" - assertThat (BLists.nth 1 xs) (isEqualTo 10) - ) - - test ( - "flatten works", - fun _ -> - let xs: BeamList> = emitErlExpr () "[[1, 2], [3, 4]]" - let expected: BeamList = emitErlExpr () "[1, 2, 3, 4]" - assertThat (BLists.flatten xs) (isEqualTo expected) - ) - - test ( - "usort removes duplicates", - fun _ -> - let xs: BeamList = emitErlExpr () "[3, 1, 2, 1, 3]" - let expected: BeamList = emitErlExpr () "[1, 2, 3]" - assertThat (BLists.usort xs) (isEqualTo expected) - ) - - test ( - "unzip returns tuple of two lists", - fun _ -> - let xs: BeamList = emitErlExpr () "[{1, a}, {2, b}, {3, c}]" - let (list1, list2) = BLists.unzip xs - assertThat (erlLength list1) (isEqualTo 3) - assertThat (erlLength list2) (isEqualTo 3) - ) - - test ( - "partition returns tuple of two lists", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3, 4, 5]" - - let (matching, notMatching) = BLists.partition (fun x -> x > 3) xs - - assertThat (erlLength matching) (isEqualTo 2) - assertThat (erlLength notMatching) (isEqualTo 3) - ) - - test ( - "sum returns sum", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3, 4]" - assertThat (BLists.sumInt xs) (isEqualTo 10) - ) - - test ( - "sum returns float sum", - fun _ -> - let xs: BeamList = emitErlExpr () "[1.5, 2.5, 3.0]" - assertThat (BLists.sumFloat xs) (isEqualTo 7.0) - ) - - test ( - "max returns maximum", - fun _ -> - let xs: BeamList = emitErlExpr () "[3, 1, 4, 1, 5, 9, 2]" - assertThat (BLists.max xs) (isEqualTo 9) - ) - - test ( - "min returns minimum", - fun _ -> - let xs: BeamList = emitErlExpr () "[3, 1, 4, 1, 5, 9, 2]" - assertThat (BLists.min xs) (isEqualTo 1) - ) - - test ( - "seq generates integer sequence", - fun _ -> - let xs = BLists.seq 1 5 - assertThat (erlLength xs) (isEqualTo 5) - assertThat (BLists.nth 1 xs) (isEqualTo 1) - assertThat (BLists.nth 5 xs) (isEqualTo 5) - ) - - test ( - "seq with step generates sequence", - fun _ -> - let xs = BLists.seqStep 0 10 2 - assertThat (erlLength xs) (isEqualTo 6) - assertThat (BLists.nth 1 xs) (isEqualTo 0) - assertThat (BLists.nth 2 xs) (isEqualTo 2) - ) - - test ( - "duplicate creates repeated list", - fun _ -> - let xs: BeamList = BLists.duplicate 3 7 - assertThat (erlLength xs) (isEqualTo 3) - assertThat (BLists.nth 1 xs) (isEqualTo 7) - assertThat (BLists.nth 3 xs) (isEqualTo 7) - ) - - test ( - "takewhile takes while predicate holds", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3, 4, 5]" - let result = BLists.takeWhile (fun x -> x < 4) xs - assertThat (erlLength result) (isEqualTo 3) - assertThat (BLists.nth 3 result) (isEqualTo 3) - ) - - test ( - "dropwhile drops while predicate holds", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3, 4, 5]" - let result = BLists.dropWhile (fun x -> x < 4) xs - assertThat (erlLength result) (isEqualTo 2) - assertThat (BLists.nth 1 result) (isEqualTo 4) - ) - - test ( - "splitwith splits at predicate boundary", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3, 4, 5]" - let (before, after) = BLists.splitWith (fun x -> x < 3) xs - assertThat (erlLength before) (isEqualTo 2) - assertThat (erlLength after) (isEqualTo 3) - ) - - test ( - "delete removes first occurrence", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3, 2, 1]" - let result = BLists.delete 2 xs - assertThat (erlLength result) (isEqualTo 4) - assertThat (BLists.``member`` 2 result) (isTrue) - ) - - test ( - "subtract removes elements", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3, 4, 5]" - let ys: BeamList = emitErlExpr () "[2, 4]" - let result = BLists.subtract xs ys - assertThat (erlLength result) (isEqualTo 3) - assertThat (BLists.``member`` 2 result) (isFalse) - ) - - test ( - "keysort sorts by Nth element", - fun _ -> - let xs: BeamList = emitErlExpr () "[{3, c}, {1, a}, {2, b}]" - let sorted = BLists.keySort 1 xs - let first: int * string = BLists.nth 1 sorted - assertThat (fst first) (isEqualTo 1) - ) - - test ( - "keydelete removes first matching tuple", - fun _ -> - let xs: BeamList = - emitErlExpr () "[{<<\"a\">>, 1}, {<<\"b\">>, 2}, {<<\"a\">>, 3}]" - - let result = BLists.keyDelete "a" 1 xs - assertThat (erlLength result) (isEqualTo 2) - ) - - test ( - "keymember checks for key", - fun _ -> - let xs: BeamList = emitErlExpr () "[{<<\"a\">>, 1}, {<<\"b\">>, 2}]" - assertThat (BLists.keyMember "a" 1 xs) (isTrue) - assertThat (BLists.keyMember "c" 1 xs) (isFalse) - ) - - test ( - "keyFind returns Some for existing key", - fun _ -> - let xs: BeamList = - emitErlExpr () "[{<<\"a\">>, 1}, {<<\"b\">>, 2}, {<<\"c\">>, 3}]" - - let found = BLists.keyFind "b" 1 xs - assertThat found (isEqualTo (Some("b", 2))) - ) - - test ( - "keyFind returns None for missing key", - fun _ -> - let xs: BeamList = emitErlExpr () "[{<<\"a\">>, 1}, {<<\"b\">>, 2}]" - assertThat (BLists.keyFind "z" 1 xs) (isEqualTo None) - ) - - test ( - "keyreplace replaces first matching tuple", - fun _ -> - let xs: BeamList = - emitErlExpr () "[{<<\"a\">>, 1}, {<<\"b\">>, 2}, {<<\"a\">>, 3}]" - - let result = BLists.keyReplace "a" 1 xs ("a", 99) - assertThat (BLists.nth 1 result) (isEqualTo ("a", 99)) - assertThat (erlLength result) (isEqualTo 3) - ) - - test ( - "mapfoldl maps and folds left", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3]" - - let (mapped, acc) = BLists.mapFoldLeft (fun x s -> (x * 2, s + x)) 0 xs - - assertThat mapped (isEqualTo (emitErlExpr () "[2, 4, 6]")) - assertThat acc (isEqualTo 6) - ) - - test ( - "mapfoldr maps and folds right", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3]" - - let (mapped, acc) = BLists.mapFoldRight (fun x s -> (x * 2, s + x)) 0 xs - - assertThat mapped (isEqualTo (emitErlExpr () "[2, 4, 6]")) - assertThat acc (isEqualTo 6) - ) - - test ( - "map applies a function to each element", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3]" - assertThat (BLists.map (fun x -> x * 2) xs) (isEqualTo (emitErlExpr () "[2, 4, 6]")) - ) - - test ( - "filter keeps matching elements", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3, 4]" - assertThat (BLists.filter (fun x -> x % 2 = 0) xs) (isEqualTo (emitErlExpr () "[2, 4]")) - ) - - test ( - "foldl folds from the left", - fun _ -> - let xs: BeamList = emitErlExpr () "[1, 2, 3]" - assertThat (BLists.foldl (fun x acc -> acc + x) 0 xs) (isEqualTo 6) - ) - - test ( - "foldr folds from the right", - fun _ -> - // Subtraction is not associative, so this pins the direction: 1-(2-(3-0)) = 2. - let xs: BeamList = emitErlExpr () "[1, 2, 3]" - assertThat (BLists.foldr (fun x acc -> x - acc) 0 xs) (isEqualTo 2) - ) - - test ( - "all and any check predicates", - fun _ -> - let xs: BeamList = emitErlExpr () "[2, 4, 6]" - assertThat (BLists.all (fun x -> x % 2 = 0) xs) (isTrue) - assertThat (BLists.any (fun x -> x > 5) xs) (isTrue) - assertThat (BLists.any (fun x -> x > 10) xs) (isFalse) - ) - - test ( - "sort with a comparison function", - fun _ -> - let xs: BeamList = emitErlExpr () "[3, 1, 2]" - // Descending: the comparator returns true when A should come before B. - assertThat (BLists.sortWith (fun a b -> a >= b) xs) (isEqualTo (emitErlExpr () "[3, 2, 1]")) - ) ] + [ + test ( + "reverse works", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3]" + let expected: BeamList = emitErlExpr () "[3, 2, 1]" + assertThat (BLists.reverse xs) (isEqualTo expected) + ) + + test ( + "member works", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3]" + assertThat (BLists.``member`` 2 xs) (isTrue) + assertThat (BLists.``member`` 4 xs) (isFalse) + ) + + test ( + "sort works", + fun _ -> + let xs: BeamList = emitErlExpr () "[3, 1, 2]" + let expected: BeamList = emitErlExpr () "[1, 2, 3]" + assertThat (BLists.sort xs) (isEqualTo expected) + ) + + test ( + "append works", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2]" + let ys: BeamList = emitErlExpr () "[3, 4]" + let expected: BeamList = emitErlExpr () "[1, 2, 3, 4]" + assertThat (BLists.append xs ys) (isEqualTo expected) + ) + + test ( + "last works", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3]" + assertThat (BLists.last xs) (isEqualTo 3) + ) + + test ( + "nth works", + fun _ -> + // Erlang lists:nth is 1-based + let xs: BeamList = emitErlExpr () "[10, 20, 30]" + assertThat (BLists.nth 1 xs) (isEqualTo 10) + ) + + test ( + "flatten works", + fun _ -> + let xs: BeamList> = emitErlExpr () "[[1, 2], [3, 4]]" + let expected: BeamList = emitErlExpr () "[1, 2, 3, 4]" + assertThat (BLists.flatten xs) (isEqualTo expected) + ) + + test ( + "usort removes duplicates", + fun _ -> + let xs: BeamList = emitErlExpr () "[3, 1, 2, 1, 3]" + let expected: BeamList = emitErlExpr () "[1, 2, 3]" + assertThat (BLists.usort xs) (isEqualTo expected) + ) + + test ( + "unzip returns tuple of two lists", + fun _ -> + let xs: BeamList = emitErlExpr () "[{1, a}, {2, b}, {3, c}]" + let (list1, list2) = BLists.unzip xs + assertThat (erlLength list1) (isEqualTo 3) + assertThat (erlLength list2) (isEqualTo 3) + ) + + test ( + "partition returns tuple of two lists", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3, 4, 5]" + + let (matching, notMatching) = BLists.partition (fun x -> x > 3) xs + + assertThat (erlLength matching) (isEqualTo 2) + assertThat (erlLength notMatching) (isEqualTo 3) + ) + + test ( + "sum returns sum", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3, 4]" + assertThat (BLists.sumInt xs) (isEqualTo 10) + ) + + test ( + "sum returns float sum", + fun _ -> + let xs: BeamList = emitErlExpr () "[1.5, 2.5, 3.0]" + assertThat (BLists.sumFloat xs) (isEqualTo 7.0) + ) + + test ( + "max returns maximum", + fun _ -> + let xs: BeamList = emitErlExpr () "[3, 1, 4, 1, 5, 9, 2]" + assertThat (BLists.max xs) (isEqualTo 9) + ) + + test ( + "min returns minimum", + fun _ -> + let xs: BeamList = emitErlExpr () "[3, 1, 4, 1, 5, 9, 2]" + assertThat (BLists.min xs) (isEqualTo 1) + ) + + test ( + "seq generates integer sequence", + fun _ -> + let xs = BLists.seq 1 5 + assertThat (erlLength xs) (isEqualTo 5) + assertThat (BLists.nth 1 xs) (isEqualTo 1) + assertThat (BLists.nth 5 xs) (isEqualTo 5) + ) + + test ( + "seq with step generates sequence", + fun _ -> + let xs = BLists.seqStep 0 10 2 + assertThat (erlLength xs) (isEqualTo 6) + assertThat (BLists.nth 1 xs) (isEqualTo 0) + assertThat (BLists.nth 2 xs) (isEqualTo 2) + ) + + test ( + "duplicate creates repeated list", + fun _ -> + let xs: BeamList = BLists.duplicate 3 7 + assertThat (erlLength xs) (isEqualTo 3) + assertThat (BLists.nth 1 xs) (isEqualTo 7) + assertThat (BLists.nth 3 xs) (isEqualTo 7) + ) + + test ( + "takewhile takes while predicate holds", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3, 4, 5]" + let result = BLists.takeWhile (fun x -> x < 4) xs + assertThat (erlLength result) (isEqualTo 3) + assertThat (BLists.nth 3 result) (isEqualTo 3) + ) + + test ( + "dropwhile drops while predicate holds", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3, 4, 5]" + let result = BLists.dropWhile (fun x -> x < 4) xs + assertThat (erlLength result) (isEqualTo 2) + assertThat (BLists.nth 1 result) (isEqualTo 4) + ) + + test ( + "splitwith splits at predicate boundary", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3, 4, 5]" + let (before, after) = BLists.splitWith (fun x -> x < 3) xs + assertThat (erlLength before) (isEqualTo 2) + assertThat (erlLength after) (isEqualTo 3) + ) + + test ( + "delete removes first occurrence", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3, 2, 1]" + let result = BLists.delete 2 xs + assertThat (erlLength result) (isEqualTo 4) + assertThat (BLists.``member`` 2 result) (isTrue) + ) + + test ( + "subtract removes elements", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3, 4, 5]" + let ys: BeamList = emitErlExpr () "[2, 4]" + let result = BLists.subtract xs ys + assertThat (erlLength result) (isEqualTo 3) + assertThat (BLists.``member`` 2 result) (isFalse) + ) + + test ( + "keysort sorts by Nth element", + fun _ -> + let xs: BeamList = emitErlExpr () "[{3, c}, {1, a}, {2, b}]" + let sorted = BLists.keySort 1 xs + let first: int * string = BLists.nth 1 sorted + assertThat (fst first) (isEqualTo 1) + ) + + test ( + "keydelete removes first matching tuple", + fun _ -> + let xs: BeamList = + emitErlExpr () "[{<<\"a\">>, 1}, {<<\"b\">>, 2}, {<<\"a\">>, 3}]" + + let result = BLists.keyDelete "a" 1 xs + assertThat (erlLength result) (isEqualTo 2) + ) + + test ( + "keymember checks for key", + fun _ -> + let xs: BeamList = emitErlExpr () "[{<<\"a\">>, 1}, {<<\"b\">>, 2}]" + assertThat (BLists.keyMember "a" 1 xs) (isTrue) + assertThat (BLists.keyMember "c" 1 xs) (isFalse) + ) + + test ( + "keyFind returns Some for existing key", + fun _ -> + let xs: BeamList = + emitErlExpr () "[{<<\"a\">>, 1}, {<<\"b\">>, 2}, {<<\"c\">>, 3}]" + + let found = BLists.keyFind "b" 1 xs + assertThat found (isEqualTo (Some("b", 2))) + ) + + test ( + "keyFind returns None for missing key", + fun _ -> + let xs: BeamList = emitErlExpr () "[{<<\"a\">>, 1}, {<<\"b\">>, 2}]" + assertThat (BLists.keyFind "z" 1 xs) (isEqualTo None) + ) + + test ( + "keyreplace replaces first matching tuple", + fun _ -> + let xs: BeamList = + emitErlExpr () "[{<<\"a\">>, 1}, {<<\"b\">>, 2}, {<<\"a\">>, 3}]" + + let result = BLists.keyReplace "a" 1 xs ("a", 99) + assertThat (BLists.nth 1 result) (isEqualTo ("a", 99)) + assertThat (erlLength result) (isEqualTo 3) + ) + + test ( + "mapfoldl maps and folds left", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3]" + + let (mapped, acc) = BLists.mapFoldLeft (fun x s -> (x * 2, s + x)) 0 xs + + assertThat mapped (isEqualTo (emitErlExpr () "[2, 4, 6]")) + assertThat acc (isEqualTo 6) + ) + + test ( + "mapfoldr maps and folds right", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3]" + + let (mapped, acc) = BLists.mapFoldRight (fun x s -> (x * 2, s + x)) 0 xs + + assertThat mapped (isEqualTo (emitErlExpr () "[2, 4, 6]")) + assertThat acc (isEqualTo 6) + ) + + test ( + "map applies a function to each element", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3]" + assertThat (BLists.map (fun x -> x * 2) xs) (isEqualTo (emitErlExpr () "[2, 4, 6]")) + ) + + test ( + "filter keeps matching elements", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3, 4]" + assertThat (BLists.filter (fun x -> x % 2 = 0) xs) (isEqualTo (emitErlExpr () "[2, 4]")) + ) + + test ( + "foldl folds from the left", + fun _ -> + let xs: BeamList = emitErlExpr () "[1, 2, 3]" + assertThat (BLists.foldl (fun x acc -> acc + x) 0 xs) (isEqualTo 6) + ) + + test ( + "foldr folds from the right", + fun _ -> + // Subtraction is not associative, so this pins the direction: 1-(2-(3-0)) = 2. + let xs: BeamList = emitErlExpr () "[1, 2, 3]" + assertThat (BLists.foldr (fun x acc -> x - acc) 0 xs) (isEqualTo 2) + ) + + test ( + "all and any check predicates", + fun _ -> + let xs: BeamList = emitErlExpr () "[2, 4, 6]" + assertThat (BLists.all (fun x -> x % 2 = 0) xs) (isTrue) + assertThat (BLists.any (fun x -> x > 5) xs) (isTrue) + assertThat (BLists.any (fun x -> x > 10) xs) (isFalse) + ) + + test ( + "sort with a comparison function", + fun _ -> + let xs: BeamList = emitErlExpr () "[3, 1, 2]" + // Descending: the comparator returns true when A should come before B. + assertThat (BLists.sortWith (fun a b -> a >= b) xs) (isEqualTo (emitErlExpr () "[3, 2, 1]")) + ) + ] ) diff --git a/test/TestLogger.fs b/test/TestLogger.fs index 8c2047f..e53ab26 100644 --- a/test/TestLogger.fs +++ b/test/TestLogger.fs @@ -14,136 +14,142 @@ module BLogger = Fable.Beam.Logger let tests = testList ( "Logger", - [ test ("logger.info works", fun _ -> BLogger.info "test info message") - - test ("logger.warning works", fun _ -> BLogger.warning "test warning message") - - test ("logger.debug works", fun _ -> BLogger.debug "test debug message") - - test ( - "logger.info with format args", - fun _ -> - // The 2-arg overload accepts both metadata maps and format args lists - BLogger.infoWith "test ~p message" (U2.Case2 [ box 42 ]) - ) - - test ( - "logger add and remove handler", - fun _ -> - // Round-trip a handler through add_handler/3 and remove_handler/1, asserting the - // ok | {error, term()} result maps to Ok () (and is not swallowed). - let handlerId = Erlang.binaryToAtom "test_handler" - let modle = Erlang.binaryToAtom "logger_std_h" - - let config: BeamMap = - Maps.ofList [ (Erlang.binaryToAtom "level", box (Erlang.binaryToAtom "info")) ] - - assertThat (BLogger.addHandler handlerId modle config) (isEqualTo (Ok())) - assertThat (BLogger.removeHandler handlerId) (isEqualTo (Ok())) - ) - - test ( - "Filter.addPrimary receives the event and can stop it", - fun _ -> - // Primary filters run in the logging (client) process, so the filter can record - // what it saw in this process's dictionary for us to assert on afterwards. - let filterId = Erlang.binaryToAtom "fable_test_filter" - let seenKey = Erlang.binaryToAtom "fable_test_seen_level" - let timeKey = Erlang.binaryToAtom "fable_test_seen_time" - - let filter = - System.Func<_, _, _>(fun (ev: BLogger.Filter.LogEvent) _extra -> - // Exercise the accessors, then record what we saw and discard the event - // (returning `stop` keeps test output clean). `meta` values are Dynamic; - // OTP always stamps a `time` (system time in microseconds) onto the event. - BLogger.Filter.msg ev |> ignore - let m = BLogger.Filter.meta ev - Erlang.put timeKey (Maps.get (Erlang.binaryToAtom "time") m) |> ignore - Erlang.put seenKey (BLogger.Filter.level ev) |> ignore - BLogger.Filter.stop) - - assertThat (BLogger.Filter.addPrimary filterId filter (Erlang.binaryToAtom "ok")) (isEqualTo (Ok())) - - // `error` is above the default primary level (`notice`), so it reaches the filter. - BLogger.error "trigger for filter" - - match Erlang.get seenKey with - | Some lvl -> assertThat lvl (isEqualTo BLogger.LogLevel.Error) - | None -> failwith "filter saw the event" - - // The metadata `time` came out as Dynamic and decodes to a positive integer. - match Erlang.get timeKey with - | Some d -> - match Decode.int d with - | Ok t -> assertThat ((t > 0)) (isTrue) - | Error _ -> failwith "time decodes to int" - | None -> failwith "time present in meta" - - assertThat (BLogger.Filter.removePrimary filterId) (isEqualTo (Ok())) - ) - - test ( - "Filter.removePrimary on unknown id returns Error", - fun _ -> - match BLogger.Filter.removePrimary (Erlang.binaryToAtom "fable_test_no_such_filter") with - | Error _ -> assertThat true (isTrue) - | Ok() -> failwith "Error" - ) - - test ( - "raw add_primary_filter ok path is not swallowed", - fun _ -> - // The opaque {FilterFun, Extra} tuple that Filter.addPrimary builds for you. - // Exercises the bare-ok success path of the raw IExports binding. - let filterId = Erlang.binaryToAtom "fable_test_raw_filter" - - let filterTuple: obj = - emitErlExpr () "{fun(RawLogEvent__, _) -> RawLogEvent__ end, ok}" - - assertThat (BLogger.addPrimaryFilterRaw filterId filterTuple) (isEqualTo (Ok())) - assertThat (BLogger.Filter.removePrimary filterId) (isEqualTo (Ok())) - ) - - test ( - "set_primary_config ok path is not swallowed", - fun _ -> - // Setting filter_default to its default (`log`) is behaviourally a no-op but - // exercises the bare-ok success path — a missing wrapper would fall through. - assertThat - (BLogger.setPrimaryConfig (Erlang.binaryToAtom "filter_default") (Erlang.binaryToAtom "log")) - (isEqualTo (Ok())) - ) - - test ( - "Formatter.setTemplate updates a handler's formatter", - fun _ -> - let handlerId = Erlang.binaryToAtom "fable_test_fmt_handler" - let modle = Erlang.binaryToAtom "logger_std_h" - - let config: BeamMap = - Maps.ofList [ (Erlang.binaryToAtom "level", box (Erlang.binaryToAtom "info")) ] - - assertThat (BLogger.addHandler handlerId modle config) (isEqualTo (Ok())) - - // Compact template exercising key / text / cond template items. - let sp = BLogger.Formatter.text " " - - let template = - [ BLogger.Formatter.key (Erlang.binaryToAtom "time") - sp - BLogger.Formatter.key (Erlang.binaryToAtom "level") - BLogger.Formatter.text ": " - BLogger.Formatter.cond - (Erlang.binaryToAtom "pid") - [ BLogger.Formatter.text "[" - BLogger.Formatter.key (Erlang.binaryToAtom "pid") - BLogger.Formatter.text "] " ] - [] - BLogger.Formatter.key (Erlang.binaryToAtom "msg") - BLogger.Formatter.text "\n" ] - - assertThat (BLogger.Formatter.setTemplate handlerId true template) (isEqualTo (Ok())) - - assertThat (BLogger.removeHandler handlerId) (isEqualTo (Ok())) - ) ] + [ + test ("logger.info works", fun _ -> BLogger.info "test info message") + + test ("logger.warning works", fun _ -> BLogger.warning "test warning message") + + test ("logger.debug works", fun _ -> BLogger.debug "test debug message") + + test ( + "logger.info with format args", + fun _ -> + // The 2-arg overload accepts both metadata maps and format args lists + BLogger.infoWith "test ~p message" (U2.Case2 [ box 42 ]) + ) + + test ( + "logger add and remove handler", + fun _ -> + // Round-trip a handler through add_handler/3 and remove_handler/1, asserting the + // ok | {error, term()} result maps to Ok () (and is not swallowed). + let handlerId = Erlang.binaryToAtom "test_handler" + let modle = Erlang.binaryToAtom "logger_std_h" + + let config: BeamMap = + Maps.ofList [ (Erlang.binaryToAtom "level", box (Erlang.binaryToAtom "info")) ] + + assertThat (BLogger.addHandler handlerId modle config) (isEqualTo (Ok())) + assertThat (BLogger.removeHandler handlerId) (isEqualTo (Ok())) + ) + + test ( + "Filter.addPrimary receives the event and can stop it", + fun _ -> + // Primary filters run in the logging (client) process, so the filter can record + // what it saw in this process's dictionary for us to assert on afterwards. + let filterId = Erlang.binaryToAtom "fable_test_filter" + let seenKey = Erlang.binaryToAtom "fable_test_seen_level" + let timeKey = Erlang.binaryToAtom "fable_test_seen_time" + + let filter = + System.Func<_, _, _>(fun (ev: BLogger.Filter.LogEvent) _extra -> + // Exercise the accessors, then record what we saw and discard the event + // (returning `stop` keeps test output clean). `meta` values are Dynamic; + // OTP always stamps a `time` (system time in microseconds) onto the event. + BLogger.Filter.msg ev |> ignore + let m = BLogger.Filter.meta ev + Erlang.put timeKey (Maps.get (Erlang.binaryToAtom "time") m) |> ignore + Erlang.put seenKey (BLogger.Filter.level ev) |> ignore + BLogger.Filter.stop) + + assertThat (BLogger.Filter.addPrimary filterId filter (Erlang.binaryToAtom "ok")) (isEqualTo (Ok())) + + // `error` is above the default primary level (`notice`), so it reaches the filter. + BLogger.error "trigger for filter" + + match Erlang.get seenKey with + | Some lvl -> assertThat lvl (isEqualTo BLogger.LogLevel.Error) + | None -> failwith "filter saw the event" + + // The metadata `time` came out as Dynamic and decodes to a positive integer. + match Erlang.get timeKey with + | Some d -> + match Decode.int d with + | Ok t -> assertThat ((t > 0)) (isTrue) + | Error _ -> failwith "time decodes to int" + | None -> failwith "time present in meta" + + assertThat (BLogger.Filter.removePrimary filterId) (isEqualTo (Ok())) + ) + + test ( + "Filter.removePrimary on unknown id returns Error", + fun _ -> + match BLogger.Filter.removePrimary (Erlang.binaryToAtom "fable_test_no_such_filter") with + | Error _ -> assertThat true (isTrue) + | Ok() -> failwith "Error" + ) + + test ( + "raw add_primary_filter ok path is not swallowed", + fun _ -> + // The opaque {FilterFun, Extra} tuple that Filter.addPrimary builds for you. + // Exercises the bare-ok success path of the raw IExports binding. + let filterId = Erlang.binaryToAtom "fable_test_raw_filter" + + let filterTuple: obj = + emitErlExpr () "{fun(RawLogEvent__, _) -> RawLogEvent__ end, ok}" + + assertThat (BLogger.addPrimaryFilterRaw filterId filterTuple) (isEqualTo (Ok())) + assertThat (BLogger.Filter.removePrimary filterId) (isEqualTo (Ok())) + ) + + test ( + "set_primary_config ok path is not swallowed", + fun _ -> + // Setting filter_default to its default (`log`) is behaviourally a no-op but + // exercises the bare-ok success path — a missing wrapper would fall through. + assertThat + (BLogger.setPrimaryConfig (Erlang.binaryToAtom "filter_default") (Erlang.binaryToAtom "log")) + (isEqualTo (Ok())) + ) + + test ( + "Formatter.setTemplate updates a handler's formatter", + fun _ -> + let handlerId = Erlang.binaryToAtom "fable_test_fmt_handler" + let modle = Erlang.binaryToAtom "logger_std_h" + + let config: BeamMap = + Maps.ofList [ (Erlang.binaryToAtom "level", box (Erlang.binaryToAtom "info")) ] + + assertThat (BLogger.addHandler handlerId modle config) (isEqualTo (Ok())) + + // Compact template exercising key / text / cond template items. + let sp = BLogger.Formatter.text " " + + let template = + [ + BLogger.Formatter.key (Erlang.binaryToAtom "time") + sp + BLogger.Formatter.key (Erlang.binaryToAtom "level") + BLogger.Formatter.text ": " + BLogger.Formatter.cond + (Erlang.binaryToAtom "pid") + [ + BLogger.Formatter.text "[" + BLogger.Formatter.key (Erlang.binaryToAtom "pid") + BLogger.Formatter.text "] " + ] + [] + BLogger.Formatter.key (Erlang.binaryToAtom "msg") + BLogger.Formatter.text "\n" + ] + + assertThat (BLogger.Formatter.setTemplate handlerId true template) (isEqualTo (Ok())) + + assertThat (BLogger.removeHandler handlerId) (isEqualTo (Ok())) + ) + ] ) diff --git a/test/TestMaps.fs b/test/TestMaps.fs index 8f2fe85..a012269 100644 --- a/test/TestMaps.fs +++ b/test/TestMaps.fs @@ -15,150 +15,152 @@ let private listLen (xs: BeamList<'T>) : int = nativeOnly let tests = testList ( "Maps", - [ test ( - "new_ creates an empty map", - fun _ -> - let m: BMaps.BeamMap = BMaps.empty () - assertThat (BMaps.size m) (isEqualTo 0) - ) - - test ( - "put and get round-trip", - fun _ -> - let m: BMaps.BeamMap = BMaps.empty () - let m = BMaps.put "key" "value" m - assertThat (BMaps.get "key" m) (isEqualTo "value") - ) - - test ( - "is_key works", - fun _ -> - let m: BMaps.BeamMap = BMaps.empty () - let m = BMaps.put "a" 1 m - assertThat (BMaps.containsKey "a" m) (isEqualTo true) - assertThat (BMaps.containsKey "b" m) (isEqualTo false) - ) - - test ( - "remove works", - fun _ -> - let m: BMaps.BeamMap = BMaps.empty () - let m = BMaps.put "a" 1 m - let m = BMaps.remove "a" m - assertThat (BMaps.size m) (isEqualTo 0) - ) - - test ( - "size works", - fun _ -> - let m: BMaps.BeamMap = BMaps.empty () - let m = BMaps.put "a" 1 m - let m = BMaps.put "b" 2 m - assertThat (BMaps.size m) (isEqualTo 2) - ) - - test ( - "merge works", - fun _ -> - let m1: BMaps.BeamMap = BMaps.put "a" 1 (BMaps.empty ()) - let m2 = BMaps.put "b" 2 (BMaps.empty ()) - let merged = BMaps.merge m1 m2 - assertThat (BMaps.size merged) (isEqualTo 2) - ) - - test ( - "keys and values", - fun _ -> - let m: BMaps.BeamMap = BMaps.empty () - let m = BMaps.put "a" 1 m - let m = BMaps.put "b" 2 m - assertThat (BMaps.keys m |> Array.length) (isEqualTo 2) - assertThat (BMaps.values m |> Array.length) (isEqualTo 2) - ) - - test ( - "get with default", - fun _ -> - let m: BMaps.BeamMap = BMaps.empty () - assertThat (BMaps.getOrDefault "missing" m 42) (isEqualTo 42) - ) - - test ( - "to_list and from_list", - fun _ -> - let m: BMaps.BeamMap = BMaps.empty () - let m = BMaps.put "a" 1 m - let lst = BMaps.toArray m - assertThat (Array.length lst) (isEqualTo 1) - let m2 = BMaps.ofArray lst - assertThat (BMaps.size m2) (isEqualTo 1) - ) - - test ( - "tryFind returns Some for existing key", - fun _ -> - let m: BMaps.BeamMap = BMaps.put "x" 99 (BMaps.empty ()) - assertThat (BMaps.tryFind "x" m) (isEqualTo (Some 99)) - ) - - test ( - "tryFind returns None for missing key", - fun _ -> - let m: BMaps.BeamMap = BMaps.empty () - assertThat (BMaps.tryFind "missing" m) (isEqualTo None) - ) - - test ( - "ofList builds a map from a literal list", - fun _ -> - let headers: BMaps.BeamMap = - BMaps.ofList [ "content-type", "text/html"; "server", "cowboy" ] - - assertThat (BMaps.size headers) (isEqualTo 2) - assertThat (BMaps.get "content-type" headers) (isEqualTo "text/html") - assertThat (BMaps.tryFind "server" headers) (isEqualTo (Some "cowboy")) - ) - - test ( - "keysRaw and valuesRaw return native lists matching keys and values", - fun _ -> - let m: BMaps.BeamMap = BMaps.ofList [ "a", 1; "b", 2; "c", 3 ] - // native lists carry the same data as the array-returning members, without the ref-wrap - assertThat (BMaps.keysRaw m |> listLen) (isEqualTo (BMaps.keys m |> Array.length)) - assertThat (BMaps.valuesRaw m |> listLen) (isEqualTo (BMaps.values m |> Array.length)) - assertThat (BMaps.keysRaw m |> listLen) (isEqualTo 3) - ) - - test ( - "toListRaw returns native list of pairs", - fun _ -> - let m: BMaps.BeamMap = BMaps.ofList [ "a", 1; "b", 2 ] - assertThat (BMaps.toListRaw m |> listLen) (isEqualTo 2) - ) - - test ( - "maps.fold accumulates over key-value pairs", - fun _ -> - // maps:fold/3 applies F(K, V, Acc) — the only 3-arity callback in the bindings. - let m: BMaps.BeamMap = BMaps.ofList [ ("a", 1); ("b", 2); ("c", 3) ] - assertThat (BMaps.fold (fun _k v acc -> v + acc) 0 m) (isEqualTo 6) - ) - - test ( - "maps.map transforms each value", - fun _ -> - let m: BMaps.BeamMap = BMaps.ofList [ ("a", 1); ("b", 2) ] - let doubled = BMaps.map (fun _k v -> v * 2) m - assertThat (BMaps.get "a" doubled) (isEqualTo 2) - assertThat (BMaps.get "b" doubled) (isEqualTo 4) - ) - - test ( - "maps.filter keeps matching pairs", - fun _ -> - let m: BMaps.BeamMap = BMaps.ofList [ ("a", 1); ("b", 2); ("c", 3) ] - let big = BMaps.filter (fun _k v -> v > 1) m - assertThat (BMaps.size big) (isEqualTo 2) - assertThat (BMaps.containsKey "a" big) (isEqualTo false) - ) ] + [ + test ( + "new_ creates an empty map", + fun _ -> + let m: BMaps.BeamMap = BMaps.empty () + assertThat (BMaps.size m) (isEqualTo 0) + ) + + test ( + "put and get round-trip", + fun _ -> + let m: BMaps.BeamMap = BMaps.empty () + let m = BMaps.put "key" "value" m + assertThat (BMaps.get "key" m) (isEqualTo "value") + ) + + test ( + "is_key works", + fun _ -> + let m: BMaps.BeamMap = BMaps.empty () + let m = BMaps.put "a" 1 m + assertThat (BMaps.containsKey "a" m) (isEqualTo true) + assertThat (BMaps.containsKey "b" m) (isEqualTo false) + ) + + test ( + "remove works", + fun _ -> + let m: BMaps.BeamMap = BMaps.empty () + let m = BMaps.put "a" 1 m + let m = BMaps.remove "a" m + assertThat (BMaps.size m) (isEqualTo 0) + ) + + test ( + "size works", + fun _ -> + let m: BMaps.BeamMap = BMaps.empty () + let m = BMaps.put "a" 1 m + let m = BMaps.put "b" 2 m + assertThat (BMaps.size m) (isEqualTo 2) + ) + + test ( + "merge works", + fun _ -> + let m1: BMaps.BeamMap = BMaps.put "a" 1 (BMaps.empty ()) + let m2 = BMaps.put "b" 2 (BMaps.empty ()) + let merged = BMaps.merge m1 m2 + assertThat (BMaps.size merged) (isEqualTo 2) + ) + + test ( + "keys and values", + fun _ -> + let m: BMaps.BeamMap = BMaps.empty () + let m = BMaps.put "a" 1 m + let m = BMaps.put "b" 2 m + assertThat (BMaps.keys m |> Array.length) (isEqualTo 2) + assertThat (BMaps.values m |> Array.length) (isEqualTo 2) + ) + + test ( + "get with default", + fun _ -> + let m: BMaps.BeamMap = BMaps.empty () + assertThat (BMaps.getOrDefault "missing" m 42) (isEqualTo 42) + ) + + test ( + "to_list and from_list", + fun _ -> + let m: BMaps.BeamMap = BMaps.empty () + let m = BMaps.put "a" 1 m + let lst = BMaps.toArray m + assertThat (Array.length lst) (isEqualTo 1) + let m2 = BMaps.ofArray lst + assertThat (BMaps.size m2) (isEqualTo 1) + ) + + test ( + "tryFind returns Some for existing key", + fun _ -> + let m: BMaps.BeamMap = BMaps.put "x" 99 (BMaps.empty ()) + assertThat (BMaps.tryFind "x" m) (isEqualTo (Some 99)) + ) + + test ( + "tryFind returns None for missing key", + fun _ -> + let m: BMaps.BeamMap = BMaps.empty () + assertThat (BMaps.tryFind "missing" m) (isEqualTo None) + ) + + test ( + "ofList builds a map from a literal list", + fun _ -> + let headers: BMaps.BeamMap = + BMaps.ofList [ "content-type", "text/html"; "server", "cowboy" ] + + assertThat (BMaps.size headers) (isEqualTo 2) + assertThat (BMaps.get "content-type" headers) (isEqualTo "text/html") + assertThat (BMaps.tryFind "server" headers) (isEqualTo (Some "cowboy")) + ) + + test ( + "keysRaw and valuesRaw return native lists matching keys and values", + fun _ -> + let m: BMaps.BeamMap = BMaps.ofList [ "a", 1; "b", 2; "c", 3 ] + // native lists carry the same data as the array-returning members, without the ref-wrap + assertThat (BMaps.keysRaw m |> listLen) (isEqualTo (BMaps.keys m |> Array.length)) + assertThat (BMaps.valuesRaw m |> listLen) (isEqualTo (BMaps.values m |> Array.length)) + assertThat (BMaps.keysRaw m |> listLen) (isEqualTo 3) + ) + + test ( + "toListRaw returns native list of pairs", + fun _ -> + let m: BMaps.BeamMap = BMaps.ofList [ "a", 1; "b", 2 ] + assertThat (BMaps.toListRaw m |> listLen) (isEqualTo 2) + ) + + test ( + "maps.fold accumulates over key-value pairs", + fun _ -> + // maps:fold/3 applies F(K, V, Acc) — the only 3-arity callback in the bindings. + let m: BMaps.BeamMap = BMaps.ofList [ ("a", 1); ("b", 2); ("c", 3) ] + assertThat (BMaps.fold (fun _k v acc -> v + acc) 0 m) (isEqualTo 6) + ) + + test ( + "maps.map transforms each value", + fun _ -> + let m: BMaps.BeamMap = BMaps.ofList [ ("a", 1); ("b", 2) ] + let doubled = BMaps.map (fun _k v -> v * 2) m + assertThat (BMaps.get "a" doubled) (isEqualTo 2) + assertThat (BMaps.get "b" doubled) (isEqualTo 4) + ) + + test ( + "maps.filter keeps matching pairs", + fun _ -> + let m: BMaps.BeamMap = BMaps.ofList [ ("a", 1); ("b", 2); ("c", 3) ] + let big = BMaps.filter (fun _k v -> v > 1) m + assertThat (BMaps.size big) (isEqualTo 2) + assertThat (BMaps.containsKey "a" big) (isEqualTo false) + ) + ] ) diff --git a/test/TestMath.fs b/test/TestMath.fs index 6a752bc..4d6d160 100644 --- a/test/TestMath.fs +++ b/test/TestMath.fs @@ -12,56 +12,58 @@ module BMath = Fable.Beam.Math let tests = testList ( "Math", - [ test ( - "pi returns pi", - fun _ -> - let piValue = BMath.pi () - // pi is approximately 3.14159 - assertThat (piValue > 3.14 && piValue < 3.15) (isTrue) - ) + [ + test ( + "pi returns pi", + fun _ -> + let piValue = BMath.pi () + // pi is approximately 3.14159 + assertThat (piValue > 3.14 && piValue < 3.15) (isTrue) + ) - test ("sin of zero is zero", fun _ -> assertThat (BMath.sin 0.0) (isEqualTo 0.0)) + test ("sin of zero is zero", fun _ -> assertThat (BMath.sin 0.0) (isEqualTo 0.0)) - test ("cos of zero is one", fun _ -> assertThat (BMath.cos 0.0) (isEqualTo 1.0)) + test ("cos of zero is one", fun _ -> assertThat (BMath.cos 0.0) (isEqualTo 1.0)) - test ("sqrt of four is two", fun _ -> assertThat (BMath.sqrt 4.0) (isEqualTo 2.0)) + test ("sqrt of four is two", fun _ -> assertThat (BMath.sqrt 4.0) (isEqualTo 2.0)) - test ("pow computes power", fun _ -> assertThat (BMath.pow 2.0 10.0) (isEqualTo 1024.0)) + test ("pow computes power", fun _ -> assertThat (BMath.pow 2.0 10.0) (isEqualTo 1024.0)) - test ("exp of zero is one", fun _ -> assertThat (BMath.exp 0.0) (isEqualTo 1.0)) + test ("exp of zero is one", fun _ -> assertThat (BMath.exp 0.0) (isEqualTo 1.0)) - test ( - "log of e is one", - fun _ -> - let e = BMath.exp 1.0 - let result = BMath.log e - // result should be approximately 1.0 - assertThat (result > 0.9999 && result < 1.0001) (isTrue) - ) + test ( + "log of e is one", + fun _ -> + let e = BMath.exp 1.0 + let result = BMath.log e + // result should be approximately 1.0 + assertThat (result > 0.9999 && result < 1.0001) (isTrue) + ) - test ( - "log2 of eight is three", - fun _ -> - let result = BMath.log2 8.0 - assertThat (result > 2.9999 && result < 3.0001) (isTrue) - ) + test ( + "log2 of eight is three", + fun _ -> + let result = BMath.log2 8.0 + assertThat (result > 2.9999 && result < 3.0001) (isTrue) + ) - test ( - "log10 of one hundred is two", - fun _ -> - let result = BMath.log10 100.0 - assertThat (result > 1.9999 && result < 2.0001) (isTrue) - ) + test ( + "log10 of one hundred is two", + fun _ -> + let result = BMath.log10 100.0 + assertThat (result > 1.9999 && result < 2.0001) (isTrue) + ) - test ("floor rounds down", fun _ -> assertThat (BMath.floor 3.9) (isEqualTo 3.0)) + test ("floor rounds down", fun _ -> assertThat (BMath.floor 3.9) (isEqualTo 3.0)) - test ("ceil rounds up", fun _ -> assertThat (BMath.ceil 3.1) (isEqualTo 4.0)) + test ("ceil rounds up", fun _ -> assertThat (BMath.ceil 3.1) (isEqualTo 4.0)) - test ( - "atan2 quadrant", - fun _ -> - // atan2(1, 1) = pi/4 approximately 0.785 - let result = BMath.atan2 1.0 1.0 - assertThat (result > 0.78 && result < 0.79) (isTrue) - ) ] + test ( + "atan2 quadrant", + fun _ -> + // atan2(1, 1) = pi/4 approximately 0.785 + let result = BMath.atan2 1.0 1.0 + assertThat (result > 0.78 && result < 0.79) (isTrue) + ) + ] ) diff --git a/test/TestOs.fs b/test/TestOs.fs index 63d8517..3770fbd 100644 --- a/test/TestOs.fs +++ b/test/TestOs.fs @@ -10,99 +10,101 @@ open Fable.Beam.Os let tests = testList ( "Os", - [ test ( - "getenv returns None for unset var", - fun _ -> assertThat (getenv "FABLE_BEAM_TEST_UNSET_12345") (isEqualTo None) - ) + [ + test ( + "getenv returns None for unset var", + fun _ -> assertThat (getenv "FABLE_BEAM_TEST_UNSET_12345") (isEqualTo None) + ) - test ( - "putenv and getenv roundtrip", - fun _ -> - putenv "FABLE_BEAM_TEST_VAR" "hello_beam" - assertThat (getenv "FABLE_BEAM_TEST_VAR") (isEqualTo (Some "hello_beam")) - unsetenv "FABLE_BEAM_TEST_VAR" - ) + test ( + "putenv and getenv roundtrip", + fun _ -> + putenv "FABLE_BEAM_TEST_VAR" "hello_beam" + assertThat (getenv "FABLE_BEAM_TEST_VAR") (isEqualTo (Some "hello_beam")) + unsetenv "FABLE_BEAM_TEST_VAR" + ) - test ( - "unsetenv removes a variable", - fun _ -> - putenv "FABLE_BEAM_TEST_UNSET" "temp" - unsetenv "FABLE_BEAM_TEST_UNSET" - assertThat (getenv "FABLE_BEAM_TEST_UNSET") (isEqualTo None) - ) + test ( + "unsetenv removes a variable", + fun _ -> + putenv "FABLE_BEAM_TEST_UNSET" "temp" + unsetenv "FABLE_BEAM_TEST_UNSET" + assertThat (getenv "FABLE_BEAM_TEST_UNSET") (isEqualTo None) + ) - test ( - "getenv returns Some for HOME", - fun _ -> - match getenv "HOME" with - | Some home -> assertThat ((String.length home > 0)) (isTrue) - | None -> - // HOME should be set on any unix system - failwith "expected HOME to be set" - ) + test ( + "getenv returns Some for HOME", + fun _ -> + match getenv "HOME" with + | Some home -> assertThat ((String.length home > 0)) (isTrue) + | None -> + // HOME should be set on any unix system + failwith "expected HOME to be set" + ) - test ( - "cmd runs a command", - fun _ -> - let result = cmd "echo hello" - assertThat result (isEqualTo "hello\n") - ) + test ( + "cmd runs a command", + fun _ -> + let result = cmd "echo hello" + assertThat result (isEqualTo "hello\n") + ) - test ( - "systemTimeSeconds returns positive", - fun _ -> - let t = systemTimeSeconds () - assertThat ((t > 0)) (isTrue) - ) + test ( + "systemTimeSeconds returns positive", + fun _ -> + let t = systemTimeSeconds () + assertThat ((t > 0)) (isTrue) + ) - test ( - "systemTime with TimeUnit returns a sensible value", - fun _ -> - // Exercises the TimeUnit DU: each case compiles to its time-unit atom. - let secs = systemTime TimeUnit.Second - assertThat ((secs > 1_000_000_000L)) (isTrue) - let micros = systemTime TimeUnit.Microsecond - assertThat ((micros > secs)) (isTrue) - ) + test ( + "systemTime with TimeUnit returns a sensible value", + fun _ -> + // Exercises the TimeUnit DU: each case compiles to its time-unit atom. + let secs = systemTime TimeUnit.Second + assertThat ((secs > 1_000_000_000L)) (isTrue) + let micros = systemTime TimeUnit.Microsecond + assertThat ((micros > secs)) (isTrue) + ) - test ( - "systemTimeMs is monotonically increasing", - fun _ -> - let t1 = systemTimeMs () - let t2 = systemTimeMs () - assertThat ((t2 >= t1)) (isTrue) - ) + test ( + "systemTimeMs is monotonically increasing", + fun _ -> + let t1 = systemTimeMs () + let t2 = systemTimeMs () + assertThat ((t2 >= t1)) (isTrue) + ) - test ( - "systemTimeMs returns int64 value above 32-bit range", - fun _ -> - let t = systemTimeMs () - // Millisecond timestamps are around 1.7 * 10^12, well above int32 max (~2.1 * 10^9) - assertThat ((t > 1_000_000_000_000L)) (isTrue) - ) + test ( + "systemTimeMs returns int64 value above 32-bit range", + fun _ -> + let t = systemTimeMs () + // Millisecond timestamps are around 1.7 * 10^12, well above int32 max (~2.1 * 10^9) + assertThat ((t > 1_000_000_000_000L)) (isTrue) + ) - test ( - "systemTimeSeconds returns int64", - fun _ -> - let t = systemTimeSeconds () - // Unix epoch seconds are around 1.7 * 10^9 - assertThat ((t > 1_000_000_000L)) (isTrue) - ) + test ( + "systemTimeSeconds returns int64", + fun _ -> + let t = systemTimeSeconds () + // Unix epoch seconds are around 1.7 * 10^9 + assertThat ((t > 1_000_000_000L)) (isTrue) + ) - test ( - "osType returns a string tuple", - fun _ -> - let (family, _name) = osType () - // Should be "unix" on Linux/macOS or "win32" on Windows - assertThat ((family = "unix" || family = "win32")) (isTrue) - ) + test ( + "osType returns a string tuple", + fun _ -> + let (family, _name) = osType () + // Should be "unix" on Linux/macOS or "win32" on Windows + assertThat ((family = "unix" || family = "win32")) (isTrue) + ) - test ( - "version returns an int tuple", - fun _ -> - let (major, minor, release) = version () - assertThat ((major >= 0)) (isTrue) - assertThat ((minor >= 0)) (isTrue) - assertThat ((release >= 0)) (isTrue) - ) ] + test ( + "version returns an int tuple", + fun _ -> + let (major, minor, release) = version () + assertThat ((major >= 0)) (isTrue) + assertThat ((minor >= 0)) (isTrue) + assertThat ((release >= 0)) (isTrue) + ) + ] ) diff --git a/test/TestPort.fs b/test/TestPort.fs index 3e7c884..f826f76 100644 --- a/test/TestPort.fs +++ b/test/TestPort.fs @@ -18,255 +18,259 @@ type MailboxProbe = | [] Unrelated let private options arguments maxLineLength = { PortOptions.defaultOptions with arguments = arguments - maxLineLength = maxLineLength } + maxLineLength = maxLineLength + } #endif let tests = testList ( "Port", - [ test ( - "port streams a complete line and exit status", - fun _ -> - // This is a deliberately small fixture: sh reads one stdin line, echoes it, - // and exits. The script is an argument to a fixed executable, not a command - // assembled by the port binding. - let script = "read line; printf '%s\n' \"$line\"; exit 7" - - let port = - match startAbsolute "/bin/sh" (options [ "-c"; script ] 128) with - | Ok port -> port - | Error reason -> failwithf "could not start port fixture: %s" reason - - assertThat (send port "hello from port\n") (isTrue) - - match receive port 1000 with - | Some(Line data) -> assertThat data (isEqualTo "hello from port") - | Some message -> failwithf "expected line data, got %A" message - | None -> failwith "timed out waiting for port line" - - match receive port 1000 with - | Some(ExitStatus status) -> assertThat status (isEqualTo 7) - | Some message -> failwithf "expected exit status, got %A" message - | None -> failwith "timed out waiting for port exit status" - ) - - test ( - "port path lookup and close", - fun _ -> - let port = - match startOnPath "cat" (options [] 128) with - | Ok port -> port - | Error reason -> failwithf "could not find cat on PATH: %s" reason - - assertThat (send port "close probe\n") (isTrue) - - match receive port 1000 with - | Some(Line data) -> assertThat data (isEqualTo "close probe") - | Some message -> failwithf "expected line data, got %A" message - | None -> failwith "timed out waiting for port line" - - close port - ) - - test ( - "port delivers an incomplete line when the process ends mid-line", - fun _ -> - // `printf` with no trailing newline: the process ends mid-line. With `exit_status` - // enabled, ERTS delivers both the pending partial line (`{data, {noeol, ...}}`) and - // the exit status. Their relative order is an ERTS implementation detail — on this - // runtime the exit status arrives first — so assert on the two trailing messages - // without depending on which one is delivered first. - let port = - match startAbsolute "/bin/sh" (options [ "-c"; "printf 'partial'; exit 3" ] 128) with - | Ok port -> port - | Error reason -> failwithf "could not start port fixture: %s" reason - - let trailing = - [ receive port 1000; receive port 1000 ] - |> List.filter (fun m -> m <> None) - |> List.map Option.get - - assertThat - ((trailing - |> List.exists (function - | IncompleteLine d -> d = "partial" - | _ -> false))) - (isTrue) - - assertThat - ((trailing - |> List.exists (function - | ExitStatus s -> s = 3 - | _ -> false))) - (isTrue) - ) - - test ( - "port receive leaves unrelated mailbox messages behind", - fun _ -> - // Inject an unrelated message into this process's mailbox before the port reads, - // to verify the selective port receive skips it and leaves it for the mailbox owner. - emitErlExpr () "erlang:self() ! unrelated_probe" - - let port = - match - startAbsolute "/bin/sh" (options [ "-c"; "read line; printf '%s\n' \"$line\"; exit 0" ] 128) - with - | Ok port -> port - | Error reason -> failwithf "could not start port fixture: %s" reason - - assertThat (send port "selective probe\n") (isTrue) - - // Selective receive must skip the unrelated message and deliver the port line. - match receive port 1000 with - | Some(Line data) -> assertThat data (isEqualTo "selective probe") - | Some message -> failwithf "expected line data, got %A" message - | None -> failwith "timed out waiting for port line" - - // Drain the port's exit status; selective receive still skips the unrelated message. - match receive port 1000 with - | Some(ExitStatus status) -> assertThat status (isEqualTo 0) - | Some message -> failwithf "expected exit status, got %A" message - | None -> failwith "timed out waiting for exit status" - - // The unrelated message must still be in the mailbox, undisturbed. - match Erlang.receive 1000 with - | Some Unrelated -> assertThat 1 (isEqualTo 1) - | _ -> failwith "unrelated mailbox message was lost by selective receive" - ) - - test ( - "port startAbsolute rejects a relative path", - fun _ -> - match startAbsolute "some/relative/path" (options [] 128) with - | Error reason -> - assertThat - reason - (isEqualTo - "path must be absolute, maxLineLength must be positive, and stderrToStdout requires useStdio") - | Ok _ -> failwith "expected an error for a relative path" - ) - - test ( - "port startOnPath errors when the executable is missing", - fun _ -> - match startOnPath "definitely_not_a_real_executable_xyz" (options [] 128) with - | Error reason -> assertThat reason (isEqualTo "executable not found on PATH") - | Ok _ -> failwith "expected an error for a missing executable" - ) - - test ( - "port rejects a non-positive maxLineLength", - fun _ -> - match startAbsolute "/bin/sh" (options [] 0) with - | Error reason -> - assertThat - reason - (isEqualTo - "path must be absolute, maxLineLength must be positive, and stderrToStdout requires useStdio") - | Ok _ -> failwith "expected an error for maxLineLength 0" - - match startOnPath "cat" (options [] 0) with - | Error reason -> - assertThat - reason - (isEqualTo "maxLineLength must be positive and stderrToStdout requires useStdio") - | Ok _ -> failwith "expected an error for maxLineLength 0" - ) - - test ( - "port options redirect stderr and apply child environment", - fun _ -> - // The shell script writes two lines to stdout (one with the configured env value - // and working dir) and a diagnostic line to stderr, merged via stderrToStdout. - let script = - "printf '%s:%s\\n' \"$PORT_TEST_VALUE\" \"$PWD\"; printf 'diagnostic\\n' >&2" - - let portOptions = - { PortOptions.defaultOptions with - arguments = [ "-c"; script ] - maxLineLength = 128 - stderrToStdout = true - workingDirectory = Some "/tmp" - environment = [ "PORT_TEST_VALUE", "configured" ] } - - let port = - match startAbsolute "/bin/sh" portOptions with - | Ok port -> port - | Error reason -> failwithf "could not start configured port fixture: %s" reason - - let lines = - receiveUntil port 1000 - |> List.filter (function - | Line _ -> true - | _ -> false) - |> List.map (function - | Line data -> data - | _ -> failwith "unreachable") - - assertThat lines (isEqualTo [ "configured:/tmp"; "diagnostic" ]) - ) - - test ( - "port lifecycle operations are non-throwing after exit", - fun _ -> - let port = - match startAbsolute "/bin/sh" (options [ "-c"; "exit 0" ] 128) with - | Ok port -> port - | Error reason -> failwithf "could not start port fixture: %s" reason - - receiveUntil port 1000 |> ignore - - match trySend port "too late\n" with - | Error _ -> assertThat true (isTrue) - | Ok() -> failwith "sending to an exited port should fail" - - match tryClose port with - | Error _ -> assertThat true (isTrue) - | Ok() -> failwith "closing an exited port should fail" - ) - - test ( - "port foldMessages keeps trailing oversized JSONL fragments after exit", - fun _ -> - let port = - match - startAbsolute "/bin/sh" (options [ "-c"; "printf '{\\\"value\\\":\\\"0123456789\\\"}'" ] 8) - with - | Ok port -> port - | Error reason -> failwithf "could not start port fixture: %s" reason - - let messages = - foldMessages port 1000 (fun messages message -> message :: messages) [] - |> List.rev - - assertThat - ((messages - |> List.exists (function - | ExitStatus 0 -> true - | _ -> false))) - (isTrue) - - assertThat - ((messages - |> List.exists (function - | IncompleteLine data -> data.Contains "0123456789" || data.Length = 8 - | _ -> false))) - (isTrue) - ) - - test ( - "monitored port emits a typed down notification", - fun _ -> - let port = - match startAbsolute "/bin/sh" (options [ "-c"; "exit 0" ] 128) with - | Ok port -> port - | Error reason -> failwithf "could not start port fixture: %s" reason - - let portMonitor = monitor port - - match receiveDown port portMonitor 1000 with - | Some(Down reason) -> assertThat reason (isEqualTo "normal") - | None -> failwith "timed out waiting for port down notification" - ) ] + [ + test ( + "port streams a complete line and exit status", + fun _ -> + // This is a deliberately small fixture: sh reads one stdin line, echoes it, + // and exits. The script is an argument to a fixed executable, not a command + // assembled by the port binding. + let script = "read line; printf '%s\n' \"$line\"; exit 7" + + let port = + match startAbsolute "/bin/sh" (options [ "-c"; script ] 128) with + | Ok port -> port + | Error reason -> failwithf "could not start port fixture: %s" reason + + assertThat (send port "hello from port\n") (isTrue) + + match receive port 1000 with + | Some(Line data) -> assertThat data (isEqualTo "hello from port") + | Some message -> failwithf "expected line data, got %A" message + | None -> failwith "timed out waiting for port line" + + match receive port 1000 with + | Some(ExitStatus status) -> assertThat status (isEqualTo 7) + | Some message -> failwithf "expected exit status, got %A" message + | None -> failwith "timed out waiting for port exit status" + ) + + test ( + "port path lookup and close", + fun _ -> + let port = + match startOnPath "cat" (options [] 128) with + | Ok port -> port + | Error reason -> failwithf "could not find cat on PATH: %s" reason + + assertThat (send port "close probe\n") (isTrue) + + match receive port 1000 with + | Some(Line data) -> assertThat data (isEqualTo "close probe") + | Some message -> failwithf "expected line data, got %A" message + | None -> failwith "timed out waiting for port line" + + close port + ) + + test ( + "port delivers an incomplete line when the process ends mid-line", + fun _ -> + // `printf` with no trailing newline: the process ends mid-line. With `exit_status` + // enabled, ERTS delivers both the pending partial line (`{data, {noeol, ...}}`) and + // the exit status. Their relative order is an ERTS implementation detail — on this + // runtime the exit status arrives first — so assert on the two trailing messages + // without depending on which one is delivered first. + let port = + match startAbsolute "/bin/sh" (options [ "-c"; "printf 'partial'; exit 3" ] 128) with + | Ok port -> port + | Error reason -> failwithf "could not start port fixture: %s" reason + + let trailing = + [ receive port 1000; receive port 1000 ] + |> List.filter (fun m -> m <> None) + |> List.map Option.get + + assertThat + ((trailing + |> List.exists (function + | IncompleteLine d -> d = "partial" + | _ -> false))) + (isTrue) + + assertThat + ((trailing + |> List.exists (function + | ExitStatus s -> s = 3 + | _ -> false))) + (isTrue) + ) + + test ( + "port receive leaves unrelated mailbox messages behind", + fun _ -> + // Inject an unrelated message into this process's mailbox before the port reads, + // to verify the selective port receive skips it and leaves it for the mailbox owner. + emitErlExpr () "erlang:self() ! unrelated_probe" + + let port = + match + startAbsolute "/bin/sh" (options [ "-c"; "read line; printf '%s\n' \"$line\"; exit 0" ] 128) + with + | Ok port -> port + | Error reason -> failwithf "could not start port fixture: %s" reason + + assertThat (send port "selective probe\n") (isTrue) + + // Selective receive must skip the unrelated message and deliver the port line. + match receive port 1000 with + | Some(Line data) -> assertThat data (isEqualTo "selective probe") + | Some message -> failwithf "expected line data, got %A" message + | None -> failwith "timed out waiting for port line" + + // Drain the port's exit status; selective receive still skips the unrelated message. + match receive port 1000 with + | Some(ExitStatus status) -> assertThat status (isEqualTo 0) + | Some message -> failwithf "expected exit status, got %A" message + | None -> failwith "timed out waiting for exit status" + + // The unrelated message must still be in the mailbox, undisturbed. + match Erlang.receive 1000 with + | Some Unrelated -> assertThat 1 (isEqualTo 1) + | _ -> failwith "unrelated mailbox message was lost by selective receive" + ) + + test ( + "port startAbsolute rejects a relative path", + fun _ -> + match startAbsolute "some/relative/path" (options [] 128) with + | Error reason -> + assertThat + reason + (isEqualTo + "path must be absolute, maxLineLength must be positive, and stderrToStdout requires useStdio") + | Ok _ -> failwith "expected an error for a relative path" + ) + + test ( + "port startOnPath errors when the executable is missing", + fun _ -> + match startOnPath "definitely_not_a_real_executable_xyz" (options [] 128) with + | Error reason -> assertThat reason (isEqualTo "executable not found on PATH") + | Ok _ -> failwith "expected an error for a missing executable" + ) + + test ( + "port rejects a non-positive maxLineLength", + fun _ -> + match startAbsolute "/bin/sh" (options [] 0) with + | Error reason -> + assertThat + reason + (isEqualTo + "path must be absolute, maxLineLength must be positive, and stderrToStdout requires useStdio") + | Ok _ -> failwith "expected an error for maxLineLength 0" + + match startOnPath "cat" (options [] 0) with + | Error reason -> + assertThat + reason + (isEqualTo "maxLineLength must be positive and stderrToStdout requires useStdio") + | Ok _ -> failwith "expected an error for maxLineLength 0" + ) + + test ( + "port options redirect stderr and apply child environment", + fun _ -> + // The shell script writes two lines to stdout (one with the configured env value + // and working dir) and a diagnostic line to stderr, merged via stderrToStdout. + let script = + "printf '%s:%s\\n' \"$PORT_TEST_VALUE\" \"$PWD\"; printf 'diagnostic\\n' >&2" + + let portOptions = + { PortOptions.defaultOptions with + arguments = [ "-c"; script ] + maxLineLength = 128 + stderrToStdout = true + workingDirectory = Some "/tmp" + environment = [ "PORT_TEST_VALUE", "configured" ] + } + + let port = + match startAbsolute "/bin/sh" portOptions with + | Ok port -> port + | Error reason -> failwithf "could not start configured port fixture: %s" reason + + let lines = + receiveUntil port 1000 + |> List.filter (function + | Line _ -> true + | _ -> false) + |> List.map (function + | Line data -> data + | _ -> failwith "unreachable") + + assertThat lines (isEqualTo [ "configured:/tmp"; "diagnostic" ]) + ) + + test ( + "port lifecycle operations are non-throwing after exit", + fun _ -> + let port = + match startAbsolute "/bin/sh" (options [ "-c"; "exit 0" ] 128) with + | Ok port -> port + | Error reason -> failwithf "could not start port fixture: %s" reason + + receiveUntil port 1000 |> ignore + + match trySend port "too late\n" with + | Error _ -> assertThat true (isTrue) + | Ok() -> failwith "sending to an exited port should fail" + + match tryClose port with + | Error _ -> assertThat true (isTrue) + | Ok() -> failwith "closing an exited port should fail" + ) + + test ( + "port foldMessages keeps trailing oversized JSONL fragments after exit", + fun _ -> + let port = + match + startAbsolute "/bin/sh" (options [ "-c"; "printf '{\\\"value\\\":\\\"0123456789\\\"}'" ] 8) + with + | Ok port -> port + | Error reason -> failwithf "could not start port fixture: %s" reason + + let messages = + foldMessages port 1000 (fun messages message -> message :: messages) [] + |> List.rev + + assertThat + ((messages + |> List.exists (function + | ExitStatus 0 -> true + | _ -> false))) + (isTrue) + + assertThat + ((messages + |> List.exists (function + | IncompleteLine data -> data.Contains "0123456789" || data.Length = 8 + | _ -> false))) + (isTrue) + ) + + test ( + "monitored port emits a typed down notification", + fun _ -> + let port = + match startAbsolute "/bin/sh" (options [ "-c"; "exit 0" ] 128) with + | Ok port -> port + | Error reason -> failwithf "could not start port fixture: %s" reason + + let portMonitor = monitor port + + match receiveDown port portMonitor 1000 with + | Some(Down reason) -> assertThat reason (isEqualTo "normal") + | None -> failwith "timed out waiting for port down notification" + ) + ] ) diff --git a/test/TestProplists.fs b/test/TestProplists.fs index d2a5ae6..7160a0e 100644 --- a/test/TestProplists.fs +++ b/test/TestProplists.fs @@ -15,121 +15,123 @@ module BProplists = Fable.Beam.Proplists let tests = testList ( "Proplists", - [ test ( - "get_value returns value when key found", - fun _ -> - // [{name, <<"alice">>}, {age, 30}] - let pl: BeamList = emitErlExpr () "[{name, <<\"alice\">>}, {age, 30}]" - let key = Erlang.binaryToAtom "name" - assertThat (BProplists.tryFind key pl) (isEqualTo (Some "alice")) - ) + [ + test ( + "get_value returns value when key found", + fun _ -> + // [{name, <<"alice">>}, {age, 30}] + let pl: BeamList = emitErlExpr () "[{name, <<\"alice\">>}, {age, 30}]" + let key = Erlang.binaryToAtom "name" + assertThat (BProplists.tryFind key pl) (isEqualTo (Some "alice")) + ) - test ( - "get_value returns None when key missing", - fun _ -> - let pl: BeamList = emitErlExpr () "[{name, <<\"alice\">>}]" - let key = Erlang.binaryToAtom "missing" - let result: string option = BProplists.tryFind key pl - assertThat result (isEqualTo None) - ) + test ( + "get_value returns None when key missing", + fun _ -> + let pl: BeamList = emitErlExpr () "[{name, <<\"alice\">>}]" + let key = Erlang.binaryToAtom "missing" + let result: string option = BProplists.tryFind key pl + assertThat result (isEqualTo None) + ) - test ( - "get_value with default returns value when key found", - fun _ -> - let pl: BeamList = emitErlExpr () "[{port, 443}]" - let portKey = Erlang.binaryToAtom "port" - let timeoutKey = Erlang.binaryToAtom "timeout" - assertThat (BProplists.getOrDefault portKey pl 80) (isEqualTo 443) - assertThat (BProplists.getOrDefault timeoutKey pl 5000) (isEqualTo 5000) - ) + test ( + "get_value with default returns value when key found", + fun _ -> + let pl: BeamList = emitErlExpr () "[{port, 443}]" + let portKey = Erlang.binaryToAtom "port" + let timeoutKey = Erlang.binaryToAtom "timeout" + assertThat (BProplists.getOrDefault portKey pl 80) (isEqualTo 443) + assertThat (BProplists.getOrDefault timeoutKey pl 5000) (isEqualTo 5000) + ) - test ( - "is_defined returns correct bool", - fun _ -> - let pl: BeamList = emitErlExpr () "[{ssl, true}, {port, 443}]" - let sslKey = Erlang.binaryToAtom "ssl" - let missingKey = Erlang.binaryToAtom "missing" - assertThat (BProplists.containsKey sslKey pl) (isEqualTo true) - assertThat (BProplists.containsKey missingKey pl) (isEqualTo false) - ) + test ( + "is_defined returns correct bool", + fun _ -> + let pl: BeamList = emitErlExpr () "[{ssl, true}, {port, 443}]" + let sslKey = Erlang.binaryToAtom "ssl" + let missingKey = Erlang.binaryToAtom "missing" + assertThat (BProplists.containsKey sslKey pl) (isEqualTo true) + assertThat (BProplists.containsKey missingKey pl) (isEqualTo false) + ) - test ( - "delete removes all entries with key", - fun _ -> - let pl: BeamList = emitErlExpr () "[{a, 1}, {b, 2}, {a, 3}]" - let aKey = Erlang.binaryToAtom "a" - let bKey = Erlang.binaryToAtom "b" - let result = BProplists.remove aKey pl - assertThat (BProplists.containsKey aKey result) (isEqualTo false) - assertThat (BProplists.containsKey bKey result) (isEqualTo true) - ) + test ( + "delete removes all entries with key", + fun _ -> + let pl: BeamList = emitErlExpr () "[{a, 1}, {b, 2}, {a, 3}]" + let aKey = Erlang.binaryToAtom "a" + let bKey = Erlang.binaryToAtom "b" + let result = BProplists.remove aKey pl + assertThat (BProplists.containsKey aKey result) (isEqualTo false) + assertThat (BProplists.containsKey bKey result) (isEqualTo true) + ) - test ( - "get_all_values returns all values for key", - fun _ -> - let pl: BeamList = emitErlExpr () "[{x, 1}, {y, 2}, {x, 3}]" - let xKey = Erlang.binaryToAtom "x" - let vs: BeamList = BProplists.getAllValues xKey pl - let expected: BeamList = emitErlExpr () "[1, 3]" - assertThat vs (isEqualTo expected) - ) + test ( + "get_all_values returns all values for key", + fun _ -> + let pl: BeamList = emitErlExpr () "[{x, 1}, {y, 2}, {x, 3}]" + let xKey = Erlang.binaryToAtom "x" + let vs: BeamList = BProplists.getAllValues xKey pl + let expected: BeamList = emitErlExpr () "[1, 3]" + assertThat vs (isEqualTo expected) + ) - test ( - "to_map converts proplist to map", - fun _ -> - let pl: BeamList = emitErlExpr () "[{a, 1}, {b, 2}]" - let m: BMaps.BeamMap = BProplists.toMap pl - let aKey = Erlang.binaryToAtom "a" - let bKey = Erlang.binaryToAtom "b" - assertThat (BMaps.get aKey m) (isEqualTo 1) - assertThat (BMaps.get bKey m) (isEqualTo 2) - ) + test ( + "to_map converts proplist to map", + fun _ -> + let pl: BeamList = emitErlExpr () "[{a, 1}, {b, 2}]" + let m: BMaps.BeamMap = BProplists.toMap pl + let aKey = Erlang.binaryToAtom "a" + let bKey = Erlang.binaryToAtom "b" + assertThat (BMaps.get aKey m) (isEqualTo 1) + assertThat (BMaps.get bKey m) (isEqualTo 2) + ) - test ( - "unfold expands bare atoms to {Atom, true}", - fun _ -> - // [ssl, {port, 443}] -> [{ssl, true}, {port, 443}] - let pl: BeamList = emitErlExpr () "[ssl, {port, 443}]" - let result = BProplists.unfold pl - let expected: BeamList = emitErlExpr () "[{ssl, true}, {port, 443}]" - assertThat result (isEqualTo expected) - ) + test ( + "unfold expands bare atoms to {Atom, true}", + fun _ -> + // [ssl, {port, 443}] -> [{ssl, true}, {port, 443}] + let pl: BeamList = emitErlExpr () "[ssl, {port, 443}]" + let result = BProplists.unfold pl + let expected: BeamList = emitErlExpr () "[{ssl, true}, {port, 443}]" + assertThat result (isEqualTo expected) + ) - test ( - "compact collapses {Atom, true} to bare atoms", - fun _ -> - // [{ssl, true}, {port, 443}] -> [ssl, {port, 443}] - let pl: BeamList = emitErlExpr () "[{ssl, true}, {port, 443}]" - let result = BProplists.compact pl - let expected: BeamList = emitErlExpr () "[ssl, {port, 443}]" - assertThat result (isEqualTo expected) - ) + test ( + "compact collapses {Atom, true} to bare atoms", + fun _ -> + // [{ssl, true}, {port, 443}] -> [ssl, {port, 443}] + let pl: BeamList = emitErlExpr () "[{ssl, true}, {port, 443}]" + let result = BProplists.compact pl + let expected: BeamList = emitErlExpr () "[ssl, {port, 443}]" + assertThat result (isEqualTo expected) + ) - test ( - "get_keys returns deduplicated keys", - fun _ -> - // [{a, 1}, {b, 2}, {a, 3}] -> [a, b] (unordered, no duplicates) - let pl: BeamList = emitErlExpr () "[{a, 1}, {b, 2}, {a, 3}]" - let ks: Atom array = BProplists.keys pl - assertThat (ks |> Array.length) (isEqualTo 2) - let aKey = Erlang.binaryToAtom "a" - let bKey = Erlang.binaryToAtom "b" - assertThat (ks |> Array.contains aKey) (isTrue) - assertThat (ks |> Array.contains bKey) (isTrue) - ) + test ( + "get_keys returns deduplicated keys", + fun _ -> + // [{a, 1}, {b, 2}, {a, 3}] -> [a, b] (unordered, no duplicates) + let pl: BeamList = emitErlExpr () "[{a, 1}, {b, 2}, {a, 3}]" + let ks: Atom array = BProplists.keys pl + assertThat (ks |> Array.length) (isEqualTo 2) + let aKey = Erlang.binaryToAtom "a" + let bKey = Erlang.binaryToAtom "b" + assertThat (ks |> Array.contains aKey) (isTrue) + assertThat (ks |> Array.contains bKey) (isTrue) + ) - test ( - "from_map converts map to proplist", - fun _ -> - let m: BMaps.BeamMap = BMaps.empty () - let aKey = Erlang.binaryToAtom "a" - let bKey = Erlang.binaryToAtom "b" - let m = BMaps.put aKey 1 m - let m = BMaps.put bKey 2 m - let pl: BeamList = BProplists.ofMap m - assertThat (BProplists.containsKey aKey pl) (isEqualTo true) - assertThat (BProplists.containsKey bKey pl) (isEqualTo true) - let aVal: int option = BProplists.tryFind aKey pl - assertThat aVal (isEqualTo (Some 1)) - ) ] + test ( + "from_map converts map to proplist", + fun _ -> + let m: BMaps.BeamMap = BMaps.empty () + let aKey = Erlang.binaryToAtom "a" + let bKey = Erlang.binaryToAtom "b" + let m = BMaps.put aKey 1 m + let m = BMaps.put bKey 2 m + let pl: BeamList = BProplists.ofMap m + assertThat (BProplists.containsKey aKey pl) (isEqualTo true) + assertThat (BProplists.containsKey bKey pl) (isEqualTo true) + let aVal: int option = BProplists.tryFind aKey pl + assertThat aVal (isEqualTo (Some 1)) + ) + ] ) diff --git a/test/TestQueue.fs b/test/TestQueue.fs index 9826598..1d8fce5 100644 --- a/test/TestQueue.fs +++ b/test/TestQueue.fs @@ -13,233 +13,235 @@ module BQueue = Fable.Beam.Queue let tests = testList ( "Queue", - [ test ( - "new creates empty queue", - fun _ -> - let q = BQueue.empty () - assertThat (BQueue.isEmpty q) (isTrue) - ) - - test ( - "is_queue returns true for queue", - fun _ -> - let q = BQueue.empty () - assertThat (BQueue.isQueue q) (isTrue) - ) - - test ("is_queue returns false for non-queue", fun _ -> assertThat (BQueue.isQueue (box 42)) (isFalse)) - - test ( - "len returns zero for empty queue", - fun _ -> - let q = BQueue.empty () - assertThat (BQueue.length q) (isEqualTo 0) - ) - - test ( - "in adds element at rear", - fun _ -> - let q = BQueue.empty () - let q1 = BQueue.enqueue 1 q - let q2 = BQueue.enqueue 2 q1 - assertThat (BQueue.length q2) (isEqualTo 2) - ) - - test ( - "in_r adds element at front", - fun _ -> - let q = BQueue.empty () - let q1 = BQueue.enqueue 1 q - let q2 = BQueue.enqueueFront 99 q1 - assertThat (BQueue.head q2) (isEqualTo 99) - ) - - test ( - "head returns front element", - fun _ -> - let q = BQueue.empty () - let q1 = BQueue.enqueue 10 q - let q2 = BQueue.enqueue 20 q1 - assertThat (BQueue.head q2) (isEqualTo 10) - ) - - test ( - "last returns rear element", - fun _ -> - let q = BQueue.empty () - let q1 = BQueue.enqueue 10 q - let q2 = BQueue.enqueue 20 q1 - assertThat (BQueue.last q2) (isEqualTo 20) - ) - - test ( - "tail removes front element", - fun _ -> - let q = BQueue.empty () - let q1 = BQueue.enqueue 1 q - let q2 = BQueue.enqueue 2 q1 - let q3 = BQueue.tail q2 - assertThat (BQueue.length q3) (isEqualTo 1) - assertThat (BQueue.head q3) (isEqualTo 2) - ) - - test ( - "init removes rear element", - fun _ -> - let q = BQueue.empty () - let q1 = BQueue.enqueue 1 q - let q2 = BQueue.enqueue 2 q1 - let q3 = BQueue.init q2 - assertThat (BQueue.length q3) (isEqualTo 1) - assertThat (BQueue.last q3) (isEqualTo 1) - ) - - test ( - "to_list returns elements front first", - fun _ -> - let q = BQueue.empty () - let q1 = BQueue.enqueue 1 q - let q2 = BQueue.enqueue 2 q1 - let q3 = BQueue.enqueue 3 q2 - assertThat (BQueue.toList q3) (isEqualTo [ 1; 2; 3 ]) - ) - - test ( - "from_list builds queue from list", - fun _ -> - let q = BQueue.ofList [ 1; 2; 3 ] - assertThat (BQueue.length q) (isEqualTo 3) - assertThat (BQueue.head q) (isEqualTo 1) - assertThat (BQueue.last q) (isEqualTo 3) - ) - - test ( - "member returns true when element present", - fun _ -> - let q = BQueue.ofList [ 1; 2; 3 ] - assertThat (BQueue.contains 2 q) (isTrue) - ) - - test ( - "member returns false when element absent", - fun _ -> - let q = BQueue.ofList [ 1; 2; 3 ] - assertThat (BQueue.contains 99 q) (isFalse) - ) - - test ( - "reverse reverses order", - fun _ -> - let q = BQueue.ofList [ 1; 2; 3 ] - let r = BQueue.reverse q - assertThat (BQueue.toList r) (isEqualTo [ 3; 2; 1 ]) - ) - - test ( - "join appends two queues", - fun _ -> - let q1 = BQueue.ofList [ 1; 2 ] - let q2 = BQueue.ofList [ 3; 4 ] - let q3 = BQueue.join q1 q2 - assertThat (BQueue.toList q3) (isEqualTo [ 1; 2; 3; 4 ]) - ) - - test ( - "filter keeps matching elements", - fun _ -> - let q = BQueue.ofList [ 1; 2; 3; 4; 5 ] - let evens = BQueue.filter (fun x -> x % 2 = 0) q - assertThat (BQueue.toList evens) (isEqualTo [ 2; 4 ]) - ) - - test ( - "out removes front element", - fun _ -> - let q = BQueue.ofList [ 10; 20; 30 ] - let (item, q2) = BQueue.out q - assertThat item (isEqualTo (Some 10)) - assertThat (BQueue.length q2) (isEqualTo 2) - ) - - test ( - "out returns None for empty queue", - fun _ -> - let q = BQueue.empty () - let (item, _) = BQueue.out q - assertThat item (isEqualTo None) - ) - - test ( - "outRear removes rear element", - fun _ -> - let q = BQueue.ofList [ 10; 20; 30 ] - let (item, q2) = BQueue.outRear q - assertThat item (isEqualTo (Some 30)) - assertThat (BQueue.length q2) (isEqualTo 2) - ) - - test ( - "outRear returns None for empty queue", - fun _ -> - let q = BQueue.empty () - let (item, _) = BQueue.outRear q - assertThat item (isEqualTo None) - ) - - test ( - "peek returns front element without removing", - fun _ -> - let q = BQueue.ofList [ 10; 20 ] - assertThat (BQueue.peek q) (isEqualTo (Some 10)) - assertThat (BQueue.length q) (isEqualTo 2) - ) - - test ( - "peek returns None for empty queue", - fun _ -> - let q = BQueue.empty () - assertThat (BQueue.peek q) (isEqualTo None) - ) - - test ( - "peekRear returns rear element without removing", - fun _ -> - let q = BQueue.ofList [ 10; 20; 30 ] - assertThat (BQueue.peekRear q) (isEqualTo (Some 30)) - assertThat (BQueue.length q) (isEqualTo 3) - ) - - test ( - "split divides queue at position", - fun _ -> - let q = BQueue.ofList [ 1; 2; 3; 4; 5 ] - let (q1, q2) = BQueue.split 3 q - assertThat (BQueue.toList q1) (isEqualTo [ 1; 2; 3 ]) - assertThat (BQueue.toList q2) (isEqualTo [ 4; 5 ]) - ) - - test ( - "split at zero yields empty front", - fun _ -> - let q = BQueue.ofList [ 1; 2; 3 ] - let (q1, q2) = BQueue.split 0 q - assertThat (BQueue.isEmpty q1) (isTrue) - assertThat (BQueue.toList q2) (isEqualTo [ 1; 2; 3 ]) - ) - - test ( - "fifo ordering is preserved", - fun _ -> - // Enqueue 1, 2, 3 — dequeue should yield 1, 2, 3 - let q0 = BQueue.empty () - let q1 = BQueue.enqueue 1 q0 - let q2 = BQueue.enqueue 2 q1 - let q3 = BQueue.enqueue 3 q2 - let (a, q4) = BQueue.out q3 - let (b, q5) = BQueue.out q4 - let (c, _) = BQueue.out q5 - assertThat a (isEqualTo (Some 1)) - assertThat b (isEqualTo (Some 2)) - assertThat c (isEqualTo (Some 3)) - ) ] + [ + test ( + "new creates empty queue", + fun _ -> + let q = BQueue.empty () + assertThat (BQueue.isEmpty q) (isTrue) + ) + + test ( + "is_queue returns true for queue", + fun _ -> + let q = BQueue.empty () + assertThat (BQueue.isQueue q) (isTrue) + ) + + test ("is_queue returns false for non-queue", fun _ -> assertThat (BQueue.isQueue (box 42)) (isFalse)) + + test ( + "len returns zero for empty queue", + fun _ -> + let q = BQueue.empty () + assertThat (BQueue.length q) (isEqualTo 0) + ) + + test ( + "in adds element at rear", + fun _ -> + let q = BQueue.empty () + let q1 = BQueue.enqueue 1 q + let q2 = BQueue.enqueue 2 q1 + assertThat (BQueue.length q2) (isEqualTo 2) + ) + + test ( + "in_r adds element at front", + fun _ -> + let q = BQueue.empty () + let q1 = BQueue.enqueue 1 q + let q2 = BQueue.enqueueFront 99 q1 + assertThat (BQueue.head q2) (isEqualTo 99) + ) + + test ( + "head returns front element", + fun _ -> + let q = BQueue.empty () + let q1 = BQueue.enqueue 10 q + let q2 = BQueue.enqueue 20 q1 + assertThat (BQueue.head q2) (isEqualTo 10) + ) + + test ( + "last returns rear element", + fun _ -> + let q = BQueue.empty () + let q1 = BQueue.enqueue 10 q + let q2 = BQueue.enqueue 20 q1 + assertThat (BQueue.last q2) (isEqualTo 20) + ) + + test ( + "tail removes front element", + fun _ -> + let q = BQueue.empty () + let q1 = BQueue.enqueue 1 q + let q2 = BQueue.enqueue 2 q1 + let q3 = BQueue.tail q2 + assertThat (BQueue.length q3) (isEqualTo 1) + assertThat (BQueue.head q3) (isEqualTo 2) + ) + + test ( + "init removes rear element", + fun _ -> + let q = BQueue.empty () + let q1 = BQueue.enqueue 1 q + let q2 = BQueue.enqueue 2 q1 + let q3 = BQueue.init q2 + assertThat (BQueue.length q3) (isEqualTo 1) + assertThat (BQueue.last q3) (isEqualTo 1) + ) + + test ( + "to_list returns elements front first", + fun _ -> + let q = BQueue.empty () + let q1 = BQueue.enqueue 1 q + let q2 = BQueue.enqueue 2 q1 + let q3 = BQueue.enqueue 3 q2 + assertThat (BQueue.toList q3) (isEqualTo [ 1; 2; 3 ]) + ) + + test ( + "from_list builds queue from list", + fun _ -> + let q = BQueue.ofList [ 1; 2; 3 ] + assertThat (BQueue.length q) (isEqualTo 3) + assertThat (BQueue.head q) (isEqualTo 1) + assertThat (BQueue.last q) (isEqualTo 3) + ) + + test ( + "member returns true when element present", + fun _ -> + let q = BQueue.ofList [ 1; 2; 3 ] + assertThat (BQueue.contains 2 q) (isTrue) + ) + + test ( + "member returns false when element absent", + fun _ -> + let q = BQueue.ofList [ 1; 2; 3 ] + assertThat (BQueue.contains 99 q) (isFalse) + ) + + test ( + "reverse reverses order", + fun _ -> + let q = BQueue.ofList [ 1; 2; 3 ] + let r = BQueue.reverse q + assertThat (BQueue.toList r) (isEqualTo [ 3; 2; 1 ]) + ) + + test ( + "join appends two queues", + fun _ -> + let q1 = BQueue.ofList [ 1; 2 ] + let q2 = BQueue.ofList [ 3; 4 ] + let q3 = BQueue.join q1 q2 + assertThat (BQueue.toList q3) (isEqualTo [ 1; 2; 3; 4 ]) + ) + + test ( + "filter keeps matching elements", + fun _ -> + let q = BQueue.ofList [ 1; 2; 3; 4; 5 ] + let evens = BQueue.filter (fun x -> x % 2 = 0) q + assertThat (BQueue.toList evens) (isEqualTo [ 2; 4 ]) + ) + + test ( + "out removes front element", + fun _ -> + let q = BQueue.ofList [ 10; 20; 30 ] + let (item, q2) = BQueue.out q + assertThat item (isEqualTo (Some 10)) + assertThat (BQueue.length q2) (isEqualTo 2) + ) + + test ( + "out returns None for empty queue", + fun _ -> + let q = BQueue.empty () + let (item, _) = BQueue.out q + assertThat item (isEqualTo None) + ) + + test ( + "outRear removes rear element", + fun _ -> + let q = BQueue.ofList [ 10; 20; 30 ] + let (item, q2) = BQueue.outRear q + assertThat item (isEqualTo (Some 30)) + assertThat (BQueue.length q2) (isEqualTo 2) + ) + + test ( + "outRear returns None for empty queue", + fun _ -> + let q = BQueue.empty () + let (item, _) = BQueue.outRear q + assertThat item (isEqualTo None) + ) + + test ( + "peek returns front element without removing", + fun _ -> + let q = BQueue.ofList [ 10; 20 ] + assertThat (BQueue.peek q) (isEqualTo (Some 10)) + assertThat (BQueue.length q) (isEqualTo 2) + ) + + test ( + "peek returns None for empty queue", + fun _ -> + let q = BQueue.empty () + assertThat (BQueue.peek q) (isEqualTo None) + ) + + test ( + "peekRear returns rear element without removing", + fun _ -> + let q = BQueue.ofList [ 10; 20; 30 ] + assertThat (BQueue.peekRear q) (isEqualTo (Some 30)) + assertThat (BQueue.length q) (isEqualTo 3) + ) + + test ( + "split divides queue at position", + fun _ -> + let q = BQueue.ofList [ 1; 2; 3; 4; 5 ] + let (q1, q2) = BQueue.split 3 q + assertThat (BQueue.toList q1) (isEqualTo [ 1; 2; 3 ]) + assertThat (BQueue.toList q2) (isEqualTo [ 4; 5 ]) + ) + + test ( + "split at zero yields empty front", + fun _ -> + let q = BQueue.ofList [ 1; 2; 3 ] + let (q1, q2) = BQueue.split 0 q + assertThat (BQueue.isEmpty q1) (isTrue) + assertThat (BQueue.toList q2) (isEqualTo [ 1; 2; 3 ]) + ) + + test ( + "fifo ordering is preserved", + fun _ -> + // Enqueue 1, 2, 3 — dequeue should yield 1, 2, 3 + let q0 = BQueue.empty () + let q1 = BQueue.enqueue 1 q0 + let q2 = BQueue.enqueue 2 q1 + let q3 = BQueue.enqueue 3 q2 + let (a, q4) = BQueue.out q3 + let (b, q5) = BQueue.out q4 + let (c, _) = BQueue.out q5 + assertThat a (isEqualTo (Some 1)) + assertThat b (isEqualTo (Some 2)) + assertThat c (isEqualTo (Some 3)) + ) + ] ) diff --git a/test/TestRand.fs b/test/TestRand.fs index 51efe82..4d87e05 100644 --- a/test/TestRand.fs +++ b/test/TestRand.fs @@ -13,80 +13,82 @@ module BRand = Fable.Beam.Rand let tests = testList ( "Rand", - [ test ( - "uniform returns float in range", - fun _ -> - let v = BRand.uniform () - assertThat (v >= 0.0 && v < 1.0) (isTrue) - ) + [ + test ( + "uniform returns float in range", + fun _ -> + let v = BRand.uniform () + assertThat (v >= 0.0 && v < 1.0) (isTrue) + ) - test ( - "seed with typed algorithm DU", - fun _ -> - // Canary for StringEnum-style atom emission from F# DUs on BEAM. - // If DU case Exsss compiles to atom `exsss`, rand:seed/1 will accept it. - BRand.seed BRand.Exsss |> ignore - let v = BRand.uniform () - assertThat (v >= 0.0 && v < 1.0) (isTrue) - ) + test ( + "seed with typed algorithm DU", + fun _ -> + // Canary for StringEnum-style atom emission from F# DUs on BEAM. + // If DU case Exsss compiles to atom `exsss`, rand:seed/1 will accept it. + BRand.seed BRand.Exsss |> ignore + let v = BRand.uniform () + assertThat (v >= 0.0 && v < 1.0) (isTrue) + ) - test ( - "seed multi-word DU case maps to atom", - fun _ -> - // Second canary: does a multi-word case like Exro928ss produce atom exro928ss? - BRand.seed BRand.Exro928ss |> ignore - let v = BRand.uniform () - assertThat (v >= 0.0 && v < 1.0) (isTrue) - ) + test ( + "seed multi-word DU case maps to atom", + fun _ -> + // Second canary: does a multi-word case like Exro928ss produce atom exro928ss? + BRand.seed BRand.Exro928ss |> ignore + let v = BRand.uniform () + assertThat (v >= 0.0 && v < 1.0) (isTrue) + ) - test ( - "uniform n returns int in range", - fun _ -> - let v = BRand.uniformInt 100 - assertThat (v >= 1 && v <= 100) (isTrue) - ) + test ( + "uniform n returns int in range", + fun _ -> + let v = BRand.uniformInt 100 + assertThat (v >= 1 && v <= 100) (isTrue) + ) - test ("uniform 1 always returns 1", fun _ -> assertThat (BRand.uniformInt 1) (isEqualTo 1)) + test ("uniform 1 always returns 1", fun _ -> assertThat (BRand.uniformInt 1) (isEqualTo 1)) - test ( - "uniform_real returns positive float", - fun _ -> - let v = BRand.uniformReal () - assertThat (v > 0.0 && v < 1.0) (isTrue) - ) + test ( + "uniform_real returns positive float", + fun _ -> + let v = BRand.uniformReal () + assertThat (v > 0.0 && v < 1.0) (isTrue) + ) - test ( - "bytes returns binary of correct length", - fun _ -> - let randomBytes = BRand.bytes 16 - // The Erlang byte_size of the returned binary should be 16 - assertThat (randomBytes.Length > 0) (isTrue) - ) + test ( + "bytes returns binary of correct length", + fun _ -> + let randomBytes = BRand.bytes 16 + // The Erlang byte_size of the returned binary should be 16 + assertThat (randomBytes.Length > 0) (isTrue) + ) - test ( - "normal returns a float", - fun _ -> - let v = BRand.normal () - // Normal distribution — just check it's a finite float - assertThat (v = v) (isTrue) // NaN check: NaN <> NaN - ) + test ( + "normal returns a float", + fun _ -> + let v = BRand.normal () + // Normal distribution — just check it's a finite float + assertThat (v = v) (isTrue) // NaN check: NaN <> NaN + ) - test ( - "normal with mean and variance", - fun _ -> - // With large variance we get varied values; just check it's a float - let v = BRand.normalWith 0.0 1.0 - assertThat (v = v) (isTrue) - ) + test ( + "normal with mean and variance", + fun _ -> + // With large variance we get varied values; just check it's a float + let v = BRand.normalWith 0.0 1.0 + assertThat (v = v) (isTrue) + ) - test ( - "two uniform calls can differ", - fun _ -> - // With N=1000000, getting the same value twice in a row is astronomically unlikely - let v1 = BRand.uniformInt 1000000 - let v2 = BRand.uniformInt 1000000 - // At least verify both are in range — equality would be a fluke - assertThat (v1 >= 1 && v1 <= 1000000) (isTrue) - assertThat (v2 >= 1 && v2 <= 1000000) (isTrue) - ) ] + test ( + "two uniform calls can differ", + fun _ -> + // With N=1000000, getting the same value twice in a row is astronomically unlikely + let v1 = BRand.uniformInt 1000000 + let v2 = BRand.uniformInt 1000000 + // At least verify both are in range — equality would be a fluke + assertThat (v1 >= 1 && v1 <= 1000000) (isTrue) + assertThat (v2 >= 1 && v2 <= 1000000) (isTrue) + ) + ] ) diff --git a/test/TestRe.fs b/test/TestRe.fs index 38f6112..6afd1e9 100644 --- a/test/TestRe.fs +++ b/test/TestRe.fs @@ -13,241 +13,243 @@ module BLists = Fable.Beam.Lists let tests = testList ( "Re", - [ test ( - "isMatch returns true for matching pattern", - fun _ -> assertThat (isMatch "hello world" "hello") (isTrue) - ) - - test ( - "isMatch returns false for non-matching pattern", - fun _ -> assertThat (isMatch "hello world" "xyz") (isFalse) - ) - - test ("isMatch with digit pattern", fun _ -> assertThat (isMatch "abc123" "\\d+") (isTrue)) - - test ("isMatch anchored no match", fun _ -> assertThat (isMatch "hello" "^world") (isFalse)) - - test ( - "compile returns Ok for valid pattern", - fun _ -> - match compile "hello" with - | Ok _ -> assertThat true (isTrue) - | Error _ -> failwith "expected compile to succeed" - ) - - test ( - "compile returns Error for invalid pattern", - fun _ -> - match compile "[invalid" with - | Ok _ -> failwith "expected compile to fail" - | Error msg -> assertThat (msg.Length > 0) (isTrue) - ) - - test ( - "isMatchMP with compiled pattern", - fun _ -> - match compile "\\d+" with - | Ok mp -> assertThat (isMatchMP "abc123" mp) (isTrue) - | Error _ -> failwith "expected compile to succeed" - ) - - test ( - "isMatchMP with compiled pattern no match", - fun _ -> - match compile "\\d+" with - | Ok mp -> assertThat (isMatchMP "abcdef" mp) (isFalse) - | Error _ -> failwith "expected compile to succeed" - ) - - test ( - "run returns Some with whole match at index 0", - fun _ -> - match run "hello world" "hello" with - | Some captures -> assertThat captures.[0] (isEqualTo "hello") - | None -> failwith "expected a match" - ) - - test ( - "run returns Some with capture groups", - fun _ -> - match run "hello world" "h(e)(l+)o" with - | Some captures -> - assertThat captures.[0] (isEqualTo "hello") - assertThat captures.[1] (isEqualTo "e") - assertThat captures.[2] (isEqualTo "ll") - | None -> failwith "expected a match" - ) - - test ("run returns None for no match", fun _ -> assertThat (run "hello world" "xyz") (isEqualTo None)) - - test ( - "runMP returns captures for compiled pattern", - fun _ -> - match compile "(\\d+)" with - | Ok mp -> - match runMP "abc123def" mp with - | Some captures -> - assertThat captures.[0] (isEqualTo "123") - assertThat captures.[1] (isEqualTo "123") - | None -> failwith "expected a capture" - | Error _ -> failwith "expected compile to succeed" - ) - - test ( - "replaceFirst replaces only first occurrence", - fun _ -> assertThat (replaceFirst "aabbaa" "a+" "X") (isEqualTo "Xbbaa") - ) - - test ( - "replaceFirstWith caseless replaces first case-insensitively", - fun _ -> assertThat (replaceFirstWith "Aabbaa" "a+" "X" [ caseless ]) (isEqualTo "Xbbaa") - ) - - test ( - "replaceAll replaces all occurrences", - fun _ -> assertThat (replaceAll "aabbaa" "a+" "X") (isEqualTo "XbbX") - ) - - test ( - "replaceAll with digit pattern", - fun _ -> assertThat (replaceAll "abc123def456" "\\d+" "N") (isEqualTo "abcNdefN") - ) - - test ( - "split on comma", - fun _ -> - let parts = split "one,two,three" "," - assertThat parts.[0] (isEqualTo "one") - assertThat parts.[1] (isEqualTo "two") - assertThat parts.[2] (isEqualTo "three") - ) - - test ( - "split on whitespace pattern", - fun _ -> - let parts = split "a b c" "\\s+" - assertThat parts.[0] (isEqualTo "a") - assertThat parts.[1] (isEqualTo "b") - assertThat parts.[2] (isEqualTo "c") - ) - - test ( - "splitParts limits result count", - fun _ -> - let parts = splitParts "one,two,three,four" "," 2 - assertThat parts.[0] (isEqualTo "one") - assertThat parts.[1] (isEqualTo "two,three,four") - ) - - test ( - "isMatchWith caseless option matches different case", - fun _ -> - assertThat (isMatchWith "HELLO" "hello" [ caseless ]) (isTrue) - // Sanity check: default is case-sensitive - assertThat (isMatch "HELLO" "hello") (isFalse) - ) - - test ( - "isMatchWith multiline option matches after newline", - fun _ -> - // ^world only matches at line starts in multiline mode - assertThat (isMatchWith "hello\nworld" "^world" [ multiline ]) (isTrue) - assertThat (isMatch "hello\nworld" "^world") (isFalse) - ) - - test ( - "isMatchWith unicode option handles multi-byte characters", - fun _ -> - // "é" is 2 bytes in UTF-8. Without unicode, ^.$ expects exactly 1 byte — no match. - // With unicode, ^.$ expects exactly 1 codepoint — matches. - assertThat (isMatch "é" "^.$") (isFalse) - assertThat (isMatchWith "é" "^.$" [ unicode ]) (isTrue) - ) - - test ( - "runWith caseless returns original-case captures", - fun _ -> - match runWith "HELLO world" "hello" [ caseless ] with - | Some captures -> assertThat captures.[0] (isEqualTo "HELLO") - | None -> failwith "expected a match" - ) - - test ( - "compileWith caseless produces case-insensitive MP", - fun _ -> - match compileWith "hello" [ caseless ] with - | Ok mp -> - assertThat (isMatchMP "HELLO" mp) (isTrue) - assertThat (isMatchMP "hello" mp) (isTrue) - | Error _ -> failwith "expected compile to succeed" - ) - - test ( - "replaceAllWith caseless replaces all cases", - fun _ -> assertThat (replaceAllWith "Hello HELLO hello" "hello" "X" [ caseless ]) (isEqualTo "X X X") - ) - - test ( - "splitWith caseless splits on either case", - fun _ -> - let parts = splitWith "aXbxc" "x" [ caseless ] - assertThat parts.[0] (isEqualTo "a") - assertThat parts.[1] (isEqualTo "b") - assertThat parts.[2] (isEqualTo "c") - ) - - test ( - "replaceFirstMP with compiled pattern", - fun _ -> - match compile "a+" with - | Ok mp -> assertThat (replaceFirstMP "aabbaa" mp "X") (isEqualTo "Xbbaa") - | Error _ -> failwith "expected compile to succeed" - ) - - test ( - "replaceAllMP with compiled pattern", - fun _ -> - match compile "\\d+" with - | Ok mp -> assertThat (replaceAllMP "abc123def456" mp "N") (isEqualTo "abcNdefN") - | Error _ -> failwith "expected compile to succeed" - ) - - test ( - "splitMP with compiled pattern", - fun _ -> - match compile "," with - | Ok mp -> - let parts = splitMP "one,two,three" mp - assertThat parts.[0] (isEqualTo "one") - assertThat parts.[1] (isEqualTo "two") - assertThat parts.[2] (isEqualTo "three") - | Error _ -> failwith "expected compile to succeed" - ) - - test ( - "isMatch with empty subject", - fun _ -> - // Empty pattern matches empty subject (zero-width match at position 0) - assertThat (isMatch "" "") (isTrue) - assertThat (isMatch "" "a") (isFalse) - ) - - test ( - "run with empty subject and optional group returns Some empty", - fun _ -> - match run "" "a*" with - | Some captures -> assertThat captures.[0] (isEqualTo "") - | None -> failwith "expected a match" - ) - - test ( - "splitRaw returns the native list form of split", - fun _ -> - let parts: BLists.BeamList = splitRaw "a1b2c" "[0-9]" - - let expected: BLists.BeamList = - emitErlExpr () "[<<\"a\">>, <<\"b\">>, <<\"c\">>]" - - assertThat parts (isEqualTo expected) - ) ] + [ + test ( + "isMatch returns true for matching pattern", + fun _ -> assertThat (isMatch "hello world" "hello") (isTrue) + ) + + test ( + "isMatch returns false for non-matching pattern", + fun _ -> assertThat (isMatch "hello world" "xyz") (isFalse) + ) + + test ("isMatch with digit pattern", fun _ -> assertThat (isMatch "abc123" "\\d+") (isTrue)) + + test ("isMatch anchored no match", fun _ -> assertThat (isMatch "hello" "^world") (isFalse)) + + test ( + "compile returns Ok for valid pattern", + fun _ -> + match compile "hello" with + | Ok _ -> assertThat true (isTrue) + | Error _ -> failwith "expected compile to succeed" + ) + + test ( + "compile returns Error for invalid pattern", + fun _ -> + match compile "[invalid" with + | Ok _ -> failwith "expected compile to fail" + | Error msg -> assertThat (msg.Length > 0) (isTrue) + ) + + test ( + "isMatchMP with compiled pattern", + fun _ -> + match compile "\\d+" with + | Ok mp -> assertThat (isMatchMP "abc123" mp) (isTrue) + | Error _ -> failwith "expected compile to succeed" + ) + + test ( + "isMatchMP with compiled pattern no match", + fun _ -> + match compile "\\d+" with + | Ok mp -> assertThat (isMatchMP "abcdef" mp) (isFalse) + | Error _ -> failwith "expected compile to succeed" + ) + + test ( + "run returns Some with whole match at index 0", + fun _ -> + match run "hello world" "hello" with + | Some captures -> assertThat captures.[0] (isEqualTo "hello") + | None -> failwith "expected a match" + ) + + test ( + "run returns Some with capture groups", + fun _ -> + match run "hello world" "h(e)(l+)o" with + | Some captures -> + assertThat captures.[0] (isEqualTo "hello") + assertThat captures.[1] (isEqualTo "e") + assertThat captures.[2] (isEqualTo "ll") + | None -> failwith "expected a match" + ) + + test ("run returns None for no match", fun _ -> assertThat (run "hello world" "xyz") (isEqualTo None)) + + test ( + "runMP returns captures for compiled pattern", + fun _ -> + match compile "(\\d+)" with + | Ok mp -> + match runMP "abc123def" mp with + | Some captures -> + assertThat captures.[0] (isEqualTo "123") + assertThat captures.[1] (isEqualTo "123") + | None -> failwith "expected a capture" + | Error _ -> failwith "expected compile to succeed" + ) + + test ( + "replaceFirst replaces only first occurrence", + fun _ -> assertThat (replaceFirst "aabbaa" "a+" "X") (isEqualTo "Xbbaa") + ) + + test ( + "replaceFirstWith caseless replaces first case-insensitively", + fun _ -> assertThat (replaceFirstWith "Aabbaa" "a+" "X" [ caseless ]) (isEqualTo "Xbbaa") + ) + + test ( + "replaceAll replaces all occurrences", + fun _ -> assertThat (replaceAll "aabbaa" "a+" "X") (isEqualTo "XbbX") + ) + + test ( + "replaceAll with digit pattern", + fun _ -> assertThat (replaceAll "abc123def456" "\\d+" "N") (isEqualTo "abcNdefN") + ) + + test ( + "split on comma", + fun _ -> + let parts = split "one,two,three" "," + assertThat parts.[0] (isEqualTo "one") + assertThat parts.[1] (isEqualTo "two") + assertThat parts.[2] (isEqualTo "three") + ) + + test ( + "split on whitespace pattern", + fun _ -> + let parts = split "a b c" "\\s+" + assertThat parts.[0] (isEqualTo "a") + assertThat parts.[1] (isEqualTo "b") + assertThat parts.[2] (isEqualTo "c") + ) + + test ( + "splitParts limits result count", + fun _ -> + let parts = splitParts "one,two,three,four" "," 2 + assertThat parts.[0] (isEqualTo "one") + assertThat parts.[1] (isEqualTo "two,three,four") + ) + + test ( + "isMatchWith caseless option matches different case", + fun _ -> + assertThat (isMatchWith "HELLO" "hello" [ caseless ]) (isTrue) + // Sanity check: default is case-sensitive + assertThat (isMatch "HELLO" "hello") (isFalse) + ) + + test ( + "isMatchWith multiline option matches after newline", + fun _ -> + // ^world only matches at line starts in multiline mode + assertThat (isMatchWith "hello\nworld" "^world" [ multiline ]) (isTrue) + assertThat (isMatch "hello\nworld" "^world") (isFalse) + ) + + test ( + "isMatchWith unicode option handles multi-byte characters", + fun _ -> + // "é" is 2 bytes in UTF-8. Without unicode, ^.$ expects exactly 1 byte — no match. + // With unicode, ^.$ expects exactly 1 codepoint — matches. + assertThat (isMatch "é" "^.$") (isFalse) + assertThat (isMatchWith "é" "^.$" [ unicode ]) (isTrue) + ) + + test ( + "runWith caseless returns original-case captures", + fun _ -> + match runWith "HELLO world" "hello" [ caseless ] with + | Some captures -> assertThat captures.[0] (isEqualTo "HELLO") + | None -> failwith "expected a match" + ) + + test ( + "compileWith caseless produces case-insensitive MP", + fun _ -> + match compileWith "hello" [ caseless ] with + | Ok mp -> + assertThat (isMatchMP "HELLO" mp) (isTrue) + assertThat (isMatchMP "hello" mp) (isTrue) + | Error _ -> failwith "expected compile to succeed" + ) + + test ( + "replaceAllWith caseless replaces all cases", + fun _ -> assertThat (replaceAllWith "Hello HELLO hello" "hello" "X" [ caseless ]) (isEqualTo "X X X") + ) + + test ( + "splitWith caseless splits on either case", + fun _ -> + let parts = splitWith "aXbxc" "x" [ caseless ] + assertThat parts.[0] (isEqualTo "a") + assertThat parts.[1] (isEqualTo "b") + assertThat parts.[2] (isEqualTo "c") + ) + + test ( + "replaceFirstMP with compiled pattern", + fun _ -> + match compile "a+" with + | Ok mp -> assertThat (replaceFirstMP "aabbaa" mp "X") (isEqualTo "Xbbaa") + | Error _ -> failwith "expected compile to succeed" + ) + + test ( + "replaceAllMP with compiled pattern", + fun _ -> + match compile "\\d+" with + | Ok mp -> assertThat (replaceAllMP "abc123def456" mp "N") (isEqualTo "abcNdefN") + | Error _ -> failwith "expected compile to succeed" + ) + + test ( + "splitMP with compiled pattern", + fun _ -> + match compile "," with + | Ok mp -> + let parts = splitMP "one,two,three" mp + assertThat parts.[0] (isEqualTo "one") + assertThat parts.[1] (isEqualTo "two") + assertThat parts.[2] (isEqualTo "three") + | Error _ -> failwith "expected compile to succeed" + ) + + test ( + "isMatch with empty subject", + fun _ -> + // Empty pattern matches empty subject (zero-width match at position 0) + assertThat (isMatch "" "") (isTrue) + assertThat (isMatch "" "a") (isFalse) + ) + + test ( + "run with empty subject and optional group returns Some empty", + fun _ -> + match run "" "a*" with + | Some captures -> assertThat captures.[0] (isEqualTo "") + | None -> failwith "expected a match" + ) + + test ( + "splitRaw returns the native list form of split", + fun _ -> + let parts: BLists.BeamList = splitRaw "a1b2c" "[0-9]" + + let expected: BLists.BeamList = + emitErlExpr () "[<<\"a\">>, <<\"b\">>, <<\"c\">>]" + + assertThat parts (isEqualTo expected) + ) + ] ) diff --git a/test/TestString.fs b/test/TestString.fs index 5e126f3..94ea723 100644 --- a/test/TestString.fs +++ b/test/TestString.fs @@ -14,221 +14,229 @@ module BString = Fable.Beam.String let tests = testList ( "String", - [ test ("isEmpty returns true for empty", fun _ -> assertThat (BString.isEmpty "") (isTrue)) - - test ("isEmpty returns false for non-empty", fun _ -> assertThat (BString.isEmpty "hello") (isFalse)) - - test ("length returns grapheme count", fun _ -> assertThat (BString.length "hello") (isEqualTo 5)) - - test ("lowercase converts to lowercase", fun _ -> assertThat (BString.lowercase "HELLO") (isEqualTo "hello")) - - test ("uppercase converts to uppercase", fun _ -> assertThat (BString.uppercase "hello") (isEqualTo "HELLO")) - - test ( - "titlecase capitalises first grapheme", - fun _ -> assertThat (BString.titlecase "hello world") (isEqualTo "Hello world") - ) - - test ( - "casefold lowercases for comparison", - fun _ -> assertThat (BString.casefold "HELLO") (isEqualTo "hello") - ) - - test ("reverse reverses string", fun _ -> assertThat (BString.reverse "hello") (isEqualTo "olleh")) - - test ("trim strips whitespace", fun _ -> assertThat (BString.trim " hello ") (isEqualTo "hello")) - - test ( - "trimStart strips leading whitespace", - fun _ -> assertThat (BString.trimStart " hello ") (isEqualTo "hello ") - ) - - test ( - "trimEnd strips trailing whitespace", - fun _ -> assertThat (BString.trimEnd " hello ") (isEqualTo " hello") - ) - - test ("pad trailing to length", fun _ -> assertThat (BString.padEnd "hi" 5) (isEqualTo "hi ")) - - test ("padStart pads leading to length", fun _ -> assertThat (BString.padStart "hi" 5) (isEqualTo " hi")) - - test ( - "padStartWith pads with custom character", - fun _ -> assertThat (BString.padStartWith "7" 3 "0") (isEqualTo "007") - ) - - test ( - "padEndRaw returns unflattened chardata that flattens to padEnd", - fun _ -> - let raw = BString.padEndRaw "hi" 5 - // proves it is genuinely raw: string:pad yields an iolist ([<<"hi">>,32,32,32]), not a binary - assertThat (Erlang.isList raw) (isTrue) - assertThat (BeamChardata.toString raw) (isEqualTo "hi ") - assertThat (BeamChardata.toString raw) (isEqualTo (BString.padEnd "hi" 5)) - ) - - test ( - "padStartRaw returns unflattened chardata that flattens to padStart", - fun _ -> - let raw = BString.padStartRaw "hi" 5 - assertThat (Erlang.isList raw) (isTrue) - assertThat (BeamChardata.toString raw) (isEqualTo (BString.padStart "hi" 5)) - ) - - test ( - "padBoth and padBothRaw pad both sides", - fun _ -> - let raw = BString.padBothRaw "7" 5 - assertThat (BString.padBoth "7" 5) (isEqualTo " 7 ") - assertThat (Erlang.isList raw) (isTrue) - assertThat (BeamChardata.toString raw) (isEqualTo (BString.padBoth "7" 5)) - assertThat (BString.padBothWith "7" 5 "0") (isEqualTo "00700") - ) - - test ( - "reverseRaw flattens back to reverse", - fun _ -> - let raw = BString.reverseRaw "hello" - assertThat (Erlang.isList raw) (isTrue) - assertThat (BeamChardata.toString raw) (isEqualTo "olleh") - ) - - test ( - "replaceAllRaw flattens back to replaceAll", - fun _ -> - let raw = BString.replaceAllRaw "aXbXa" "X" "Y" - assertThat (BeamChardata.toString raw) (isEqualTo "aYbYa") - assertThat (BeamChardata.toString raw) (isEqualTo (BString.replaceAll "aXbXa" "X" "Y")) - ) - - test ( - "BeamChardata ofString roundtrips through toString", - fun _ -> - let result = "hi" |> BeamChardata.ofString |> BeamChardata.toString - assertThat result (isEqualTo "hi") - ) - - test ("slice from position", fun _ -> assertThat (BString.slice "hello world" 6) (isEqualTo "world")) - - test ("sliceLen with length", fun _ -> assertThat (BString.sliceLen "hello world" 0 5) (isEqualTo "hello")) - - test ( - "equal compares strings", - fun _ -> - assertThat (BString.equal "hello" "hello") (isTrue) - assertThat (BString.equal "hello" "world") (isFalse) - ) - - test ( - "equal case-insensitive", - fun _ -> - assertThat (BString.equalCaseInsensitive "Hello" "hello") (isTrue) - assertThat (BString.equalCaseInsensitive "Hello" "world") (isFalse) - ) - - test ( - "find returns Some on match", - fun _ -> assertThat (BString.find "hello world" "world") (isEqualTo (Some "world")) - ) - - test ( - "find returns None when not found", - fun _ -> assertThat (BString.find "hello world" "xyz") (isEqualTo None) - ) - - test ( - "findLast finds last occurrence", - fun _ -> assertThat (BString.findLast "a-b-c" "-") (isEqualTo (Some "-c")) - ) - - test ( - "prefix returns Some rest when prefix matches", - fun _ -> assertThat (BString.prefix "hello world" "hello ") (isEqualTo (Some "world")) - ) - - test ( - "prefix returns None when no match", - fun _ -> assertThat (BString.prefix "hello world" "xyz") (isEqualTo None) - ) - - test ( - "splitFirst splits at first occurrence", - fun _ -> - let parts = BString.splitFirst "hello world" " " - assertThat (Array.length parts) (isEqualTo 2) - assertThat (parts.[0]) (isEqualTo "hello") - assertThat (parts.[1]) (isEqualTo "world") - ) - - test ( - "splitAll splits at all occurrences", - fun _ -> - let parts = BString.splitAll "a,b,c" "," - assertThat (Array.length parts) (isEqualTo 3) - assertThat (parts.[0]) (isEqualTo "a") - assertThat (parts.[1]) (isEqualTo "b") - assertThat (parts.[2]) (isEqualTo "c") - ) - - test ( - "replaceFirst replaces first occurrence", - fun _ -> assertThat (BString.replaceFirst "aabbaa" "aa" "XX") (isEqualTo "XXbbaa") - ) - - test ( - "replaceAll replaces all occurrences", - fun _ -> assertThat (BString.replaceAll "aabbaa" "aa" "XX") (isEqualTo "XXbbXX") - ) - - test ( - "toInteger parses valid integer", - fun _ -> - match BString.toInteger "42abc" with - | Ok(n, rest) -> - assertThat n (isEqualTo 42) - assertThat rest (isEqualTo "abc") - | Error _ -> assertThat false (isTrue) - ) - - test ( - "toInteger returns error for non-integer", - fun _ -> - match BString.toInteger "abc" with - | Error _ -> assertThat true (isTrue) - | Ok _ -> assertThat false (isTrue) - ) - - test ( - "toFloat parses valid float", - fun _ -> - match BString.toFloat "3.14rest" with - | Ok(f, _) -> assertThat ((f > 3.13 && f < 3.15)) (isTrue) - | Error _ -> assertThat false (isTrue) - ) - - test ( - "toGraphemes splits into grapheme clusters", - fun _ -> - let graphemes = BString.toGraphemes "abc" - assertThat (Array.length graphemes) (isEqualTo 3) - assertThat (graphemes.[0]) (isEqualTo "a") - assertThat (graphemes.[1]) (isEqualTo "b") - assertThat (graphemes.[2]) (isEqualTo "c") - ) - - test ( - "splitAllRaw returns the native list form of splitAll", - fun _ -> - let parts: BeamList = BString.splitAllRaw "a,b,c" "," - let expected: BeamList = emitErlExpr () "[<<\"a\">>, <<\"b\">>, <<\"c\">>]" - assertThat parts (isEqualTo expected) - ) - - test ( - "splitFirstRaw returns the native list form of splitFirst", - fun _ -> - let parts: BeamList = BString.splitFirstRaw "hello world" " " - let expected: BeamList = emitErlExpr () "[<<\"hello\">>, <<\"world\">>]" - assertThat parts (isEqualTo expected) - ) ] + [ + test ("isEmpty returns true for empty", fun _ -> assertThat (BString.isEmpty "") (isTrue)) + + test ("isEmpty returns false for non-empty", fun _ -> assertThat (BString.isEmpty "hello") (isFalse)) + + test ("length returns grapheme count", fun _ -> assertThat (BString.length "hello") (isEqualTo 5)) + + test ( + "lowercase converts to lowercase", + fun _ -> assertThat (BString.lowercase "HELLO") (isEqualTo "hello") + ) + + test ( + "uppercase converts to uppercase", + fun _ -> assertThat (BString.uppercase "hello") (isEqualTo "HELLO") + ) + + test ( + "titlecase capitalises first grapheme", + fun _ -> assertThat (BString.titlecase "hello world") (isEqualTo "Hello world") + ) + + test ( + "casefold lowercases for comparison", + fun _ -> assertThat (BString.casefold "HELLO") (isEqualTo "hello") + ) + + test ("reverse reverses string", fun _ -> assertThat (BString.reverse "hello") (isEqualTo "olleh")) + + test ("trim strips whitespace", fun _ -> assertThat (BString.trim " hello ") (isEqualTo "hello")) + + test ( + "trimStart strips leading whitespace", + fun _ -> assertThat (BString.trimStart " hello ") (isEqualTo "hello ") + ) + + test ( + "trimEnd strips trailing whitespace", + fun _ -> assertThat (BString.trimEnd " hello ") (isEqualTo " hello") + ) + + test ("pad trailing to length", fun _ -> assertThat (BString.padEnd "hi" 5) (isEqualTo "hi ")) + + test ("padStart pads leading to length", fun _ -> assertThat (BString.padStart "hi" 5) (isEqualTo " hi")) + + test ( + "padStartWith pads with custom character", + fun _ -> assertThat (BString.padStartWith "7" 3 "0") (isEqualTo "007") + ) + + test ( + "padEndRaw returns unflattened chardata that flattens to padEnd", + fun _ -> + let raw = BString.padEndRaw "hi" 5 + // proves it is genuinely raw: string:pad yields an iolist ([<<"hi">>,32,32,32]), not a binary + assertThat (Erlang.isList raw) (isTrue) + assertThat (BeamChardata.toString raw) (isEqualTo "hi ") + assertThat (BeamChardata.toString raw) (isEqualTo (BString.padEnd "hi" 5)) + ) + + test ( + "padStartRaw returns unflattened chardata that flattens to padStart", + fun _ -> + let raw = BString.padStartRaw "hi" 5 + assertThat (Erlang.isList raw) (isTrue) + assertThat (BeamChardata.toString raw) (isEqualTo (BString.padStart "hi" 5)) + ) + + test ( + "padBoth and padBothRaw pad both sides", + fun _ -> + let raw = BString.padBothRaw "7" 5 + assertThat (BString.padBoth "7" 5) (isEqualTo " 7 ") + assertThat (Erlang.isList raw) (isTrue) + assertThat (BeamChardata.toString raw) (isEqualTo (BString.padBoth "7" 5)) + assertThat (BString.padBothWith "7" 5 "0") (isEqualTo "00700") + ) + + test ( + "reverseRaw flattens back to reverse", + fun _ -> + let raw = BString.reverseRaw "hello" + assertThat (Erlang.isList raw) (isTrue) + assertThat (BeamChardata.toString raw) (isEqualTo "olleh") + ) + + test ( + "replaceAllRaw flattens back to replaceAll", + fun _ -> + let raw = BString.replaceAllRaw "aXbXa" "X" "Y" + assertThat (BeamChardata.toString raw) (isEqualTo "aYbYa") + assertThat (BeamChardata.toString raw) (isEqualTo (BString.replaceAll "aXbXa" "X" "Y")) + ) + + test ( + "BeamChardata ofString roundtrips through toString", + fun _ -> + let result = "hi" |> BeamChardata.ofString |> BeamChardata.toString + assertThat result (isEqualTo "hi") + ) + + test ("slice from position", fun _ -> assertThat (BString.slice "hello world" 6) (isEqualTo "world")) + + test ("sliceLen with length", fun _ -> assertThat (BString.sliceLen "hello world" 0 5) (isEqualTo "hello")) + + test ( + "equal compares strings", + fun _ -> + assertThat (BString.equal "hello" "hello") (isTrue) + assertThat (BString.equal "hello" "world") (isFalse) + ) + + test ( + "equal case-insensitive", + fun _ -> + assertThat (BString.equalCaseInsensitive "Hello" "hello") (isTrue) + assertThat (BString.equalCaseInsensitive "Hello" "world") (isFalse) + ) + + test ( + "find returns Some on match", + fun _ -> assertThat (BString.find "hello world" "world") (isEqualTo (Some "world")) + ) + + test ( + "find returns None when not found", + fun _ -> assertThat (BString.find "hello world" "xyz") (isEqualTo None) + ) + + test ( + "findLast finds last occurrence", + fun _ -> assertThat (BString.findLast "a-b-c" "-") (isEqualTo (Some "-c")) + ) + + test ( + "prefix returns Some rest when prefix matches", + fun _ -> assertThat (BString.prefix "hello world" "hello ") (isEqualTo (Some "world")) + ) + + test ( + "prefix returns None when no match", + fun _ -> assertThat (BString.prefix "hello world" "xyz") (isEqualTo None) + ) + + test ( + "splitFirst splits at first occurrence", + fun _ -> + let parts = BString.splitFirst "hello world" " " + assertThat (Array.length parts) (isEqualTo 2) + assertThat (parts.[0]) (isEqualTo "hello") + assertThat (parts.[1]) (isEqualTo "world") + ) + + test ( + "splitAll splits at all occurrences", + fun _ -> + let parts = BString.splitAll "a,b,c" "," + assertThat (Array.length parts) (isEqualTo 3) + assertThat (parts.[0]) (isEqualTo "a") + assertThat (parts.[1]) (isEqualTo "b") + assertThat (parts.[2]) (isEqualTo "c") + ) + + test ( + "replaceFirst replaces first occurrence", + fun _ -> assertThat (BString.replaceFirst "aabbaa" "aa" "XX") (isEqualTo "XXbbaa") + ) + + test ( + "replaceAll replaces all occurrences", + fun _ -> assertThat (BString.replaceAll "aabbaa" "aa" "XX") (isEqualTo "XXbbXX") + ) + + test ( + "toInteger parses valid integer", + fun _ -> + match BString.toInteger "42abc" with + | Ok(n, rest) -> + assertThat n (isEqualTo 42) + assertThat rest (isEqualTo "abc") + | Error _ -> assertThat false (isTrue) + ) + + test ( + "toInteger returns error for non-integer", + fun _ -> + match BString.toInteger "abc" with + | Error _ -> assertThat true (isTrue) + | Ok _ -> assertThat false (isTrue) + ) + + test ( + "toFloat parses valid float", + fun _ -> + match BString.toFloat "3.14rest" with + | Ok(f, _) -> assertThat ((f > 3.13 && f < 3.15)) (isTrue) + | Error _ -> assertThat false (isTrue) + ) + + test ( + "toGraphemes splits into grapheme clusters", + fun _ -> + let graphemes = BString.toGraphemes "abc" + assertThat (Array.length graphemes) (isEqualTo 3) + assertThat (graphemes.[0]) (isEqualTo "a") + assertThat (graphemes.[1]) (isEqualTo "b") + assertThat (graphemes.[2]) (isEqualTo "c") + ) + + test ( + "splitAllRaw returns the native list form of splitAll", + fun _ -> + let parts: BeamList = BString.splitAllRaw "a,b,c" "," + let expected: BeamList = emitErlExpr () "[<<\"a\">>, <<\"b\">>, <<\"c\">>]" + assertThat parts (isEqualTo expected) + ) + + test ( + "splitFirstRaw returns the native list form of splitFirst", + fun _ -> + let parts: BeamList = BString.splitFirstRaw "hello world" " " + let expected: BeamList = emitErlExpr () "[<<\"hello\">>, <<\"world\">>]" + assertThat parts (isEqualTo expected) + ) + ] ) diff --git a/test/TestSupervisor.fs b/test/TestSupervisor.fs index f95b3e9..89985c6 100644 --- a/test/TestSupervisor.fs +++ b/test/TestSupervisor.fs @@ -20,58 +20,60 @@ let private startSup () : BSupervisor.SupRef = let tests = testList ( "Supervisor", - [ test ( - "supervisor.which_children on non-existent catches error", - fun _ -> - try - BSupervisor.children (BSupervisor.fromName (Erlang.binaryToAtom "nonexistent_sup_xyz")) - |> ignore - with _ -> - () - ) + [ + test ( + "supervisor.which_children on non-existent catches error", + fun _ -> + try + BSupervisor.children (BSupervisor.fromName (Erlang.binaryToAtom "nonexistent_sup_xyz")) + |> ignore + with _ -> + () + ) - test ( - "supervisor.terminate_child succeeds for a running child", - fun _ -> - let sup = startSup () + test ( + "supervisor.terminate_child succeeds for a running child", + fun _ -> + let sup = startSup () - // Bare `ok` from OTP must surface as Ok () on the F# side. - match BSupervisor.terminateChild sup (Erlang.binaryToAtom "counter") with - | Ok() -> assertThat true (isTrue) - | Error _ -> failwith "terminate_child should succeed for a known child" - ) + // Bare `ok` from OTP must surface as Ok () on the F# side. + match BSupervisor.terminateChild sup (Erlang.binaryToAtom "counter") with + | Ok() -> assertThat true (isTrue) + | Error _ -> failwith "terminate_child should succeed for a known child" + ) - test ( - "supervisor.terminate_child returns Error not_found for unknown id", - fun _ -> - let sup = startSup () + test ( + "supervisor.terminate_child returns Error not_found for unknown id", + fun _ -> + let sup = startSup () - match BSupervisor.terminateChild sup (Erlang.binaryToAtom "nope") with - | Ok() -> failwith "terminate_child should fail for an unknown child" - | Error reason -> assertThat reason (isEqualTo (Erlang.binaryToAtom "not_found")) - ) + match BSupervisor.terminateChild sup (Erlang.binaryToAtom "nope") with + | Ok() -> failwith "terminate_child should fail for an unknown child" + | Error reason -> assertThat reason (isEqualTo (Erlang.binaryToAtom "not_found")) + ) - test ( - "supervisor.delete_child succeeds after terminate", - fun _ -> - let sup = startSup () - let counter = Erlang.binaryToAtom "counter" + test ( + "supervisor.delete_child succeeds after terminate", + fun _ -> + let sup = startSup () + let counter = Erlang.binaryToAtom "counter" - // A child spec can only be deleted once the child is terminated. - BSupervisor.terminateChild sup counter |> ignore + // A child spec can only be deleted once the child is terminated. + BSupervisor.terminateChild sup counter |> ignore - match BSupervisor.deleteChild sup counter with - | Ok() -> assertThat true (isTrue) - | Error _ -> failwith "delete_child should succeed for a terminated child" - ) + match BSupervisor.deleteChild sup counter with + | Ok() -> assertThat true (isTrue) + | Error _ -> failwith "delete_child should succeed for a terminated child" + ) - test ( - "supervisor.delete_child returns Error not_found for unknown id", - fun _ -> - let sup = startSup () + test ( + "supervisor.delete_child returns Error not_found for unknown id", + fun _ -> + let sup = startSup () - match BSupervisor.deleteChild sup (Erlang.binaryToAtom "nope") with - | Ok() -> failwith "delete_child should fail for an unknown child" - | Error reason -> assertThat reason (isEqualTo (Erlang.binaryToAtom "not_found")) - ) ] + match BSupervisor.deleteChild sup (Erlang.binaryToAtom "nope") with + | Ok() -> failwith "delete_child should fail for an unknown child" + | Error reason -> assertThat reason (isEqualTo (Erlang.binaryToAtom "not_found")) + ) + ] ) diff --git a/test/TestTimer.fs b/test/TestTimer.fs index 23a23b0..7114f5e 100644 --- a/test/TestTimer.fs +++ b/test/TestTimer.fs @@ -9,11 +9,13 @@ module BTimer = Fable.Beam.Timer let tests = testList ( "Timer", - [ test ("hours converts correctly", fun _ -> assertThat (BTimer.hours 1) (isEqualTo 3600000)) + [ + test ("hours converts correctly", fun _ -> assertThat (BTimer.hours 1) (isEqualTo 3600000)) - test ("minutes converts correctly", fun _ -> assertThat (BTimer.minutes 1) (isEqualTo 60000)) + test ("minutes converts correctly", fun _ -> assertThat (BTimer.minutes 1) (isEqualTo 60000)) - test ("seconds converts correctly", fun _ -> assertThat (BTimer.seconds 1) (isEqualTo 1000)) + test ("seconds converts correctly", fun _ -> assertThat (BTimer.seconds 1) (isEqualTo 1000)) - test ("sleep does not crash", fun _ -> BTimer.sleep 10) ] + test ("sleep does not crash", fun _ -> BTimer.sleep 10) + ] ) diff --git a/test/TestUriString.fs b/test/TestUriString.fs index 3b30683..126e1c0 100644 --- a/test/TestUriString.fs +++ b/test/TestUriString.fs @@ -11,151 +11,156 @@ open Fable.Beam.UriString let tests = testList ( "UriString", - [ test ( - "parse full uri", - fun _ -> - match parse "https://user:pass@example.com:8080/path?q=hello#frag" with - | Ok uri -> - assertThat (scheme uri) (isEqualTo (Some "https")) - assertThat (userinfo uri) (isEqualTo (Some "user:pass")) - assertThat (host uri) (isEqualTo (Some "example.com")) - assertThat (port uri) (isEqualTo (Some 8080)) - assertThat (path uri) (isEqualTo (Some "/path")) - assertThat (query uri) (isEqualTo (Some "q=hello")) - assertThat (fragment uri) (isEqualTo (Some "frag")) - | Error _ -> failwith "expected a parsed uri" - ) - - test ( - "parse minimal uri", - fun _ -> - match parse "https://example.com" with - | Ok uri -> - assertThat (scheme uri) (isEqualTo (Some "https")) - assertThat (host uri) (isEqualTo (Some "example.com")) - assertThat (port uri) (isEqualTo None) - assertThat (query uri) (isEqualTo None) - assertThat (fragment uri) (isEqualTo None) - | Error _ -> failwith "expected a parsed uri" - ) - - test ( - "parse relative uri has no scheme or host", - fun _ -> - match parse "/relative/path" with - | Ok uri -> - assertThat (scheme uri) (isEqualTo None) - assertThat (host uri) (isEqualTo None) - assertThat (path uri) (isEqualTo (Some "/relative/path")) - | Error _ -> failwith "expected a parsed uri" - ) - - test ( - "parse path only uri", - fun _ -> - match parse "just/a/path" with - | Ok uri -> - assertThat (scheme uri) (isEqualTo None) - assertThat (host uri) (isEqualTo None) - assertThat (path uri) (isEqualTo (Some "just/a/path")) - | Error _ -> failwith "expected a parsed uri" - ) - - test ( - "normalize lowercases scheme and host", - fun _ -> assertThat (normalize "HTTP://EXAMPLE.COM/path") (isEqualTo (Ok "http://example.com/path")) - ) - - test ( - "normalize removes default http port", - fun _ -> assertThat (normalize "http://example.com:80/path") (isEqualTo (Ok "http://example.com/path")) - ) - - test ( - "normalize removes default https port", - fun _ -> assertThat (normalize "https://example.com:443/path") (isEqualTo (Ok "https://example.com/path")) - ) - - test ( - "normalize resolves dot segments", - fun _ -> assertThat (normalize "http://example.com/a/b/../c") (isEqualTo (Ok "http://example.com/a/c")) - ) - - test ( - "resolve absolute path reference", - fun _ -> - assertThat (resolve "/new" "https://example.com/old/page") (isEqualTo (Ok "https://example.com/new")) - ) - - test ( - "resolve relative path reference", - fun _ -> - assertThat - (resolve "new" "https://example.com/old/page") - (isEqualTo (Ok "https://example.com/old/new")) - ) - - test ( - "resolve full uri preserves reference", - fun _ -> - assertThat - (resolve "https://other.com/path" "https://example.com/base") - (isEqualTo (Ok "https://other.com/path")) - ) - - test ( - "dissect query parses key value pairs", - fun _ -> assertThat (dissectQuery "q=hello&lang=en") (isEqualTo [ ("q", "hello"); ("lang", "en") ]) - ) - - test ("dissect query empty string", fun _ -> assertThat (dissectQuery "") (isEqualTo [])) - - test ( - "compose query builds query string", - fun _ -> assertThat (composeQuery [ ("q", "search"); ("page", "1") ]) (isEqualTo "q=search&page=1") - ) - - test ("compose query empty list", fun _ -> assertThat (composeQuery []) (isEqualTo "")) - - test ( - "dissect and compose query roundtrip", - fun _ -> - let original = "name=Alice&role=admin" - assertThat (original |> dissectQuery |> composeQuery) (isEqualTo original) - ) - - test ( - "percent decode decodes encoded chars", - fun _ -> assertThat (percentDecode "hello%20world") (isEqualTo (Ok "hello world")) - ) - - test ( - "percent decode passthrough for plain string", - fun _ -> assertThat (percentDecode "hello") (isEqualTo (Ok "hello")) - ) - - test ( - "percent decode returns error for malformed encoding", - fun _ -> - match percentDecode "invalid%GG" with - | Error _ -> assertThat true (isTrue) - | Ok _ -> failwith "expected a malformed-encoding error" - ) - - test ( - "quote encodes spaces and slashes", - fun _ -> assertThat (quote "hello world") (isEqualTo "hello%20world") - ) - - test ( - "quote with safe chars preserves slash", - fun _ -> assertThat (quoteWith "hello/world" "/") (isEqualTo "hello/world") - ) - - test ( - "unquote decodes percent encoded string", - fun _ -> assertThat (unquote "hello%20world") (isEqualTo "hello world") - ) - - test ("unquote passthrough for plain string", fun _ -> assertThat (unquote "hello") (isEqualTo "hello")) ] + [ + test ( + "parse full uri", + fun _ -> + match parse "https://user:pass@example.com:8080/path?q=hello#frag" with + | Ok uri -> + assertThat (scheme uri) (isEqualTo (Some "https")) + assertThat (userinfo uri) (isEqualTo (Some "user:pass")) + assertThat (host uri) (isEqualTo (Some "example.com")) + assertThat (port uri) (isEqualTo (Some 8080)) + assertThat (path uri) (isEqualTo (Some "/path")) + assertThat (query uri) (isEqualTo (Some "q=hello")) + assertThat (fragment uri) (isEqualTo (Some "frag")) + | Error _ -> failwith "expected a parsed uri" + ) + + test ( + "parse minimal uri", + fun _ -> + match parse "https://example.com" with + | Ok uri -> + assertThat (scheme uri) (isEqualTo (Some "https")) + assertThat (host uri) (isEqualTo (Some "example.com")) + assertThat (port uri) (isEqualTo None) + assertThat (query uri) (isEqualTo None) + assertThat (fragment uri) (isEqualTo None) + | Error _ -> failwith "expected a parsed uri" + ) + + test ( + "parse relative uri has no scheme or host", + fun _ -> + match parse "/relative/path" with + | Ok uri -> + assertThat (scheme uri) (isEqualTo None) + assertThat (host uri) (isEqualTo None) + assertThat (path uri) (isEqualTo (Some "/relative/path")) + | Error _ -> failwith "expected a parsed uri" + ) + + test ( + "parse path only uri", + fun _ -> + match parse "just/a/path" with + | Ok uri -> + assertThat (scheme uri) (isEqualTo None) + assertThat (host uri) (isEqualTo None) + assertThat (path uri) (isEqualTo (Some "just/a/path")) + | Error _ -> failwith "expected a parsed uri" + ) + + test ( + "normalize lowercases scheme and host", + fun _ -> assertThat (normalize "HTTP://EXAMPLE.COM/path") (isEqualTo (Ok "http://example.com/path")) + ) + + test ( + "normalize removes default http port", + fun _ -> assertThat (normalize "http://example.com:80/path") (isEqualTo (Ok "http://example.com/path")) + ) + + test ( + "normalize removes default https port", + fun _ -> + assertThat (normalize "https://example.com:443/path") (isEqualTo (Ok "https://example.com/path")) + ) + + test ( + "normalize resolves dot segments", + fun _ -> assertThat (normalize "http://example.com/a/b/../c") (isEqualTo (Ok "http://example.com/a/c")) + ) + + test ( + "resolve absolute path reference", + fun _ -> + assertThat + (resolve "/new" "https://example.com/old/page") + (isEqualTo (Ok "https://example.com/new")) + ) + + test ( + "resolve relative path reference", + fun _ -> + assertThat + (resolve "new" "https://example.com/old/page") + (isEqualTo (Ok "https://example.com/old/new")) + ) + + test ( + "resolve full uri preserves reference", + fun _ -> + assertThat + (resolve "https://other.com/path" "https://example.com/base") + (isEqualTo (Ok "https://other.com/path")) + ) + + test ( + "dissect query parses key value pairs", + fun _ -> assertThat (dissectQuery "q=hello&lang=en") (isEqualTo [ ("q", "hello"); ("lang", "en") ]) + ) + + test ("dissect query empty string", fun _ -> assertThat (dissectQuery "") (isEqualTo [])) + + test ( + "compose query builds query string", + fun _ -> assertThat (composeQuery [ ("q", "search"); ("page", "1") ]) (isEqualTo "q=search&page=1") + ) + + test ("compose query empty list", fun _ -> assertThat (composeQuery []) (isEqualTo "")) + + test ( + "dissect and compose query roundtrip", + fun _ -> + let original = "name=Alice&role=admin" + assertThat (original |> dissectQuery |> composeQuery) (isEqualTo original) + ) + + test ( + "percent decode decodes encoded chars", + fun _ -> assertThat (percentDecode "hello%20world") (isEqualTo (Ok "hello world")) + ) + + test ( + "percent decode passthrough for plain string", + fun _ -> assertThat (percentDecode "hello") (isEqualTo (Ok "hello")) + ) + + test ( + "percent decode returns error for malformed encoding", + fun _ -> + match percentDecode "invalid%GG" with + | Error _ -> assertThat true (isTrue) + | Ok _ -> failwith "expected a malformed-encoding error" + ) + + test ( + "quote encodes spaces and slashes", + fun _ -> assertThat (quote "hello world") (isEqualTo "hello%20world") + ) + + test ( + "quote with safe chars preserves slash", + fun _ -> assertThat (quoteWith "hello/world" "/") (isEqualTo "hello/world") + ) + + test ( + "unquote decodes percent encoded string", + fun _ -> assertThat (unquote "hello%20world") (isEqualTo "hello world") + ) + + test ("unquote passthrough for plain string", fun _ -> assertThat (unquote "hello") (isEqualTo "hello")) + ] )