diff --git a/.github/workflows/codeql.yml b/.github/workflows/codeql.yml index 5a603c48..0bbaa526 100644 --- a/.github/workflows/codeql.yml +++ b/.github/workflows/codeql.yml @@ -27,15 +27,16 @@ jobs: uses: actions/checkout@v3 - name: Initialize CodeQL - uses: github/codeql-action/init@v2 + uses: github/codeql-action/init@v3 with: languages: ${{ matrix.language }} queries: +security-and-quality + tools: linked - name: Autobuild - uses: github/codeql-action/autobuild@v2 + uses: github/codeql-action/autobuild@v3 - name: Perform CodeQL Analysis - uses: github/codeql-action/analyze@v2 + uses: github/codeql-action/analyze@v3 with: category: "/language:${{ matrix.language }}" diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index e832e7fc..4a385ab3 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -38,6 +38,9 @@ jobs: - name: Test the project shell: cmd run: build_win test + - name: Test installer build + shell: cmd + run: build_win dist test-windows-min: name: Build and test on Windows Minimal build diff --git a/CHANGELOG.md b/CHANGELOG.md index 308f32f7..11eebf84 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,22 @@ All notable changes to this project will be documented in this file. ## ??? - Unreleased +- Improve `?` peg special termination behavior +- Add IEEE hex floats to grammar. +- Add buffer peg literal support +- Improve `split` peg special edge case behavior +- Add Arm64 .msi support +- Add `no-reuse` argument to `net/listen` to disable reusing server sockets +- Add `struct/rawget` +- Fix `deep=` and `deep-not=` to better handle degenerate cases with mutable table keys +- Long strings will now dedent on `\r\n` instead of just `\n`. +- Add `ev/to-file` for synchronous resource operations +- Improve `file/open` error message by including path + +## 1.37.1 - 2024-12-05 +- Fix meson cross compilation +- Update timeout documentation for networking APIs: timeouts raise errors and do not return nil. +- Add `janet_addtimeout_nil(double sec);` to the C API. - Change string hashing. - Fix string equality bug. - Add `assertf` diff --git a/README.md b/README.md index 7376b433..5a37618d 100644 --- a/README.md +++ b/README.md @@ -207,7 +207,7 @@ Alternatively, install the package directly with `pkgin install janet`. To build an `.msi` installer executable, in addition to the above steps, you will have to: -5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases). +5. Install, or otherwise add to your PATH the [WiX 3.14 Toolset](https://github.com/wixtoolset/wix3/releases). 6. Run `build_win dist`. Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself. diff --git a/build_win.bat b/build_win.bat index 5e40d14b..31cbd403 100644 --- a/build_win.bat +++ b/build_win.bat @@ -91,7 +91,7 @@ exit /b 0 @rem Clean build artifacts :CLEAN -del *.exe *.lib *.exp +del *.exe *.lib *.exp *.msi *.wixpdb rd /s /q build if exist dist ( rd /s /q dist @@ -138,11 +138,18 @@ if defined APPVEYOR_REPO_TAG_NAME ( set RELEASE_VERSION=%JANET_VERSION% ) if defined CI ( - set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\" + set WIXBIN="%WIX%bin\" + echo WIXBIN = %WIXBIN% ) else ( set WIXBIN= ) -%WIXBIN%candle.exe tools\msi\janet.wxs -arch %BUILDARCH% -out build\ + +set WIXARCH=%BUILDARCH% +if "%WIXARCH%"=="aarch64" ( + set WIXARCH=arm64 +) + +%WIXBIN%candle.exe tools\msi\janet.wxs -arch %WIXARCH% -out build\ %WIXBIN%light.exe "-sice:ICE38" -b tools\msi -ext WixUIExtension build\janet.wixobj -out janet-%RELEASE_VERSION%-windows-%BUILDARCH%-installer.msi exit /b 0 diff --git a/meson.build b/meson.build index feea7f6b..137d7809 100644 --- a/meson.build +++ b/meson.build @@ -20,14 +20,23 @@ project('janet', 'c', default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], - version : '1.37.0') + version : '1.37.1') # Global settings janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet') -# Link math library on all systems +# Compilers cc = meson.get_compiler('c') +native_cc = meson.get_compiler('c', native : true) + +# Native deps +native_m_dep = native_cc.find_library('m', required : false) +native_dl_dep = native_cc.find_library('dl', required : false) +native_android_spawn_dep = native_cc.find_library('android-spawn', required : false) +native_thread_dep = dependency('threads', native : true) + +# Deps m_dep = cc.find_library('m', required : false) dl_dep = cc.find_library('dl', required : false) android_spawn_dep = cc.find_library('android-spawn', required : false) @@ -167,11 +176,18 @@ mainclient_src = [ 'src/mainclient/shell.c' ] +janet_dependencies = [m_dep, dl_dep, android_spawn_dep] +janet_native_dependencies = [native_m_dep, native_dl_dep, native_android_spawn_dep] +if not get_option('single_threaded') + janet_dependencies += thread_dep + janet_native_dependencies += native_thread_dep +endif + # Build boot binary janet_boot = executable('janet-boot', core_src, boot_src, include_directories : incdir, c_args : '-DJANET_BOOTSTRAP', - dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep], + dependencies : janet_native_dependencies, native : true) # Build janet.c @@ -184,11 +200,6 @@ janetc = custom_target('janetc', 'JANET_PATH', janet_path ]) -janet_dependencies = [m_dep, dl_dep, android_spawn_dep] -if not get_option('single_threaded') - janet_dependencies += thread_dep -endif - # Allow building with no shared library if cc.has_argument('-fvisibility=hidden') lib_cflags = ['-fvisibility=hidden'] @@ -234,7 +245,7 @@ if meson.is_cross_build() endif janet_nativeclient = executable('janet-native', janetc, mainclient_src, include_directories : incdir, - dependencies : janet_dependencies, + dependencies : janet_native_dependencies, c_args : extra_native_cflags, native : true) else diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 0dced169..75f8bf2f 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -996,7 +996,7 @@ (defn reduce2 ``The 2-argument version of `reduce` that does not take an initialization value. - Instead, the first element of the array is used for initialization.`` + Instead, the first element of the array is used for initialization. If `ind` is empty, will evaluate to nil.`` [f ind] (var k (next ind)) (if (= nil k) (break nil)) @@ -1311,7 +1311,7 @@ (defdyn *redef* "When set, allow dynamically rebinding top level defs. Will slow generated code and is intended to be used for development.") (defdyn *debug* "Enables a built in debugger on errors and other useful features for debugging in a repl.") (defdyn *exit* "When set, will cause the current context to complete. Can be set to exit from repl (or file), for example.") -(defdyn *exit-value* "Set the return value from `run-context` upon an exit. By default, `run-context` will return nil.") +(defdyn *exit-value* "Set the return value from `run-context` upon an exit.") (defdyn *task-id* "When spawning a thread or fiber, the task-id can be assigned for concurrency control.") (defdyn *current-file* @@ -2219,56 +2219,31 @@ (map-template :some res pred ind inds) res) -(defn deep-not= - ``Like `not=`, but mutable types (arrays, tables, buffers) are considered - equal if they have identical structure. Much slower than `not=`.`` - [x y] - (def tx (type x)) - (or - (not= tx (type y)) - (case tx - :tuple (or (not= (length x) (length y)) - (do - (var ret false) - (forv i 0 (length x) - (def xx (in x i)) - (def yy (in y i)) - (if (deep-not= xx yy) - (break (set ret true)))) - ret)) - :array (or (not= (length x) (length y)) - (do - (var ret false) - (forv i 0 (length x) - (def xx (in x i)) - (def yy (in y i)) - (if (deep-not= xx yy) - (break (set ret true)))) - ret)) - :struct (deep-not= (kvs x) (kvs y)) - :table (deep-not= (table/to-struct x) (table/to-struct y)) - :buffer (not= (string x) (string y)) - (not= x y)))) - -(defn deep= - ``Like `=`, but mutable types (arrays, tables, buffers) are considered - equal if they have identical structure. Much slower than `=`.`` - [x y] - (not (deep-not= x y))) - (defn freeze `Freeze an object (make it immutable) and do a deep copy, making child values also immutable. Closures, fibers, and abstract types will not be recursively frozen, but all other types will.` [x] - (case (type x) - :array (tuple/slice (map freeze x)) - :tuple (tuple/slice (map freeze x)) - :table (if-let [p (table/getproto x)] - (freeze (merge (table/clone p) x)) - (struct ;(map freeze (kvs x)))) - :struct (struct ;(map freeze (kvs x))) - :buffer (string x) + (def tx (type x)) + (cond + (or (= tx :array) (= tx :tuple)) + (tuple/slice (map freeze x)) + + (or (= tx :table) (= tx :struct)) + (let [temp-tab @{}] + # Handle multiple unique keys that freeze. Result should + # be independent of iteration order. + (eachp [k v] x + (def kk (freeze k)) + (def vv (freeze v)) + (def old (get temp-tab kk)) + (def new (if (= nil old) vv (max vv old))) + (put temp-tab kk new)) + (table/to-struct temp-tab (freeze (getproto x)))) + + (= tx :buffer) + (string x) + x)) (defn thaw @@ -2284,6 +2259,41 @@ :string (buffer ds) ds)) +(defn deep-not= + ``Like `not=`, but mutable types (arrays, tables, buffers) are considered + equal if they have identical structure. Much slower than `not=`.`` + [x y] + (def tx (type x)) + (or + (not= tx (type y)) + (cond + (or (= tx :tuple) (= tx :array)) + (or (not= (length x) (length y)) + (do + (var ret false) + (forv i 0 (length x) + (def xx (in x i)) + (def yy (in y i)) + (if (deep-not= xx yy) + (break (set ret true)))) + ret)) + (or (= tx :struct) (= tx :table)) + (or (not= (length x) (length y)) + (do + (def rawget (if (= tx :struct) struct/rawget table/rawget)) + (var ret false) + (eachp [k v] x + (if (deep-not= (rawget y k) v) (break (set ret true)))) + ret)) + (= tx :buffer) (not= 0 (- (length x) (length y)) (memcmp x y)) + (not= x y)))) + +(defn deep= + ``Like `=`, but mutable types (arrays, tables, buffers) are considered + equal if they have identical structure. Much slower than `=`.`` + [x y] + (not (deep-not= x y))) + (defn macex ``Expand macros completely. `on-binding` is an optional callback for whenever a normal symbolic binding @@ -2335,17 +2345,11 @@ (defmacro short-fn ``` - Shorthand for `fn`. Arguments are given as `$n`, where `n` is the 0-indexed - argument of the function. `$` is also an alias for the first (index 0) argument. - The `$&` symbol will make the anonymous function variadic if it appears in the - body of the function, and can be combined with positional arguments. - - Example usage: - - (short-fn (+ $ $)) # A function that doubles its arguments. - (short-fn (string $0 $1)) # accepting multiple args. - |(+ $ $) # use pipe reader macro for terse function literals. - |(+ $&) # variadic functions + Shorthand for `fn`. Arguments are given as `$n`, where `n` is the + 0-indexed argument of the function. `$` is also an alias for the + first (index 0) argument. The `$&` symbol will make the anonymous + function variadic if it appears in the body of the function, and + can be combined with positional arguments. ``` [arg &opt name] (var max-param-seen -1) @@ -2665,7 +2669,6 @@ (do (var pindex 0) - (var pstatus nil) (def len (length buf)) (when (= len 0) (:eof p) @@ -2855,8 +2858,8 @@ (when (and (string? pattern) (string/has-prefix? ":sys:/" pattern)) (set last-index index) (array/push copies [(string/replace ":sys:" path pattern) ;(drop 1 entry)]))) - (array/insert mp (+ 1 last-index) ;copies) - mp) + (array/insert mp (+ 1 last-index) ;copies) + mp) (module/add-paths ":native:" :native) (module/add-paths "/init.janet" :source) @@ -3874,8 +3877,8 @@ (compwhen (dyn 'net/listen) (defn net/server "Start a server asynchronously with `net/listen` and `net/accept-loop`. Returns the new server stream." - [host port &opt handler type] - (def s (net/listen host port type)) + [host port &opt handler type no-reuse] + (def s (net/listen host port type no-reuse)) (if handler (ev/go (fn [] (net/accept-loop s handler)))) s)) @@ -4097,7 +4100,7 @@ (when (empty? b) (buffer/trim b) (os/chmod to perm) (break)) (file/write fto b) (buffer/clear b))) - (errorf "destination file %s cannot be opened for writing" to)) + (errorf "destination file %s cannot be opened for writing" to)) (errorf "source file %s cannot be opened for reading" from))) (defn- copyrf diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index 0211ee22..7fc77bc0 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -5,9 +5,9 @@ #define JANET_VERSION_MAJOR 1 #define JANET_VERSION_MINOR 37 -#define JANET_VERSION_PATCH 0 -#define JANET_VERSION_EXTRA "-dev" -#define JANET_VERSION "1.37.0-dev" +#define JANET_VERSION_PATCH 1 +#define JANET_VERSION_EXTRA "" +#define JANET_VERSION "1.37.1" /* #define JANET_BUILD "local" */ diff --git a/src/core/capi.c b/src/core/capi.c index 9d741332..af6ea582 100644 --- a/src/core/capi.c +++ b/src/core/capi.c @@ -62,6 +62,18 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) { void janet_signalv(JanetSignal sig, Janet message) { if (janet_vm.return_reg != NULL) { + /* Should match logic in janet_call for coercing everything not ok to an error (no awaits, yields, etc.) */ + if (janet_vm.coerce_error && sig != JANET_SIGNAL_OK) { +#ifdef JANET_EV + if (NULL != janet_vm.root_fiber && sig == JANET_SIGNAL_EVENT) { + janet_vm.root_fiber->sched_id++; + } +#endif + if (sig != JANET_SIGNAL_ERROR) { + message = janet_wrap_string(janet_formatc("%v coerced from %s to error", message, janet_signal_names[sig])); + } + sig = JANET_SIGNAL_ERROR; + } *janet_vm.return_reg = message; if (NULL != janet_vm.fiber) { janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP; diff --git a/src/core/corelib.c b/src/core/corelib.c index e333f079..cf1d9ab5 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -449,8 +449,9 @@ JANET_CORE_FN(janet_core_range, } count = (count > 0) ? count : 0; int32_t int_count; + janet_assert(count >= 0, "bad range code"); if (count > (double) INT32_MAX) { - int_count = INT32_MAX; + janet_panicf("range is too large, %f elements", count); } else { int_count = (int32_t) ceil(count); } @@ -1001,12 +1002,11 @@ static void make_apply(JanetTable *env) { janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG, "apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm), JDOC("(apply f & args)\n\n" - "Applies a function to a variable number of arguments. Each element in args " - "is used as an argument to f, except the last element in args, which is expected to " - "be an array-like. Each element in this last argument is then also pushed as an argument to " - "f. For example:\n\n" - "\t(apply + 1000 (range 10))\n\n" - "sums the first 10 integers and 1000.")); + "Applies a function f to a variable number of arguments. Each " + "element in args is used as an argument to f, except the last " + "element in args, which is expected to be an array or a tuple. " + "Each element in this last argument is then also pushed as an " + "argument to f.")); } static const uint32_t error_asm[] = { @@ -1159,82 +1159,82 @@ JanetTable *janet_core_env(JanetTable *replacements) { janet_quick_asm(env, JANET_FUN_CMP, "cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm), JDOC("(cmp x y)\n\n" - "Returns -1 if x is strictly less than y, 1 if y is strictly greater " - "than x, and 0 otherwise. To return 0, x and y must be the exact same type.")); + "Returns -1 if x is strictly less than y, 1 if y is strictly greater " + "than x, and 0 otherwise. To return 0, x and y must be the exact same type.")); janet_quick_asm(env, JANET_FUN_NEXT, "next", 2, 1, 2, 2, next_asm, sizeof(next_asm), JDOC("(next ds &opt key)\n\n" - "Gets the next key in a data structure. Can be used to iterate through " - "the keys of a data structure in an unspecified order. Keys are guaranteed " - "to be seen only once per iteration if the data structure is not mutated " - "during iteration. If key is nil, next returns the first key. If next " - "returns nil, there are no more keys to iterate through.")); + "Gets the next key in a data structure. Can be used to iterate through " + "the keys of a data structure in an unspecified order. Keys are guaranteed " + "to be seen only once per iteration if the data structure is not mutated " + "during iteration. If key is nil, next returns the first key. If next " + "returns nil, there are no more keys to iterate through.")); janet_quick_asm(env, JANET_FUN_PROP, "propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm), JDOC("(propagate x fiber)\n\n" - "Propagate a signal from a fiber to the current fiber and " - "set the last value of the current fiber to `x`. The signal " - "value is then available as the status of the current fiber. " - "The resulting stack trace from the current fiber will include " - "frames from fiber. If fiber is in a state that can be resumed, " - "resuming the current fiber will first resume `fiber`. " - "This function can be used to re-raise an error without losing " - "the original stack trace.")); + "Propagate a signal from a fiber to the current fiber and " + "set the last value of the current fiber to `x`. The signal " + "value is then available as the status of the current fiber. " + "The resulting stack trace from the current fiber will include " + "frames from fiber. If fiber is in a state that can be resumed, " + "resuming the current fiber will first resume `fiber`. " + "This function can be used to re-raise an error without losing " + "the original stack trace.")); janet_quick_asm(env, JANET_FUN_DEBUG, "debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm), JDOC("(debug &opt x)\n\n" - "Throws a debug signal that can be caught by a parent fiber and used to inspect " - "the running state of the current fiber. Returns the value passed in by resume.")); + "Throws a debug signal that can be caught by a parent fiber and used to inspect " + "the running state of the current fiber. Returns the value passed in by resume.")); janet_quick_asm(env, JANET_FUN_ERROR, "error", 1, 1, 1, 1, error_asm, sizeof(error_asm), JDOC("(error e)\n\n" - "Throws an error e that can be caught and handled by a parent fiber.")); + "Throws an error e that can be caught and handled by a parent fiber.")); janet_quick_asm(env, JANET_FUN_YIELD, "yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm), JDOC("(yield &opt x)\n\n" - "Yield a value to a parent fiber. When a fiber yields, its execution is paused until " - "another thread resumes it. The fiber will then resume, and the last yield call will " - "return the value that was passed to resume.")); + "Yield a value to a parent fiber. When a fiber yields, its execution is paused until " + "another thread resumes it. The fiber will then resume, and the last yield call will " + "return the value that was passed to resume.")); janet_quick_asm(env, JANET_FUN_CANCEL, "cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm), JDOC("(cancel fiber err)\n\n" - "Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. " - "Returns the same result as resume.")); + "Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. " + "Returns the same result as resume.")); janet_quick_asm(env, JANET_FUN_RESUME, "resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm), JDOC("(resume fiber &opt x)\n\n" - "Resume a new or suspended fiber and optionally pass in a value to the fiber that " - "will be returned to the last yield in the case of a pending fiber, or the argument to " - "the dispatch function in the case of a new fiber. Returns either the return result of " - "the fiber's dispatch function, or the value from the next yield call in fiber.")); + "Resume a new or suspended fiber and optionally pass in a value to the fiber that " + "will be returned to the last yield in the case of a pending fiber, or the argument to " + "the dispatch function in the case of a new fiber. Returns either the return result of " + "the fiber's dispatch function, or the value from the next yield call in fiber.")); janet_quick_asm(env, JANET_FUN_IN, "in", 3, 2, 3, 4, in_asm, sizeof(in_asm), JDOC("(in ds key &opt dflt)\n\n" - "Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, " - "strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, " - "and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can " - "take any value as a key except nil and will return nil or dflt if not found.")); + "Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, " + "strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, " + "and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can " + "take any value as a key except nil and will return nil or dflt if not found.")); janet_quick_asm(env, JANET_FUN_GET, "get", 3, 2, 3, 4, get_asm, sizeof(in_asm), JDOC("(get ds key &opt dflt)\n\n" - "Get the value mapped to key in data structure ds, and return dflt or nil if not found. " - "Similar to in, but will not throw an error if the key is invalid for the data structure " - "unless the data structure is an abstract type. In that case, the abstract type getter may throw " - "an error.")); + "Get the value mapped to key in data structure ds, and return dflt or nil if not found. " + "Similar to in, but will not throw an error if the key is invalid for the data structure " + "unless the data structure is an abstract type. In that case, the abstract type getter may throw " + "an error.")); janet_quick_asm(env, JANET_FUN_PUT, "put", 3, 3, 3, 3, put_asm, sizeof(put_asm), JDOC("(put ds key value)\n\n" - "Associate a key with a value in any mutable associative data structure. Indexed data structures " - "(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds " - "value is provided. In an array, extra space will be filled with nils, and in a buffer, extra " - "space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype " - "will hide the association defined by the prototype, but will not mutate the prototype table. Putting " - "a value nil into a table will remove the key from the table. Returns the data structure ds.")); + "Associate a key with a value in any mutable associative data structure. Indexed data structures " + "(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds " + "value is provided. In an array, extra space will be filled with nils, and in a buffer, extra " + "space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype " + "will hide the association defined by the prototype, but will not mutate the prototype table. Putting " + "a value nil into a table will remove the key from the table. Returns the data structure ds.")); janet_quick_asm(env, JANET_FUN_LENGTH, "length", 1, 1, 1, 1, length_asm, sizeof(length_asm), JDOC("(length ds)\n\n" - "Returns the length or count of a data structure in constant time as an integer. For " - "structs and tables, returns the number of key-value pairs in the data structure.")); + "Returns the length or count of a data structure in constant time as an integer. For " + "structs and tables, returns the number of key-value pairs in the data structure.")); janet_quick_asm(env, JANET_FUN_BNOT, "bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm), JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x.")); @@ -1243,74 +1243,74 @@ JanetTable *janet_core_env(JanetTable *replacements) { /* Variadic ops */ templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD, JDOC("(+ & xs)\n\n" - "Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0.")); + "Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0.")); templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT, JDOC("(- & xs)\n\n" - "Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the " - "negative value of that element. Otherwise, returns the first element in xs minus the sum of " - "the rest of the elements.")); + "Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the " + "negative value of that element. Otherwise, returns the first element in xs minus the sum of " + "the rest of the elements.")); templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY, JDOC("(* & xs)\n\n" - "Returns the product of all elements in xs. If xs is empty, returns 1.")); + "Returns the product of all elements in xs. If xs is empty, returns 1.")); templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE, JDOC("(/ & xs)\n\n" - "Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns " - "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " - "values.")); + "Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns " + "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " + "values.")); templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR, JDOC("(div & xs)\n\n" - "Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns " - "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " - "values.")); + "Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns " + "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " + "values.")); templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO, JDOC("(mod & xs)\n\n" - "Returns the result of applying the modulo operator on the first value of xs with each remaining value. " - "`(mod x 0)` is defined to be `x`.")); + "Returns the result of applying the modulo operator on the first value of xs with each remaining value. " + "`(mod x 0)` is defined to be `x`.")); templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER, JDOC("(% & xs)\n\n" - "Returns the remainder of dividing the first value of xs by each remaining value.")); + "Returns the remainder of dividing the first value of xs by each remaining value.")); templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND, JDOC("(band & xs)\n\n" - "Returns the bit-wise and of all values in xs. Each x in xs must be an integer.")); + "Returns the bit-wise and of all values in xs. Each x in xs must be an integer.")); templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR, JDOC("(bor & xs)\n\n" - "Returns the bit-wise or of all values in xs. Each x in xs must be an integer.")); + "Returns the bit-wise or of all values in xs. Each x in xs must be an integer.")); templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR, JDOC("(bxor & xs)\n\n" - "Returns the bit-wise xor of all values in xs. Each in xs must be an integer.")); + "Returns the bit-wise xor of all values in xs. Each in xs must be an integer.")); templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT, JDOC("(blshift x & shifts)\n\n" - "Returns the value of x bit shifted left by the sum of all values in shifts. x " - "and each element in shift must be an integer.")); + "Returns the value of x bit shifted left by the sum of all values in shifts. x " + "and each element in shift must be an integer.")); templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT, JDOC("(brshift x & shifts)\n\n" - "Returns the value of x bit shifted right by the sum of all values in shifts. x " - "and each element in shift must be an integer.")); + "Returns the value of x bit shifted right by the sum of all values in shifts. x " + "and each element in shift must be an integer.")); templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED, JDOC("(brushift x & shifts)\n\n" - "Returns the value of x bit shifted right by the sum of all values in shifts. x " - "and each element in shift must be an integer. The sign of x is not preserved, so " - "for positive shifts the return value will always be positive.")); + "Returns the value of x bit shifted right by the sum of all values in shifts. x " + "and each element in shift must be an integer. The sign of x is not preserved, so " + "for positive shifts the return value will always be positive.")); /* Variadic comparators */ templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN, JDOC("(> & xs)\n\n" - "Check if xs is in descending order. Returns a boolean.")); + "Check if xs is in descending order. Returns a boolean.")); templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN, JDOC("(< & xs)\n\n" - "Check if xs is in ascending order. Returns a boolean.")); + "Check if xs is in ascending order. Returns a boolean.")); templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL, JDOC("(>= & xs)\n\n" - "Check if xs is in non-ascending order. Returns a boolean.")); + "Check if xs is in non-ascending order. Returns a boolean.")); templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL, JDOC("(<= & xs)\n\n" - "Check if xs is in non-descending order. Returns a boolean.")); + "Check if xs is in non-descending order. Returns a boolean.")); templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS, JDOC("(= & xs)\n\n" - "Check if all values in xs are equal. Returns a boolean.")); + "Check if all values in xs are equal. Returns a boolean.")); templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS, JDOC("(not= & xs)\n\n" - "Check if any values in xs are not equal. Returns a boolean.")); + "Check if any values in xs are not equal. Returns a boolean.")); /* Platform detection */ janet_def(env, "janet/version", janet_cstringv(JANET_VERSION), @@ -1319,7 +1319,7 @@ JanetTable *janet_core_env(JanetTable *replacements) { JDOC("The build identifier of the running janet program.")); janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS), JDOC("The flag set of config options from janetconf.h which is used to check " - "if native modules are compatible with the host program.")); + "if native modules are compatible with the host program.")); /* Allow references to the environment */ janet_def(env, "root-env", janet_wrap_table(env), diff --git a/src/core/ev.c b/src/core/ev.c index 5437a8de..e51fee80 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -1,5 +1,5 @@ /* -* Copyright (c) 2024 Calvin Rose +* Copyright (c) 2025 Calvin Rose * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to @@ -32,9 +32,11 @@ #ifdef JANET_EV #include +#include #ifdef JANET_WINDOWS #include #include +#include #else #include #include @@ -43,7 +45,6 @@ #include #include #include -#include #include #include #include @@ -625,6 +626,18 @@ void janet_addtimeout(double sec) { add_timeout(to); } +/* Set timeout for the current root fiber but resume with nil instead of raising an error */ +void janet_addtimeout_nil(double sec) { + JanetFiber *fiber = janet_vm.root_fiber; + JanetTimeout to; + to.when = ts_delta(ts_now(), sec); + to.fiber = fiber; + to.curr_fiber = NULL; + to.sched_id = fiber->sched_id; + to.is_error = 0; + add_timeout(to); +} + void janet_ev_inc_refcount(void) { janet_atomic_inc(&janet_vm.listener_count); } @@ -1024,6 +1037,9 @@ JANET_CORE_FN(cfun_channel_push, "Returns the channel if the write succeeded, nil otherwise.") { janet_fixarity(argc, 2); JanetChannel *channel = janet_getchannel(argv, 0); + if (janet_vm.coerce_error) { + janet_panic("cannot give to channel inside janet_call"); + } if (janet_channel_push(channel, argv[1], 0)) { janet_await(); } @@ -1036,6 +1052,9 @@ JANET_CORE_FN(cfun_channel_pop, janet_fixarity(argc, 1); JanetChannel *channel = janet_getchannel(argv, 0); Janet item; + if (janet_vm.coerce_error) { + janet_panic("cannot take from channel inside janet_call"); + } if (janet_channel_pop(channel, &item, 0)) { janet_schedule(janet_vm.root_fiber, item); } @@ -1072,6 +1091,10 @@ JANET_CORE_FN(cfun_channel_choice, int32_t len; const Janet *data; + if (janet_vm.coerce_error) { + janet_panic("cannot select from channel inside janet_call"); + } + /* Check channels for immediate reads and writes */ for (int32_t i = 0; i < argc; i++) { if (janet_indexed_view(argv[i], &data, &len) && len == 2) { @@ -1776,6 +1799,22 @@ void janet_stream_edge_triggered(JanetStream *stream) { } void janet_stream_level_triggered(JanetStream *stream) { + /* On macos, we seem to need to delete any registered events before re-registering without + * EV_CLEAR, otherwise the new event will still have EV_CLEAR set erroneously. This could be a + * kernel bug, but unfortunately the specification is vague here, esp. in regards to where and when + * EV_CLEAR is set automatically. */ + struct kevent kevs[2]; + int length = 0; + if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) { + EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_DELETE, 0, 0, stream); + } + if (stream->flags & JANET_STREAM_WRITABLE) { + EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_DELETE, 0, 0, stream); + } + int status; + do { + status = kevent(janet_vm.kq, kevs, length, NULL, 0, NULL); + } while (status == -1 && errno == EINTR); janet_register_stream_impl(stream, 0); } @@ -3263,6 +3302,64 @@ JANET_CORE_FN(janet_cfun_rwlock_write_release, return argv[0]; } +static JanetFile *get_file_for_stream(JanetStream *stream) { + int32_t flags = 0; + char fmt[4] = {0}; + int index = 0; + if (stream->flags & JANET_STREAM_READABLE) { + flags |= JANET_FILE_READ; + janet_sandbox_assert(JANET_SANDBOX_FS_READ); + fmt[index++] = 'r'; + } + if (stream->flags & JANET_STREAM_WRITABLE) { + flags |= JANET_FILE_WRITE; + janet_sandbox_assert(JANET_SANDBOX_FS_WRITE); + int currindex = index; + fmt[index++] = (currindex == 0) ? 'w' : '+'; + } + if (index == 0) return NULL; + /* duplicate handle when converting stream to file */ +#ifdef JANET_WINDOWS + int htype = 0; + if (fmt[0] == 'r' && fmt[1] == '+') { + htype = _O_RDWR; + } else if (fmt[0] == 'r') { + htype = _O_RDONLY; + } else if (fmt[0] == 'w') { + htype = _O_WRONLY; + } + int fd = _open_osfhandle((intptr_t) stream->handle, htype); + if (fd < 0) return NULL; + int fd_dup = _dup(fd); + if (fd_dup < 0) return NULL; + FILE *f = _fdopen(fd_dup, fmt); + if (NULL == f) { + _close(fd_dup); + return NULL; + } +#else + int fd_dup = dup(stream->handle); + if (fd_dup < 0) return NULL; + FILE *f = fdopen(fd_dup, fmt); + if (NULL == f) { + close(fd_dup); + return NULL; + } +#endif + return janet_makejfile(f, flags); +} + +JANET_CORE_FN(janet_cfun_to_file, + "(ev/to-file)", + "Create core/file copy of the stream. This value can be used " + "when blocking IO behavior is needed.") { + janet_fixarity(argc, 1); + JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); + JanetFile *iof = get_file_for_stream(stream); + if (iof == NULL) janet_panic("cannot make file from stream"); + return janet_wrap_abstract(iof); +} + JANET_CORE_FN(janet_cfun_ev_all_tasks, "(ev/all-tasks)", "Get an array of all active fibers that are being used by the scheduler.") { @@ -3307,6 +3404,7 @@ void janet_lib_ev(JanetTable *env) { JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock), JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release), JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release), + JANET_CORE_REG("ev/to-file", janet_cfun_to_file), JANET_CORE_REG("ev/all-tasks", janet_cfun_ev_all_tasks), JANET_REG_END }; diff --git a/src/core/inttypes.c b/src/core/inttypes.c index f26dbdf6..855793d7 100644 --- a/src/core/inttypes.c +++ b/src/core/inttypes.c @@ -191,21 +191,21 @@ Janet janet_wrap_u64(uint64_t x) { JANET_CORE_FN(cfun_it_s64_new, "(int/s64 value)", - "Create a boxed signed 64 bit integer from a string value.") { + "Create a boxed signed 64 bit integer from a string value or a number.") { janet_fixarity(argc, 1); return janet_wrap_s64(janet_unwrap_s64(argv[0])); } JANET_CORE_FN(cfun_it_u64_new, "(int/u64 value)", - "Create a boxed unsigned 64 bit integer from a string value.") { + "Create a boxed unsigned 64 bit integer from a string value or a number.") { janet_fixarity(argc, 1); return janet_wrap_u64(janet_unwrap_u64(argv[0])); } JANET_CORE_FN(cfun_to_number, "(int/to-number value)", - "Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32.") { + "Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int64.") { janet_fixarity(argc, 1); if (janet_type(argv[0]) == JANET_ABSTRACT) { void *abst = janet_unwrap_abstract(argv[0]); diff --git a/src/core/io.c b/src/core/io.c index adbc9385..0f6703e9 100644 --- a/src/core/io.c +++ b/src/core/io.c @@ -31,6 +31,7 @@ #ifndef JANET_WINDOWS #include +#include #include #include #endif @@ -164,6 +165,14 @@ JANET_CORE_FN(cfun_io_fopen, } FILE *f = fopen((const char *)fname, (const char *)fmode); if (f != NULL) { +#ifndef JANET_WINDOWS + struct stat st; + fstat(fileno(f), &st); + if (S_ISDIR(st.st_mode)) { + fclose(f); + janet_panicf("cannot open directory: %s", fname); + } +#endif size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ); if (bufsize != BUFSIZ) { int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize); diff --git a/src/core/net.c b/src/core/net.c index 13ccb81f..21f4bdb1 100644 --- a/src/core/net.c +++ b/src/core/net.c @@ -554,7 +554,10 @@ JANET_CORE_FN(cfun_net_connect, int err = WSAGetLastError(); freeaddrinfo(ai); #else - int status = connect(sock, addr, addrlen); + int status; + do { + status = connect(sock, addr, addrlen); + } while (status == -1 && errno == EINTR); int err = errno; if (is_unix) { janet_free(ai); @@ -578,17 +581,23 @@ JANET_CORE_FN(cfun_net_connect, net_sched_connect(stream); } -static const char *serverify_socket(JSock sfd) { +static const char *serverify_socket(JSock sfd, int reuse_addr, int reuse_port) { /* Set various socket options */ int enable = 1; - if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) { - return "setsockopt(SO_REUSEADDR) failed"; + if (reuse_addr) { + if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) { + return "setsockopt(SO_REUSEADDR) failed"; + } } + if (reuse_port) { #ifdef SO_REUSEPORT - if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) { - return "setsockopt(SO_REUSEPORT) failed"; - } + if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) { + return "setsockopt(SO_REUSEPORT) failed"; + } +#else + (void) reuse_port; #endif + } janet_net_socknoblock(sfd); return NULL; } @@ -642,19 +651,21 @@ JANET_CORE_FN(cfun_net_shutdown, } JANET_CORE_FN(cfun_net_listen, - "(net/listen host port &opt type)", + "(net/listen host port &opt type no-reuse)", "Creates a server. Returns a new stream that is neither readable nor " "writeable. Use net/accept or net/accept-loop be to handle connections and start the server. " "The type parameter specifies the type of network connection, either " "a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is " - ":stream. The host and port arguments are the same as in net/address.") { + ":stream. The host and port arguments are the same as in net/address. The last boolean parameter `no-reuse` will " + "disable the use of SO_REUSEADDR and SO_REUSEPORT when creating a server on some operating systems.") { janet_sandbox_assert(JANET_SANDBOX_NET_LISTEN); - janet_arity(argc, 2, 3); + janet_arity(argc, 2, 4); /* Get host, port, and handler*/ int socktype = janet_get_sockettype(argv, argc, 2); int is_unix = 0; struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix); + int reuse = !(argc >= 4 && janet_truthy(argv[3])); JSock sfd = JSOCKDEFAULT; #ifndef JANET_WINDOWS @@ -664,7 +675,7 @@ JANET_CORE_FN(cfun_net_listen, janet_free(ai); janet_panicf("could not create socket: %V", janet_ev_lasterr()); } - const char *err = serverify_socket(sfd); + const char *err = serverify_socket(sfd, reuse, 0); if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) { JSOCKCLOSE(sfd); janet_free(ai); @@ -687,7 +698,7 @@ JANET_CORE_FN(cfun_net_listen, sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol); #endif if (!JSOCKVALID(sfd)) continue; - const char *err = serverify_socket(sfd); + const char *err = serverify_socket(sfd, reuse, reuse); if (NULL != err) { JSOCKCLOSE(sfd); continue; @@ -829,7 +840,7 @@ JANET_CORE_FN(cfun_stream_accept_loop, JANET_CORE_FN(cfun_stream_accept, "(net/accept stream &opt timeout)", "Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. " - "Takes an optional timeout in seconds, after which will return nil. " + "Takes an optional timeout in seconds, after which will raise an error. " "Returns a new duplex stream which represents a connection to the client.") { janet_arity(argc, 1, 2); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); @@ -844,7 +855,7 @@ JANET_CORE_FN(cfun_stream_read, "Read up to n bytes from a stream, suspending the current fiber until the bytes are available. " "`n` can also be the keyword `:all` to read into the buffer until end of stream. " "If less than n bytes are available (and more than 0), will push those bytes and return early. " - "Takes an optional timeout in seconds, after which will return nil. " + "Takes an optional timeout in seconds, after which will raise an error. " "Returns a buffer with up to n more bytes in it, or raises an error if the read failed.") { janet_arity(argc, 2, 4); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); @@ -864,7 +875,7 @@ JANET_CORE_FN(cfun_stream_read, JANET_CORE_FN(cfun_stream_chunk, "(net/chunk stream nbytes &opt buf timeout)", "Same a net/read, but will wait for all n bytes to arrive rather than return early. " - "Takes an optional timeout in seconds, after which will return nil.") { + "Takes an optional timeout in seconds, after which will raise an error.") { janet_arity(argc, 2, 4); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET); @@ -878,7 +889,7 @@ JANET_CORE_FN(cfun_stream_chunk, JANET_CORE_FN(cfun_stream_recv_from, "(net/recv-from stream nbytes buf &opt timeout)", "Receives data from a server stream and puts it into a buffer. Returns the socket-address the " - "packet came from. Takes an optional timeout in seconds, after which will return nil.") { + "packet came from. Takes an optional timeout in seconds, after which will raise an error.") { janet_arity(argc, 3, 4); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET); @@ -892,7 +903,7 @@ JANET_CORE_FN(cfun_stream_recv_from, JANET_CORE_FN(cfun_stream_write, "(net/write stream data &opt timeout)", "Write data to a stream, suspending the current fiber until the write " - "completes. Takes an optional timeout in seconds, after which will return nil. " + "completes. Takes an optional timeout in seconds, after which will raise an error. " "Returns nil, or raises an error if the write failed.") { janet_arity(argc, 2, 3); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); @@ -911,7 +922,7 @@ JANET_CORE_FN(cfun_stream_write, JANET_CORE_FN(cfun_stream_send_to, "(net/send-to stream dest data &opt timeout)", "Writes a datagram to a server stream. dest is a the destination address of the packet. " - "Takes an optional timeout in seconds, after which will return nil. " + "Takes an optional timeout in seconds, after which will raise an error. " "Returns stream.") { janet_arity(argc, 3, 4); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); diff --git a/src/core/parse.c b/src/core/parse.c index 6faa7948..c9177316 100644 --- a/src/core/parse.c +++ b/src/core/parse.c @@ -363,8 +363,7 @@ static int stringend(JanetParser *p, JanetParseState *state) { JanetParseState top = p->states[p->statecount - 1]; int32_t indent_col = (int32_t) top.column - 1; uint8_t *r = bufstart, *end = r + buflen; - /* Check if there are any characters before the start column - - * if so, do not reindent. */ + /* Unless there are only spaces before EOLs, disable reindenting */ int reindent = 1; while (reindent && (r < end)) { if (*r++ == '\n') { @@ -374,34 +373,36 @@ static int stringend(JanetParser *p, JanetParseState *state) { break; } } + if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') reindent = 1; } } - /* Now reindent if able to, otherwise just drop leading newline. */ - if (!reindent) { - if (buflen > 0 && bufstart[0] == '\n') { - buflen--; - bufstart++; - } - } else { + /* Now reindent if able */ + if (reindent) { uint8_t *w = bufstart; r = bufstart; while (r < end) { if (*r == '\n') { - if (r == bufstart) { - /* Skip leading newline */ - r++; - } else { - *w++ = *r++; - } + *w++ = *r++; for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++); + if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') *w++ = *r++; } else { *w++ = *r++; } } buflen = (int32_t)(w - bufstart); } - /* Check for trailing newline character so we can remove it */ - if (buflen > 0 && bufstart[buflen - 1] == '\n') { + /* Check for leading EOL so we can remove it */ + if (buflen > 1 && bufstart[0] == '\r' && bufstart[1] == '\n') { /* Windows EOL */ + buflen = buflen - 2; + bufstart = bufstart + 2; + } else if (buflen > 0 && bufstart[0] == '\n') { /* Unix EOL */ + buflen--; + bufstart++; + } + /* Check for trailing EOL so we can remove it */ + if (buflen > 1 && bufstart[buflen - 2] == '\r' && bufstart[buflen - 1] == '\n') { /* Windows EOL */ + buflen = buflen - 2; + } else if (buflen > 0 && bufstart[buflen - 1] == '\n') { /* Unix EOL */ buflen--; } } diff --git a/src/core/peg.c b/src/core/peg.c index 24d1d320..454cc802 100644 --- a/src/core/peg.c +++ b/src/core/peg.c @@ -1,5 +1,5 @@ /* -* Copyright (c) 2024 Calvin Rose +* Copyright (c) 2025 Calvin Rose * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to @@ -342,7 +342,7 @@ tail: while (captured < hi) { CapState cs2 = cap_save(s); next_text = peg_rule(s, rule_a, text); - if (!next_text || next_text == text) { + if (!next_text || ((next_text == text) && (hi == UINT32_MAX))) { cap_load(s, cs2); break; } @@ -544,41 +544,80 @@ tail: return window_end; } + case RULE_TIL: { + const uint32_t *rule_terminus = s->bytecode + rule[1]; + const uint32_t *rule_subpattern = s->bytecode + rule[2]; + + const uint8_t *terminus_start = text; + const uint8_t *terminus_end = NULL; + down1(s); + while (terminus_start <= s->text_end) { + CapState cs2 = cap_save(s); + terminus_end = peg_rule(s, rule_terminus, terminus_start); + cap_load(s, cs2); + if (terminus_end) { + break; + } + terminus_start++; + } + up1(s); + + if (!terminus_end) { + return NULL; + } + + const uint8_t *saved_end = s->text_end; + s->text_end = terminus_start; + down1(s); + const uint8_t *matched = peg_rule(s, rule_subpattern, text); + up1(s); + s->text_end = saved_end; + + if (!matched) { + return NULL; + } + + return terminus_end; + } + case RULE_SPLIT: { const uint8_t *saved_end = s->text_end; const uint32_t *rule_separator = s->bytecode + rule[1]; const uint32_t *rule_subpattern = s->bytecode + rule[2]; - const uint8_t *separator_end = NULL; - do { - const uint8_t *text_start = text; + const uint8_t *chunk_start = text; + const uint8_t *chunk_end = NULL; + + while (text <= saved_end) { + /* Find next split (or end of text) */ CapState cs = cap_save(s); down1(s); - while (text <= s->text_end) { - separator_end = peg_rule(s, rule_separator, text); + while (text <= saved_end) { + chunk_end = text; + const uint8_t *check = peg_rule(s, rule_separator, text); cap_load(s, cs); - if (separator_end) { + if (check) { + text = check; break; } text++; } up1(s); - if (separator_end) { - s->text_end = text; - text = separator_end; - } - + /* Match between splits */ + s->text_end = chunk_end; down1(s); - const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start); + const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, chunk_start); up1(s); s->text_end = saved_end; + if (!subpattern_end) return NULL; /* Don't match anything */ - if (!subpattern_end) { - return NULL; - } - } while (separator_end); + /* Ensure forward progress */ + if (text == chunk_start) return NULL; + chunk_start = text; + } + s->text_end = saved_end; return s->text_end; } @@ -1227,6 +1266,14 @@ static void spec_sub(Builder *b, int32_t argc, const Janet *argv) { emit_2(r, RULE_SUB, subrule1, subrule2); } +static void spec_til(Builder *b, int32_t argc, const Janet *argv) { + peg_fixarity(b, argc, 2); + Reserve r = reserve(b, 3); + uint32_t subrule1 = peg_compile1(b, argv[0]); + uint32_t subrule2 = peg_compile1(b, argv[1]); + emit_2(r, RULE_TIL, subrule1, subrule2); +} + static void spec_split(Builder *b, int32_t argc, const Janet *argv) { peg_fixarity(b, argc, 2); Reserve r = reserve(b, 3); @@ -1323,6 +1370,7 @@ static const SpecialPair peg_specials[] = { {"split", spec_split}, {"sub", spec_sub}, {"thru", spec_thru}, + {"til", spec_til}, {"to", spec_to}, {"uint", spec_uint_le}, {"uint-be", spec_uint_be}, @@ -1416,6 +1464,11 @@ static uint32_t peg_compile1(Builder *b, Janet peg) { emit_bytes(b, RULE_LITERAL, len, str); break; } + case JANET_BUFFER: { + const JanetBuffer *buf = janet_unwrap_buffer(peg); + emit_bytes(b, RULE_LITERAL, buf->count, buf->data); + break; + } case JANET_TABLE: { /* Build grammar table */ JanetTable *new_grammar = janet_table_clone(janet_unwrap_table(peg)); @@ -1657,6 +1710,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) { i += 4; break; case RULE_SUB: + case RULE_TIL: case RULE_SPLIT: /* [rule, rule] */ if (rule[1] >= blen) goto bad; diff --git a/src/core/run.c b/src/core/run.c index bdd7205d..9942f07b 100644 --- a/src/core/run.c +++ b/src/core/run.c @@ -28,7 +28,7 @@ /* Run a string */ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) { - JanetParser parser; + JanetParser *parser; int errflags = 0, done = 0; int32_t index = 0; Janet ret = janet_wrap_nil(); @@ -37,14 +37,16 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char if (where) janet_gcroot(janet_wrap_string(where)); if (NULL == sourcePath) sourcePath = ""; - janet_parser_init(&parser); + parser = janet_abstract(&janet_parser_type, sizeof(JanetParser)); + janet_parser_init(parser); + janet_gcroot(janet_wrap_abstract(parser)); /* While we haven't seen an error */ while (!done) { /* Evaluate parsed values */ - while (janet_parser_has_more(&parser)) { - Janet form = janet_parser_produce(&parser); + while (janet_parser_has_more(parser)) { + Janet form = janet_parser_produce(parser); JanetCompileResult cres = janet_compile(form, env, where); if (cres.status == JANET_COMPILE_OK) { JanetFunction *f = janet_thunk(cres.funcdef); @@ -58,8 +60,8 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char } } else { ret = janet_wrap_string(cres.error); - int32_t line = (int32_t) parser.line; - int32_t col = (int32_t) parser.column; + int32_t line = (int32_t) parser->line; + int32_t col = (int32_t) parser->column; if ((cres.error_mapping.line > 0) && (cres.error_mapping.column > 0)) { line = cres.error_mapping.line; @@ -81,16 +83,16 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char if (done) break; /* Dispatch based on parse state */ - switch (janet_parser_status(&parser)) { + switch (janet_parser_status(parser)) { case JANET_PARSE_DEAD: done = 1; break; case JANET_PARSE_ERROR: { - const char *e = janet_parser_error(&parser); + const char *e = janet_parser_error(parser); errflags |= 0x04; ret = janet_cstringv(e); - int32_t line = (int32_t) parser.line; - int32_t col = (int32_t) parser.column; + int32_t line = (int32_t) parser->line; + int32_t col = (int32_t) parser->column; janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e); done = 1; break; @@ -98,9 +100,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char case JANET_PARSE_ROOT: case JANET_PARSE_PENDING: if (index >= len) { - janet_parser_eof(&parser); + janet_parser_eof(parser); } else { - janet_parser_consume(&parser, bytes[index++]); + janet_parser_consume(parser, bytes[index++]); } break; } @@ -108,7 +110,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char } /* Clean up and return errors */ - janet_parser_deinit(&parser); + janet_gcunroot(janet_wrap_abstract(parser)); if (where) janet_gcunroot(janet_wrap_string(where)); #ifdef JANET_EV /* Enter the event loop if we are not already in it */ diff --git a/src/core/state.h b/src/core/state.h index 5d9192c4..d121f559 100644 --- a/src/core/state.h +++ b/src/core/state.h @@ -100,6 +100,7 @@ struct JanetVM { * return point for panics. */ jmp_buf *signal_buf; Janet *return_reg; + int coerce_error; /* The global registry for c functions. Used to store meta-data * along with otherwise bare c function pointers. */ diff --git a/src/core/strtod.c b/src/core/strtod.c index 67247aa6..33857027 100644 --- a/src/core/strtod.c +++ b/src/core/strtod.c @@ -301,6 +301,7 @@ int janet_scan_number_base( if (base == 0) { base = 10; } + int exp_base = base; /* Skip leading zeros */ while (str < end && (*str == '0' || *str == '.')) { @@ -322,6 +323,12 @@ int janet_scan_number_base( } else if (*str == '&') { foundexp = 1; break; + } else if (base == 16 && (*str == 'P' || *str == 'p')) { /* IEEE hex float */ + foundexp = 1; + exp_base = 10; + base = 2; + ex *= 4; /* We need to correct the current exponent after we change the base */ + break; } else if (base == 10 && (*str == 'E' || *str == 'e')) { foundexp = 1; break; @@ -360,9 +367,9 @@ int janet_scan_number_base( } while (str < end) { int digit = digit_lookup[*str & 0x7F]; - if (*str > 127 || digit >= base) goto error; + if (*str > 127 || digit >= exp_base) goto error; if (ee < (INT32_MAX / 40)) { - ee = base * ee + digit; + ee = exp_base * ee + digit; } str++; seenadigit = 1; diff --git a/src/core/struct.c b/src/core/struct.c index acc9a921..2e4be627 100644 --- a/src/core/struct.c +++ b/src/core/struct.c @@ -294,6 +294,16 @@ JANET_CORE_FN(cfun_struct_to_table, return janet_wrap_table(tab); } +JANET_CORE_FN(cfun_struct_rawget, + "(struct/rawget st key)", + "Gets a value from a struct `st` without looking at the prototype struct. " + "If `st` does not contain the key directly, the function will return " + "nil without checking the prototype. Returns the value in the struct.") { + janet_fixarity(argc, 2); + JanetStruct st = janet_getstruct(argv, 0); + return janet_struct_rawget(st, argv[1]); +} + /* Load the struct module */ void janet_lib_struct(JanetTable *env) { JanetRegExt struct_cfuns[] = { @@ -301,6 +311,7 @@ void janet_lib_struct(JanetTable *env) { JANET_CORE_REG("struct/getproto", cfun_struct_getproto), JANET_CORE_REG("struct/proto-flatten", cfun_struct_flatten), JANET_CORE_REG("struct/to-table", cfun_struct_to_table), + JANET_CORE_REG("struct/rawget", cfun_struct_rawget), JANET_REG_END }; janet_core_cfuns_ext(env, NULL, struct_cfuns); diff --git a/src/core/table.c b/src/core/table.c index 2e82b1ab..229d8fa3 100644 --- a/src/core/table.c +++ b/src/core/table.c @@ -372,12 +372,14 @@ JANET_CORE_FN(cfun_table_setproto, } JANET_CORE_FN(cfun_table_tostruct, - "(table/to-struct tab)", - "Convert a table to a struct. Returns a new struct. This function " - "does not take into account prototype tables.") { - janet_fixarity(argc, 1); + "(table/to-struct tab &opt proto)", + "Convert a table to a struct. Returns a new struct.") { + janet_arity(argc, 1, 2); JanetTable *t = janet_gettable(argv, 0); - return janet_wrap_struct(janet_table_to_struct(t)); + JanetStruct proto = janet_optstruct(argv, argc, 1, NULL); + JanetStruct st = janet_table_to_struct(t); + janet_struct_proto(st) = proto; + return janet_wrap_struct(st); } JANET_CORE_FN(cfun_table_rawget, diff --git a/src/core/vm.c b/src/core/vm.c index ccbc87e2..4fe179d3 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -1373,7 +1373,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) { /* Run vm */ janet_vm.fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP; + int old_coerce_error = janet_vm.coerce_error; + janet_vm.coerce_error = 1; JanetSignal signal = run_vm(janet_vm.fiber, janet_wrap_nil()); + janet_vm.coerce_error = old_coerce_error; /* Teardown */ janet_vm.stackn = oldn; @@ -1384,6 +1387,15 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) { } if (signal != JANET_SIGNAL_OK) { + /* Should match logic in janet_signalv */ +#ifdef JANET_EV + if (janet_vm.root_fiber != NULL && signal == JANET_SIGNAL_EVENT) { + janet_vm.root_fiber->sched_id++; + } +#endif + if (signal != JANET_SIGNAL_ERROR) { + *janet_vm.return_reg = janet_wrap_string(janet_formatc("%v coerced from %s to error", *janet_vm.return_reg, janet_signal_names[signal])); + } janet_panicv(*janet_vm.return_reg); } @@ -1430,8 +1442,10 @@ void janet_try_init(JanetTryState *state) { state->vm_fiber = janet_vm.fiber; state->vm_jmp_buf = janet_vm.signal_buf; state->vm_return_reg = janet_vm.return_reg; + state->coerce_error = janet_vm.coerce_error; janet_vm.return_reg = &(state->payload); janet_vm.signal_buf = &(state->buf); + janet_vm.coerce_error = 0; } void janet_restore(JanetTryState *state) { @@ -1440,6 +1454,7 @@ void janet_restore(JanetTryState *state) { janet_vm.fiber = state->vm_fiber; janet_vm.signal_buf = state->vm_jmp_buf; janet_vm.return_reg = state->vm_return_reg; + janet_vm.coerce_error = state->coerce_error; } static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) { diff --git a/src/include/janet.h b/src/include/janet.h index ea858d14..988e8016 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1262,6 +1262,7 @@ typedef struct { /* new state */ jmp_buf buf; Janet payload; + int coerce_error; } JanetTryState; /***** END SECTION TYPES *****/ @@ -1443,6 +1444,7 @@ JANET_NO_RETURN JANET_API void janet_sleep_await(double sec); /* For use inside listeners - adds a timeout to the current fiber, such that * it will be resumed after sec seconds if no other event schedules the current fiber. */ JANET_API void janet_addtimeout(double sec); +JANET_API void janet_addtimeout_nil(double sec); JANET_API void janet_ev_inc_refcount(void); JANET_API void janet_ev_dec_refcount(void); @@ -2181,6 +2183,7 @@ typedef enum { RULE_UNREF, /* [rule, tag] */ RULE_CAPTURE_NUM, /* [rule, tag] */ RULE_SUB, /* [rule, rule] */ + RULE_TIL, /* [rule, rule] */ RULE_SPLIT, /* [rule, rule] */ RULE_NTH, /* [nth, rule, tag] */ RULE_ONLY_TAGS, /* [rule] */ diff --git a/test/helper.janet b/test/helper.janet index 288638a9..4a6c8596 100644 --- a/test/helper.janet +++ b/test/helper.janet @@ -39,7 +39,7 @@ (defmacro assert [x &opt e] (def xx (gensym)) - (default e ~',x) + (default e (string/format "%j" x)) ~(do (def ,xx ,x) (,assert-no-tail ,xx ,e) diff --git a/test/suite-boot.janet b/test/suite-boot.janet index a598d827..ec7c4133 100644 --- a/test/suite-boot.janet +++ b/test/suite-boot.janet @@ -896,11 +896,18 @@ (struct/with-proto {:a [1 2 3]} :c 22 :b [1 2 3 4] :d "test" :e "test2")) (table/setproto table-to-freeze @{:a @[1 2 3]}) -(assert (deep= {:a [1 2 3] :b [1 2 3 4] :c 22 :d "test" :e "test2"} - (freeze table-to-freeze))) +(assert (deep= struct-to-thaw (freeze table-to-freeze))) (assert (deep= table-to-freeze-with-inline-proto (thaw table-to-freeze))) (assert (deep= table-to-freeze-with-inline-proto (thaw struct-to-thaw))) +# Check that freezing mutable keys is deterministic +# for issue #1535 +(def hashes @{}) +(repeat 200 + (def x (freeze {@"" 1 @"" 2 @"" 3 @"" 4 @"" 5})) + (put hashes (hash x) true)) +(assert (= 1 (length hashes)) "freeze mutable keys is deterministic") + # Make sure Carriage Returns don't end up in doc strings # e528b86 (assert (not (string/find "\r" @@ -1006,4 +1013,18 @@ (assert-error "assertf error 3" (assertf false "%s message" "mystery")) (assert-error "assertf error 4" (assertf nil "%s %s" "alice" "bob")) +# issue #1535 +(loop [i :range [1 1000]] + (assert (deep-not= @{:key1 "value1" @"key" "value2"} + @{:key1 "value1" @"key" "value2"}) "deep= mutable keys")) +(assert (deep-not= {"abc" 123} {@"abc" 123}) "deep= mutable keys vs immutable key") +(assert (deep-not= {@"" 1 @"" 2 @"" 3} {@"" 1 @"" 2 @"" 3}) "deep= duplicate mutable keys") +(assert (deep-not= {@"" @"" @"" @"" @"" 3} {@"" @"" @"" @"" @"" 3}) "deep= duplicate mutable keys 2") +(assert (deep-not= {@[] @"" @[] @"" @[] 3} {@[] @"" @[] @"" @[] 3}) "deep= duplicate mutable keys 3") +(assert (deep-not= {@{} @"" @{} @"" @{} 3} {@{} @"" @{} @"" @{} 3}) "deep= duplicate mutable keys 4") +(assert (deep-not= @{:key1 "value1" @"key2" @"value2"} + @{:key1 "value1" @"key2" "value2"}) "deep= mutable keys") +(assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"} + @{:key1 "value1" [@"key2"] @"value2"}) "deep= mutable keys") + (end-suite) diff --git a/test/suite-corelib.janet b/test/suite-corelib.janet index 3c209418..119ec768 100644 --- a/test/suite-corelib.janet +++ b/test/suite-corelib.janet @@ -174,6 +174,7 @@ (assert (deep= (range 0 17 4) @[0 4 8 12 16]) "(range 0 17 4)") (assert (deep= (range 16 0 -4) @[16 12 8 4]) "(range 16 0 -4)") (assert (deep= (range 17 0 -4) @[17 13 9 5 1]) "(range 17 0 -4)") +(assert-error "large range" (range 0xFFFFFFFFFF)) (assert (= (length (range 10)) 10) "(range 10)") (assert (= (length (range -10)) 0) "(range -10)") diff --git a/test/suite-ev.janet b/test/suite-ev.janet index f0e859bf..c773e960 100644 --- a/test/suite-ev.janet +++ b/test/suite-ev.janet @@ -1,4 +1,4 @@ -# Copyright (c) 2023 Calvin Rose & contributors +# Copyright (c) 2025 Calvin Rose & contributors # # Permission is hereby granted, free of charge, to any person obtaining a copy # of this software and associated documentation files (the "Software"), to @@ -199,7 +199,7 @@ (assert s "made server 1") (defn test-echo [msg] - (with [conn (net/connect test-host test-port)] + (with [conn (assert (net/connect test-host test-port))] (net/write conn msg) (def res (net/read conn 1024)) (assert (= (string res) msg) (string "echo " msg)))) @@ -213,6 +213,7 @@ # Test on both server and client # 504411e +(var iterations 0) (defn names-handler [stream] (defer (:close stream) @@ -220,21 +221,26 @@ (ev/read stream 1) (def [host port] (net/localname stream)) (assert (= host test-host) "localname host server") - (assert (= port (scan-number test-port)) "localname port server"))) + (assert (= port (scan-number test-port)) "localname port server") + (++ iterations) + (ev/write stream " "))) # Test localname and peername # 077bf5eba (repeat 10 (with [s (net/server test-host test-port names-handler)] (repeat 10 - (with [conn (net/connect test-host test-port)] + (with [conn (assert (net/connect test-host test-port))] (def [host port] (net/peername conn)) (assert (= host test-host) "peername host client ") (assert (= port (scan-number test-port)) "peername port client") - # let server close - (ev/write conn " ")))) + (++ iterations) + (ev/write conn " ") + (ev/read conn 1)))) (gccollect)) +(assert (= iterations 200) "localname and peername not enough checks") + # Create pipe # 12f09ad2d (var pipe-counter 0) @@ -410,6 +416,10 @@ (ev/call handler connection) (break)))) +# Make sure we can't bind again with no-reuse +(assert-error "no-reuse" + (net/listen test-host test-port :stream true)) + # Read from socket (defn expect-read @@ -418,11 +428,17 @@ (assert (= result text) (string/format "expected %v, got %v" text result))) # Now do our telnet chat -(def bob (net/connect test-host test-port)) +(def bob (assert (net/connect test-host test-port :stream))) (expect-read bob "Whats your name?\n") -(net/write bob "bob") +(if (= :mingw (os/which)) + (net/write bob "bob") + (do + (def fbob (ev/to-file bob)) + (file/write fbob "bob") + (file/flush fbob) + (:close fbob))) (expect-read bob "Welcome bob\n") -(def alice (net/connect test-host test-port)) +(def alice (assert (net/connect test-host test-port))) (expect-read alice "Whats your name?\n") (net/write alice "alice") (expect-read alice "Welcome alice\n") @@ -436,7 +452,7 @@ (expect-read bob "[alice]:hi\n") # Ted joins the chat server -(def ted (net/connect test-host test-port)) +(def ted (assert (net/connect test-host test-port))) (expect-read ted "Whats your name?\n") (net/write ted "ted") (expect-read ted "Welcome ted\n") @@ -465,4 +481,49 @@ # Close chat server (:close chat-server) +# Issue #1531 +(defn sleep-print [x] (ev/sleep 0) (print x)) +(protect (with-dyns [*out* sleep-print] (prin :foo))) +(defn level-trigger-handling [conn &] (:close conn)) +(def s (assert (net/server test-host test-port level-trigger-handling))) +(def c (assert (net/connect test-host test-port))) +(:close s) + +# Issue #1531 no. 2 +(def c (ev/chan 0)) +(ev/spawn (while (def x (ev/take c)))) +(defn print-to-chan [x] (ev/give c x)) +(assert-error "coerce await inside janet_call to error" + (with-dyns [*out* print-to-chan] + (pp :foo))) +(ev/chan-close c) + +# soreuseport on unix domain sockets +(compwhen (or (= :macos (os/which)) (= :linux (os/which))) + (assert-no-error "unix-domain socket reuseaddr" + (let [s (net/listen :unix "./unix-domain-socket" :stream)] + (:close s)))) + +# net/accept-loop level triggering +(gccollect) +(def maxconn 50) +(var connect-count 0) +(defn level-trigger-handling + [conn &] + (with [conn conn] + (ev/write conn (ev/read conn 4096)) + (++ connect-count))) +(def s (assert (net/server test-host test-port level-trigger-handling))) +(def cons @[]) +(repeat maxconn (array/push cons (assert (net/connect test-host test-port)))) +(assert (= maxconn (length cons))) +(defn do-connect [i] + (with [c (get cons i)] + (ev/write c "abc123") + (ev/read c 4096))) +(for i 0 maxconn (ev/spawn (do-connect i))) +(ev/sleep 0.1) +(assert (= maxconn connect-count)) +(:close s) + (end-suite) diff --git a/test/suite-marsh.janet b/test/suite-marsh.janet index b9f4d277..1bcfb0d5 100644 --- a/test/suite-marsh.janet +++ b/test/suite-marsh.janet @@ -207,7 +207,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 (assert (= 2 (length tclone)) "table/weak-values marsh 2") (gccollect) (assert (= 1 (length t)) "table/weak-value marsh 3") -(assert (deep= t tclone) "table/weak-values marsh 4") +(assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4") # tables with prototypes (def t (table/weak-values 1)) @@ -219,7 +219,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 (assert (= 2 (length tclone)) "marsh weak tables with prototypes 2") (gccollect) (assert (= 1 (length t)) "marsh weak tables with prototypes 3") -(assert (deep= t tclone) "marsh weak tables with prototypes 4") +(assert (deep= (freeze t) (freeze tclone)) "marsh weak tables with prototypes 4") (assert (deep= (getproto t) (getproto tclone)) "marsh weak tables with prototypes 5") (end-suite) diff --git a/test/suite-parse.janet b/test/suite-parse.janet index 94154120..3cf8b595 100644 --- a/test/suite-parse.janet +++ b/test/suite-parse.janet @@ -57,6 +57,8 @@ (for i (+ index 1) (+ index indent 1) (case (get text i) nil (break) + (chr "\r") (if-not (= (chr "\n") (get text (inc i))) + (set rewrite false)) (chr "\n") (break) (chr " ") nil (set rewrite false)))) @@ -64,12 +66,17 @@ # Only re-indent if no dedented characters. (def str (if rewrite - (peg/replace-all ~(* "\n" (between 0 ,indent " ")) "\n" text) + (peg/replace-all ~(* '(* (? "\r") "\n") (between 0 ,indent " ")) + (fn [mtch eol] eol) text) text)) - (def first-nl (= (chr "\n") (first str))) - (def last-nl (= (chr "\n") (last str))) - (string/slice str (if first-nl 1 0) (if last-nl -2))) + (def first-eol (cond + (string/has-prefix? "\r\n" str) :crlf + (string/has-prefix? "\n" str) :lf)) + (def last-eol (cond + (string/has-suffix? "\r\n" str) :crlf + (string/has-suffix? "\n" str) :lf)) + (string/slice str (case first-eol :crlf 2 :lf 1 0) (case last-eol :crlf -3 :lf -2))) (defn reindent-reference "Same as reindent but use parser functionality. Useful for @@ -89,8 +96,10 @@ (let [a (reindent text indent) b (reindent-reference text indent)] (assert (= a b) - (string "indent " indent-counter " (indent=" indent ")")))) + (string/format "reindent: %q, parse: %q (indent-test #%d with indent of %d)" a b indent-counter indent) + ))) +# Unix EOLs (check-indent "" 0) (check-indent "\n" 0) (check-indent "\n" 1) @@ -106,6 +115,17 @@ (check-indent "\n Hello, world!\n " 4) (check-indent "\n Hello, world!\n dedented text\n " 4) (check-indent "\n Hello, world!\n indented text\n " 4) +# Windows EOLs +(check-indent "\r\n" 0) +(check-indent "\r\n" 1) +(check-indent "\r\n\r\n" 0) +(check-indent "\r\n\r\n" 1) +(check-indent "\r\nHello, world!" 0) +(check-indent "\r\nHello, world!" 1) +(check-indent "\r\n Hello, world!\r\n " 4) +(check-indent "\r\n Hello, world!\r\n " 4) +(check-indent "\r\n Hello, world!\r\n dedented text\r\n " 4) +(check-indent "\r\n Hello, world!\r\n indented text\r\n " 4) # Symbols with @ character # d68eae9 @@ -188,5 +208,14 @@ (parser/consume p `")`) (assert (= (parser/produce p) ["hello"])) +# Hex floats +(assert (= math/pi +0x1.921fb54442d18p+0001)) +(assert (= math/int-max +0x1.ffff_ffff_ffff_ffp+0052)) +(assert (= math/int-min -0x1.ffff_ffff_ffff_ffp+0052)) +(assert (= 1 0x1P0)) +(assert (= 2 0x1P1)) +(assert (= -2 -0x1p1)) +(assert (= -0.5 -0x1p-1)) + (end-suite) diff --git a/test/suite-peg.janet b/test/suite-peg.janet index ac426cfc..59e9353b 100644 --- a/test/suite-peg.janet +++ b/test/suite-peg.janet @@ -713,6 +713,41 @@ "abcdef" @[]) +(test "til: basic matching" + ~(til "d" "abc") + "abcdef" + @[]) + +(test "til: second pattern can't see past the first occurrence of first pattern" + ~(til "d" (* "abc" -1)) + "abcdef" + @[]) + +(test "til: fails if first pattern fails" + ~(til "x" "abc") + "abcdef" + nil) + +(test "til: fails if second pattern fails" + ~(til "abc" "x") + "abcdef" + nil) + +(test "til: discards captures from initial pattern" + ~(til '"d" '"abc") + "abcdef" + @["abc"]) + +(test "til: positions inside second match are still relative to the entire input" + ~(* "one\ntw" (til 0 (* ($) (line) (column)))) + "one\ntwo\nthree\n" + @[6 2 3]) + +(test "til: advances to the end of the first pattern's first occurrence" + ~(* (til "d" "ab") "e") + "abcdef" + @[]) + (test "split: basic functionality" ~(split "," '1) "a,b,c" @@ -772,5 +807,33 @@ "5:apple6:banana6:cherry" @["apple" "banana" "cherry"]) +# Issue #1539 - make sure split with "" doesn't infinite loop/oom +(test "issue 1539" + ~(split "" (capture (to -1))) + "hello there friends" + nil) + +(test "issue 1539 pt. 2" + ~(split "," (capture 0)) + "abc123,,,," + @["" "" "" "" ""]) + +# Issue #1549 - allow buffers as peg literals +(test "issue 1549" + ''@"abc123" + "abc123" + @["abc123"]) + +# Issue 1554 - 0-width match termination behavior +(test "issue 1554 case 1" '(any (> '1)) "abc" @[]) +(test "issue 1554 case 2" '(any (? (> '1))) "abc" @[]) +(test "issue 1554 case 3" '(any (> (? '1))) "abc" @[]) +(test "issue 1554 case 4" '(* "a" (> '1)) "abc" @["b"]) +(test "issue 1554 case 5" '(* "a" (? (> '1))) "abc" @["b"]) +(test "issue 1554 case 6" '(* "a" (> (? '1))) "abc" @["b"]) +(test "issue 1554 case 7" '(between 0 2 (> '1)) "abc" @["a" "a"]) +(test "issue 1554 case 8" '(between 2 3 (? (> '1))) "abc" @["a" "a" "a"]) +(test "issue 1554 case 9" '(between 0 0 (> (? '1))) "abc" @[]) + (end-suite) diff --git a/tools/msi/janet.wxs b/tools/msi/janet.wxs index 9ea2038d..1d2f60d5 100644 --- a/tools/msi/janet.wxs +++ b/tools/msi/janet.wxs @@ -19,6 +19,11 @@ + + + + +