1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-24 19:24:48 +00:00

Compare commits

..

68 Commits

Author SHA1 Message Date
Calvin Rose
7e0c692d4e Remove test-install target from sr.ht 2025-11-15 08:39:47 -06:00
Calvin Rose
732fe0ad03 Try new openbsd. 2025-11-15 08:33:41 -06:00
Calvin Rose
0c8622c803 posix_chroot warning 2025-11-15 08:15:26 -06:00
Calvin Rose
94f2494f8d MSVC warning 2025-11-15 08:14:28 -06:00
Calvin Rose
0f9ecc2da5 Prepare for 1.40.0 release 2025-11-15 07:31:23 -06:00
Calvin Rose
83f5da3b8f Merge pull request #1662 from McSinyx/dobytes-err-ctx
Include context in dobytes' error string
2025-11-09 09:20:23 -06:00
Calvin Rose
9b9f2a1713 Merge pull request #1660 from pyrmont/bugfix.confirm-bundle-files
Clarify error message for missing bundle script during bundle installation
2025-11-09 09:06:06 -06:00
Calvin Rose
8df4d47ede Merge pull request #1663 from McSinyx/dobytes-err-keep
Keep dobytes' error string
2025-11-09 08:40:07 -06:00
Nguyễn Gia Phong
1c372fbf32 Keep dobytes' error string
The reason for failure would be more useful
than the most recently evaluated value.
2025-11-05 17:00:04 +09:00
Nguyễn Gia Phong
8ace580498 Include context in dobytes' error string 2025-11-05 16:53:19 +09:00
Michael Camilleri
8241d9cbb4 Revert support for bundles without an info file 2025-10-27 09:32:38 +09:00
Michael Camilleri
6bd02bb5b6 Confirm necessary files during bundle installation 2025-10-26 06:53:27 +09:00
Calvin Rose
2a3308005d Merge pull request #1659 from ianthehenry/try-macro-hygiene
fix (try) macro hygiene
2025-10-25 12:15:12 -05:00
Ian Henry
0c34033b72 add some tests for the (try) macro 2025-10-24 21:56:07 -07:00
Ian Henry
f1ec0cc48b fix try macro hygiene
Allow re-using the same symbol for the fiber and error. This allows you to
write code like (try (print "hi") ([_ _] (print "oh no"))), fixing a regression
introduced in #1605.
2025-10-24 21:33:15 -07:00
Calvin Rose
98265f0637 Merge pull request #1658 from sogaiu/tweak-has-bin-script 2025-10-17 15:44:50 -05:00
sogaiu
1018cb9cca Support :has-exe as well
This is a companion change to spork's issue

As implemented, :has-been-script didn't quite
mean what was intended.  :has-exe should
be an improvement.

To prevent breakage, both :has-bin-script and
:has-exe should be supported for a while in
both spork and janet.  Eventually
:has-bin-script can be retired.
2025-10-17 22:36:45 +09:00
Calvin Rose
2204209133 Merge pull request #1656 from jpaquim/build-system-consistency
Minor adjustments to Makefile
2025-10-15 07:51:12 -05:00
jpaquim
95abff31d9 Fix file mention in CONTRIBUTING.md 2025-10-11 17:48:23 +01:00
jpaquim
a776466423 Add $(RUN) for valgrind/callgrind, add dedicated callgrind-test target 2025-10-11 17:45:44 +01:00
jpaquim
511c1f4b0a Refactor with image-only variable 2025-10-11 16:32:24 +01:00
jpaquim
c29195596e Adapt generated file comments to build type 2025-10-11 16:29:14 +01:00
jpaquim
56027227fb Add missing phony targets and documentation for install-{jpm,spork}-git 2025-10-11 16:11:05 +01:00
jpaquim
c057e14b20 Fix dependencies and variable names in Makefile 2025-10-11 16:02:02 +01:00
Calvin Rose
db7f741dad Extend environment variable behavior to NO_COLOR and JANET_PROFILE
Env vars set to empty strings should behave the same as unset variables.
2025-10-04 13:12:29 -05:00
Calvin Rose
c901edbfb9 Interpret an empty JANET_PATH as unset
This is a common idiom with environment variables, where
a variable set to the empty string should behave the same as
an unset variable.
2025-10-04 10:43:55 -05:00
Calvin Rose
8fd1672963 Merge pull request #1652 from sogaiu/fix-bundle-install-breakage 2025-09-29 09:53:47 -05:00
sogaiu
9b99fc44b9 Revert some bundle/install changes 2025-09-29 23:45:53 +09:00
Michael Camilleri
f393531335 Add bundle/add-manpage 2025-09-28 19:27:53 -05:00
Michael Camilleri
6b8e5249ca Change :dependencies hook to :postdeps 2025-09-28 19:27:53 -05:00
Michael Camilleri
6a96b615f0 Tidy up bundle/ docstrings 2025-09-28 19:27:53 -05:00
Calvin Rose
8ec465d308 Merge pull request #1651 from neuschaefer/a64be
Recognise aarch64_be as big-endian
2025-09-27 14:29:47 -05:00
J. Neuschäfer
07bfd34c2f Recognise aarch64_be as big-endian 2025-09-26 02:07:09 +00:00
Calvin Rose
5f7878c00f Merge pull request #1649 from jsks/kvs-docstring 2025-09-23 06:42:51 -05:00
Joshua Krusell
aaf8ac2217 Tweak kvs docstring 2025-09-23 11:28:06 +02:00
Calvin Rose
73b1cf547e Update CHANGELOG 2025-09-21 10:26:49 -05:00
Calvin Rose
ed2ae562c6 Merge pull request #1647 from sogaiu/tweak-flycheck-related-docstrings 2025-09-21 00:53:51 -05:00
sogaiu
dd59d84b51 Tweak some flycheck-related docstrings 2025-09-21 14:09:35 +09:00
Calvin Rose
06873fbf0b Update CHANGELOG.md 2025-09-20 14:30:10 -05:00
Calvin Rose
1ff26d702a Refactor flycheck to allow customization. Address #1638
Bindings can define their own flycheckers in a simple fashion.
2025-09-20 10:32:16 -05:00
Calvin Rose
4da568254a Manually declare chroot on macos. 2025-09-19 21:17:02 -05:00
Calvin Rose
357f1f94ca Add os/posix-chroot
Gated in a similar manner to os/posix-fork.
2025-09-19 16:32:45 -05:00
Calvin Rose
015e49c806 Merge pull request #1645 from pyrmont/bugfix.avoid-apc-use
Use `SetEvent` rather than `QueueUserAPC` on Windows
2025-09-19 16:31:13 -05:00
Michael Camilleri
6b06ab5f9c Remove unused function on Windows 2025-09-17 15:51:53 +09:00
Michael Camilleri
fe6c6e15a6 Add workaround to timer resolution issue on Windows 2025-09-17 15:48:37 +09:00
Michael Camilleri
b4eb52ca45 Start worker thread in suspended state on Windows 2025-09-16 11:57:40 +09:00
Michael Camilleri
aca5428846 Use SetEvent rather than QueueUserAPC on Windows 2025-09-16 10:24:24 +09:00
Calvin Rose
3dab9737e2 Fix #1643, but add features.h 2025-09-15 15:33:18 -05:00
Calvin Rose
e601e8faab Merge pull request #1640 from sogaiu/add-some-windows-commentary
Improve windows-related docs and notes
2025-09-15 15:29:38 -05:00
sogaiu
07cf63622f Improve windows-related docs and notes 2025-09-11 14:14:07 +09:00
Calvin Rose
8e7b1e9ce0 Don't try for backwards compat with compiled modules - Address #1639
This guarantee is difficult to maintain and shouldn't be needed.
2025-09-06 10:35:10 -05:00
Calvin Rose
355c514f0e Minor version bump for linking. 2025-09-02 07:08:51 -05:00
Calvin Rose
976329abc1 Update CHANGELOG.md 2025-09-01 15:59:39 -05:00
Calvin Rose
ab3e843433 Add test case for string/format %s of buffer 2025-09-01 14:24:51 -05:00
Calvin Rose
148e108864 Remove strnlen and correctly address #1600 2025-09-01 14:04:30 -05:00
Calvin Rose
c90c737345 Revert reordering 2. 2025-09-01 13:46:09 -05:00
Calvin Rose
13b9976382 Revert reordering of janet_deinit 2025-09-01 13:44:55 -05:00
Calvin Rose
095a81286a Add per-thread finalizer calls in missing places. 2025-09-01 12:38:11 -05:00
Calvin Rose
82416e4e4e Address #1629 - janet_deinit called before threaded channel message sent
to thread.

If we take a reference to another thread inside channel code, make sure
that we increase the refcount to avoid a use after free.
2025-09-01 12:30:29 -05:00
Calvin Rose
ae51434a05 Fix #1604 - Add JANET_DO_ERROR_* defines for failure flags from janet_dobytes. 2025-09-01 09:43:27 -05:00
Calvin Rose
bb6ac423a7 Merge pull request #1637 from jsks/spelling-fixes
Small spelling fixes
2025-08-31 09:32:02 -05:00
Joshua Krusell
c5ba3c0513 Small spelling fixes 2025-08-31 12:14:51 +02:00
Calvin Rose
e9c6678614 Update janet for 1.39.1 2025-08-30 08:11:18 -05:00
Calvin Rose
800457c1bf Update meson.build version. 2025-08-30 08:09:43 -05:00
Calvin Rose
2a85781616 Merge pull request #1632 from jsks/jsks-channel
Export channel utilities
2025-08-30 08:08:55 -05:00
Calvin Rose
7c15e7f7dc Merge pull request #1633 from aeiouaeiouaeiouaeiouaeiouaeiou/janet-legacy-macos1
os.c: use JANET_SPAWN_NO_CHDIR macros for macOS <10.15
2025-08-30 08:08:43 -05:00
aeiouaeiouaeiouaeiouaeiouaeiou
896c28b0c8 os.c: use JANET_SPAWN_NO_CHDIR macros for macOS <10.15
Signed-off-by: aeiouaeiouaeiouaeiouaeiouaeiou <aeioudev@outlook.com>
2025-08-29 13:43:28 +03:00
Joshua Krusell
e7bb0dd58e Export channel utilities 2025-08-29 12:19:53 +02:00
28 changed files with 479 additions and 190 deletions

View File

@@ -1,4 +1,4 @@
image: openbsd/7.6 image: openbsd/7.7
sources: sources:
- https://git.sr.ht/~bakpakin/janet - https://git.sr.ht/~bakpakin/janet
packages: packages:
@@ -10,7 +10,6 @@ tasks:
gmake gmake
gmake test gmake test
doas gmake install doas gmake install
gmake test-install
doas gmake uninstall doas gmake uninstall
- meson_min: | - meson_min: |
cd janet cd janet

View File

@@ -1,6 +1,18 @@
# Changelog # Changelog
All notable changes to this project will be documented in this file. All notable changes to this project will be documented in this file.
## 1.40.0 - 2025-11-15
- Add `os/posix-chroot`
- Fix `ev/deadline` with interrupt race condition bug on Windows.
- Improve `flycheck` by allowing functions and macros to define their own flycheck behavior via the metadata `:flycheck`.
- Add `*flychecking*` dynamic binding to check if inside flycheck evalutation
- Add `gcperthread` callback for abstract types. This lets threaded abstracts have a finalizer that is called per thread, as well as a global finalizer.
- Add `JANET_DO_ERROR_*` flags to describe the return value of `janet_dobytes` and `janet_dostring`.
## 1.39.1 - 2025-08-30
- Add support for chdir in os/spawn on older macOS versions
- Expose channels properly in C API
## 1.39.0 - 2025-08-24 ## 1.39.0 - 2025-08-24
- Various bug fixes - Various bug fixes
- Add `net/socket` - Add `net/socket`

View File

@@ -61,7 +61,7 @@ ensure a consistent code style for C.
## Janet style ## Janet style
All janet code in the project should be formatted similar to the code in core.janet. All janet code in the project should be formatted similar to the code in src/boot/boot.janet.
The auto formatting from janet.vim will work well. The auto formatting from janet.vim will work well.
## Typo Fixing and One-Line changes ## Typo Fixing and One-Line changes

View File

@@ -220,9 +220,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
######################## ########################
ifeq ($(UNAME), Darwin) ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.39.dylib SONAME=libjanet.1.40.dylib
else else
SONAME=libjanet.so.1.39 SONAME=libjanet.so.1.40
endif endif
ifeq ($(MINGW_COMPILER), clang) ifeq ($(MINGW_COMPILER), clang)
@@ -261,6 +261,7 @@ $(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
# Testing assumes HOSTCC=CC # Testing assumes HOSTCC=CC
TEST_SCRIPTS=$(wildcard test/suite*.janet) TEST_SCRIPTS=$(wildcard test/suite*.janet)
EXAMPLE_SCRIPTS=$(wildcard examples/*.janet)
repl: $(JANET_TARGET) repl: $(JANET_TARGET)
$(RUN) ./$(JANET_TARGET) $(RUN) ./$(JANET_TARGET)
@@ -268,21 +269,26 @@ repl: $(JANET_TARGET)
debug: $(JANET_TARGET) debug: $(JANET_TARGET)
$(DEBUGGER) ./$(JANET_TARGET) $(DEBUGGER) ./$(JANET_TARGET)
VALGRIND_COMMAND=valgrind --leak-check=full --quiet VALGRIND_COMMAND=$(RUN) valgrind --leak-check=full --quiet
CALLGRIND_COMMAND=$(RUN) valgrind --tool=callgrind
valgrind: $(JANET_TARGET) valgrind: $(JANET_TARGET)
$(VALGRIND_COMMAND) ./$(JANET_TARGET) $(VALGRIND_COMMAND) ./$(JANET_TARGET)
test: $(JANET_TARGET) $(TEST_PROGRAMS) test: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
for f in test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done for f in test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; done for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; done
valtest: $(JANET_TARGET) $(TEST_PROGRAMS) valtest: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done for f in examples/*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) -k "$$f"; done
callgrind: $(JANET_TARGET) callgrind: $(JANET_TARGET)
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done $(CALLGRIND_COMMAND) ./$(JANET_TARGET)
calltest: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
for f in test/suite*.janet; do $(CALLGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do $(CALLGRIND_COMMAND) ./$(JANET_TARGET) -k "$$f"; done
######################## ########################
##### Distribution ##### ##### Distribution #####
@@ -413,9 +419,6 @@ clean:
-rm -rf build vgcore.* callgrind.* -rm -rf build vgcore.* callgrind.*
-rm -rf test/install/build test/install/modpath -rm -rf test/install/build test/install/modpath
test-install:
echo "JPM has been removed from default install."
help: help:
@echo @echo
@echo 'Janet: A Dynamic Language & Bytecode VM' @echo 'Janet: A Dynamic Language & Bytecode VM'
@@ -427,7 +430,8 @@ help:
@echo ' make test Test a built Janet' @echo ' make test Test a built Janet'
@echo ' make valgrind Assess Janet with Valgrind' @echo ' make valgrind Assess Janet with Valgrind'
@echo ' make callgrind Assess Janet with Valgrind, using Callgrind' @echo ' make callgrind Assess Janet with Valgrind, using Callgrind'
@echo ' make valtest Run the test suite with Valgrind to check for memory leaks' @echo ' make valtest Run the test suite and examples with Valgrind to check for memory leaks'
@echo ' make calltest Run the test suite and examples with Callgrind'
@echo ' make dist Create a distribution tarball' @echo ' make dist Create a distribution tarball'
@echo ' make docs Generate documentation' @echo ' make docs Generate documentation'
@echo ' make debug Run janet with GDB or LLDB' @echo ' make debug Run janet with GDB or LLDB'
@@ -437,6 +441,9 @@ help:
@echo " make format Format Janet's own source files" @echo " make format Format Janet's own source files"
@echo ' make grammar Generate a TextMate language grammar' @echo ' make grammar Generate a TextMate language grammar'
@echo @echo
@echo ' make install-jpm-git Install jpm into the current filesystem'
@echo ' make install-spork-git Install spork into the current filesystem'
@echo
.PHONY: clean install repl debug valgrind test \ .PHONY: clean install install-jpm-git install-spork-git repl debug valgrind test \
valtest dist uninstall docs grammar format help compile-commands valtest callgrind callgrind-test dist uninstall docs grammar format help compile-commands

View File

@@ -49,6 +49,7 @@ for %%f in (src\boot\*.c) do (
) )
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj %JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
@if errorlevel 1 goto :BUILDFAIL @if errorlevel 1 goto :BUILDFAIL
@rem note that there is no default sysroot being baked in
build\janet_boot . > build\c\janet.c build\janet_boot . > build\c\janet.c
@if errorlevel 1 goto :BUILDFAIL @if errorlevel 1 goto :BUILDFAIL

View File

@@ -0,0 +1,3 @@
@{
:name "sample-bad-bundle1"
}

View File

@@ -0,0 +1,3 @@
@{
:name "sample-bad-bundle2"
}

View File

@@ -214,7 +214,7 @@ Don't execute a script, only compile it to check for errors. Useful for linting
.BR \-m\ syspath .BR \-m\ syspath
Set the dynamic binding :syspath to the string syspath so that Janet will load system modules Set the dynamic binding :syspath to the string syspath so that Janet will load system modules
from a directory different than the default. The default is set when Janet is built, and defaults to from a directory different than the default. The default is set when Janet is built, and defaults to
/usr/local/lib/janet on Linux/Posix, and C:/Janet/Library on Windows. This option supersedes JANET_PATH. /usr/local/lib/janet on Linux/Posix. On Windows, there is no default value. This option supersedes JANET_PATH.
.TP .TP
.BR \-c\ source\ output .BR \-c\ source\ output
@@ -255,8 +255,7 @@ and then arguments to the script.
.RS .RS
The location to look for Janet libraries. This is the only environment variable Janet needs to The location to look for Janet libraries. This is the only environment variable Janet needs to
find native and source code modules. If no JANET_PATH is set, Janet will look in find native and source code modules. If no JANET_PATH is set, Janet will look in
the default location set at compile time. This should be a list of as well as a colon the default location set at compile time. This should be a colon-separated list of directory names on Linux/Posix, and a semicolon-separated list on Windows. Note that a typical setup (i.e. not NixOS / Guix) will only use a single directory.
separate list of such directories.
.RE .RE
.B JANET_PROFILE .B JANET_PROFILE

View File

@@ -20,7 +20,7 @@
project('janet', 'c', project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.38.0') version : '1.40.0')
# Global settings # Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -281,6 +281,7 @@ test_files = [
'test/suite-corelib.janet', 'test/suite-corelib.janet',
'test/suite-debug.janet', 'test/suite-debug.janet',
'test/suite-ev.janet', 'test/suite-ev.janet',
'test/suite-ev2.janet',
'test/suite-ffi.janet', 'test/suite-ffi.janet',
'test/suite-filewatch.janet', 'test/suite-filewatch.janet',
'test/suite-inttypes.janet', 'test/suite-inttypes.janet',

View File

@@ -7,7 +7,7 @@
### ###
### ###
(def defn :macro (def defn :macro :flycheck
``` ```
(defn name & more) (defn name & more)
@@ -43,7 +43,7 @@
# Build return value # Build return value
~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start))))) ~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
(defn defmacro :macro (defn defmacro :macro :flycheck
"Define a macro." "Define a macro."
[name & more] [name & more]
(setdyn name @{}) # override old macro definitions in the case of a recursive macro (setdyn name @{}) # override old macro definitions in the case of a recursive macro
@@ -57,12 +57,12 @@
[f & args] [f & args]
(f ;args)) (f ;args))
(defmacro defmacro- (defmacro defmacro- :flycheck
"Define a private macro that will not be exported." "Define a private macro that will not be exported."
[name & more] [name & more]
(apply defn name :macro :private more)) (apply defn name :macro :private more))
(defmacro defn- (defmacro defn- :flycheck
"Define a private function that will not be exported." "Define a private function that will not be exported."
[name & more] [name & more]
(apply defn name :private more)) (apply defn name :private more))
@@ -144,7 +144,7 @@
(defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns))) (defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns)))
(defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns))) (defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns)))
(defmacro assert (defmacro assert :flycheck # should top level assert flycheck?
"Throw an error if x is not truthy. Will not evaluate `err` if x is truthy." "Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
[x &opt err] [x &opt err]
(def v (gensym)) (def v (gensym))
@@ -154,7 +154,7 @@
,v ,v
(,error ,(if err err (string/format "assert failure in %j" x)))))) (,error ,(if err err (string/format "assert failure in %j" x))))))
(defmacro defdyn (defmacro defdyn :flycheck
``Define an alias for a keyword that is used as a dynamic binding. The ``Define an alias for a keyword that is used as a dynamic binding. The
alias is a normal, lexically scoped binding that can be used instead of alias is a normal, lexically scoped binding that can be used instead of
a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise
@@ -171,6 +171,9 @@
(defdyn *macro-form* (defdyn *macro-form*
"Inside a macro, is bound to the source form that invoked the macro") "Inside a macro, is bound to the source form that invoked the macro")
(defdyn *flychecking*
"Check if the current form is being evaluated inside `flycheck`. Will be `true` while flychecking.")
(defdyn *lint-error* (defdyn *lint-error*
"The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.") "The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.")
@@ -345,12 +348,15 @@
[body catch] [body catch]
(assert (and (not (empty? catch)) (indexed? (catch 0))) "the first element of `catch` must be a tuple or array") (assert (and (not (empty? catch)) (indexed? (catch 0))) "the first element of `catch` must be a tuple or array")
(let [[err fib] (catch 0) (let [[err fib] (catch 0)
r (or err (gensym)) r (gensym)
f (or fib (gensym))] f (gensym)]
~(let [,f (,fiber/new (fn :try [] ,body) :ie) ~(let [,f (,fiber/new (fn :try [] ,body) :ie)
,r (,resume ,f)] ,r (,resume ,f)]
(if (,= (,fiber/status ,f) :error) (if (,= (,fiber/status ,f) :error)
(do ,;(tuple/slice catch 1)) (do
,(if err ~(def ,err ,r))
,(if fib ~(def ,fib ,f))
,;(tuple/slice catch 1))
,r)))) ,r))))
(defmacro with-syms (defmacro with-syms
@@ -1800,8 +1806,8 @@
(flatten-into @[] xs)) (flatten-into @[] xs))
(defn kvs (defn kvs
``Takes a table or struct and returns and array of key value pairs ``Takes a table or struct and returns a new array of key value pairs
like `@[k v k v ...]`. Returns a new array.`` like `@[k v k v ...]`.``
[dict] [dict]
(def ret @[]) (def ret @[])
(loop [k :keys dict] (array/push ret k (in dict k))) (loop [k :keys dict] (array/push ret k (in dict k)))
@@ -2354,7 +2360,7 @@
(set macexvar macex) (set macexvar macex)
(defmacro varfn (defmacro varfn :flycheck
``Create a function that can be rebound. `varfn` has the same signature ``Create a function that can be rebound. `varfn` has the same signature
as `defn`, but defines functions in the environment as vars. If a var `name` as `defn`, but defines functions in the environment as vars. If a var `name`
already exists in the environment, it is rebound to the new function. Returns already exists in the environment, it is rebound to the new function. Returns
@@ -3945,7 +3951,7 @@
[& forms] [& forms]
(def state (gensym)) (def state (gensym))
(def loaded (gensym)) (def loaded (gensym))
~((fn [] ~((fn :delay []
(var ,state nil) (var ,state nil)
(var ,loaded nil) (var ,loaded nil)
(fn [] (fn []
@@ -3977,7 +3983,7 @@
:lazy lazy :lazy lazy
:map-symbols map-symbols})) :map-symbols map-symbols}))
(defmacro ffi/defbind-alias (defmacro ffi/defbind-alias :flycheck
"Generate bindings for native functions in a convenient manner. "Generate bindings for native functions in a convenient manner.
Similar to defbind but allows for the janet function name to be Similar to defbind but allows for the janet function name to be
different than the FFI function." different than the FFI function."
@@ -3988,6 +3994,8 @@
(def formal-args (map 0 arg-pairs)) (def formal-args (map 0 arg-pairs))
(def type-args (map 1 arg-pairs)) (def type-args (map 1 arg-pairs))
(def computed-type-args (eval ~[,;type-args])) (def computed-type-args (eval ~[,;type-args]))
(if (dyn *flychecking*)
(break ~(defn ,alias ,;meta [,;formal-args] nil)))
(def {:native lib (def {:native lib
:lazy lazy :lazy lazy
:native-lazy llib :native-lazy llib
@@ -4003,7 +4011,7 @@
~(defn ,alias ,;meta [,;formal-args] ~(defn ,alias ,;meta [,;formal-args]
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))) (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
(defmacro ffi/defbind (defmacro ffi/defbind :flycheck
"Generate bindings for native functions in a convenient manner." "Generate bindings for native functions in a convenient manner."
[name ret-type & body] [name ret-type & body]
~(ffi/defbind-alias ,name ,name ,ret-type ,;body))) ~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
@@ -4014,6 +4022,51 @@
### ###
### ###
(def- flycheck-specials @{})
(defn- flycheck-evaluator
``
An evaluator function that is passed to `run-context` that lints
(flychecks) code for `flycheck`. This means code will be parsed,
compiled, and have macros expanded, but the code will not be
evaluated.
``
[thunk source env where]
(when (and (tuple? source) (= (tuple/type source) :parens))
(def head (source 0))
(def entry (get env head {}))
(def fc (get flycheck-specials head (get entry :flycheck)))
(cond
# Sometimes safe form
(function? fc)
(fc thunk source env where)
# Always safe form
fc
(thunk))))
(defn flycheck
```
Check a file for errors without running the file. Found errors
will be printed to stderr in the usual format. Top level functions
and macros that have the metadata `:flycheck` will also be evaluated
during flychecking. For full control, the `:flycheck` metadata can
also be a function that takes 4 arguments - `thunk`, `source`, `env`,
and `where`, the same as the `:evaluator` argument to `run-context`.
Other arguments to `flycheck` are the same as `dofile`. Returns nil.
```
[path &keys kwargs]
(def mc @{})
(def new-env (make-env (get kwargs :env)))
(put new-env *flychecking* true)
(put new-env *module-cache* @{})
(put new-env *module-loading* @{})
(put new-env *module-make-env* (fn :make-flycheck-env [&] (make-env new-env)))
(try
(dofile path :evaluator flycheck-evaluator ;(kvs kwargs) :env new-env)
([e f]
(debug/stacktrace f e "")))
nil)
(defn- no-side-effects (defn- no-side-effects
`Check if form may have side effects. If returns true, then the src `Check if form may have side effects. If returns true, then the src
must not have side effects, such as calling a C function.` must not have side effects, such as calling a C function.`
@@ -4029,59 +4082,29 @@
(all no-side-effects (values src))) (all no-side-effects (values src)))
true)) true))
(defn- is-safe-def [x] (no-side-effects (last x))) (defn- is-safe-def [thunk source env where]
(if (no-side-effects (last source))
(thunk)))
(def- safe-forms {'defn true 'varfn true 'defn- true 'defmacro true 'defmacro- true (defn- flycheck-importer
'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def
'defglobal is-safe-def 'varglobal is-safe-def 'defdyn true})
(def- importers {'import true 'import* true 'dofile true 'require true})
(defn- use-2 [evaluator args]
(each a args (import* (string a) :prefix "" :evaluator evaluator)))
(defn- flycheck-evaluator
``An evaluator function that is passed to `run-context` that lints (flychecks) code.
This means code will parsed and compiled, macros executed, but the code will not be run.
Used by `flycheck`.``
[thunk source env where] [thunk source env where]
(when (tuple? source)
(def head (source 0))
(def safe-check
(or
(safe-forms head)
(if (symbol? head)
(if (string/has-prefix? "define-" head) is-safe-def))))
(cond
# Sometimes safe form
(function? safe-check)
(if (safe-check source) (thunk))
# Always safe form
safe-check
(thunk)
# Use
(= 'use head)
(use-2 flycheck-evaluator (tuple/slice source 1))
# Import-like form
(importers head)
(let [[l c] (tuple/sourcemap source) (let [[l c] (tuple/sourcemap source)
newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)] newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)]
((compile newtup env where)))))) ((compile newtup env where))))
(defn flycheck (defn- flycheck-use
``Check a file for errors without running the file. Found errors will be printed to stderr [thunk source env where]
in the usual format. Macros will still be executed, however, so (each a (drop 1 source) (import* (string a) :prefix "" :evaluator flycheck-evaluator)))
arbitrary execution is possible. Other arguments are the same as `dofile`. `path` can also be
a file value such as stdin. Returns nil.`` # Add metadata to defs and import macros for flychecking
[path &keys kwargs] (each sym ['def 'var]
(def old-modcache (table/clone module/cache)) (put flycheck-specials sym is-safe-def))
(table/clear module/cache) (each sym ['def- 'var- 'defglobal 'varglobal]
(try (put (dyn sym) :flycheck is-safe-def))
(dofile path :evaluator flycheck-evaluator ;(kvs kwargs)) (each sym ['import 'import* 'dofile 'require]
([e f] (put (dyn sym) :flycheck flycheck-importer))
(debug/stacktrace f e ""))) (each sym ['use]
(table/clear module/cache) (put (dyn sym) :flycheck flycheck-use))
(merge-into module/cache old-modcache)
nil)
### ###
### ###
@@ -4174,7 +4197,7 @@
(spit manifest-name b)) (spit manifest-name b))
(defn bundle/manifest (defn bundle/manifest
"Get the manifest for a give installed bundle" "Get the manifest for a given installed bundle."
[bundle-name] [bundle-name]
(def name (get-manifest-filename bundle-name)) (def name (get-manifest-filename bundle-name))
(assertf (fexists name) "no bundle %v found" bundle-name) (assertf (fexists name) "no bundle %v found" bundle-name)
@@ -4199,7 +4222,9 @@
(put new-env *syspath* fixed-syspath) (put new-env *syspath* fixed-syspath)
(with-env new-env (with-env new-env
(put new-env :bundle-dir (bundle-dir bundle-name)) # get the syspath right (put new-env :bundle-dir (bundle-dir bundle-name)) # get the syspath right
(require (string "@syspath/bundle/" bundle-name))))) (try
(require (string "@syspath/bundle/" bundle-name))
([_] (error "bundle must contain bundle.janet or bundle/init.janet"))))))
(defn- do-hook (defn- do-hook
[module bundle-name hook & args] [module bundle-name hook & args]
@@ -4236,7 +4261,9 @@
nil) nil)
(defn bundle/uninstall (defn bundle/uninstall
"Remove a bundle from the current syspath" ``Remove a bundle from the current syspath. There is 1 hook called during
uninstallation (uninstall). A user can register a hook by defining a
function with the same name in the bundle script.``
[bundle-name] [bundle-name]
(def breakage @{}) (def breakage @{})
(each b (bundle/list) (each b (bundle/list)
@@ -4272,8 +4299,8 @@
order) order)
(defn bundle/prune (defn bundle/prune
"Remove all orphaned bundles from the syspath. An orphaned bundle is a bundle that is ``Remove all orphaned bundles from the current syspath. An orphaned bundle is a
marked for :auto-remove and is not depended on by any other bundle." bundle that is marked for :auto-remove and is not depended on by any other bundle.``
[] []
(def topo (bundle/topolist)) (def topo (bundle/topolist))
(def rtopo (reverse topo)) (def rtopo (reverse topo))
@@ -4302,33 +4329,44 @@
(not (not (os/stat (bundle-dir bundle-name) :mode)))) (not (not (os/stat (bundle-dir bundle-name) :mode))))
(defn bundle/install (defn bundle/install
"Install a bundle from the local filesystem. The name of the bundle will be inferred from the bundle, or passed as a parameter :name in `config`." ``Install a bundle from the local filesystem. The name of the bundle is
the value mapped to :name in either `config` or the info file. There are
5 hooks called during installation (postdeps, clean, build, install and
check). A user can register a hook by defining a function with the same name
in the bundle script.``
[path &keys config] [path &keys config]
(def path (bundle-rpath path)) (def path (bundle-rpath path))
(def s (sep)) (def s (sep))
# Detect bundle name # Detect bundle name
(def infofile-src1 (string path s "bundle" s "info.jdn")) (def infofile-src1 (string path s "bundle" s "info.jdn"))
(def infofile-src2 (string path s "info.jdn")) (def infofile-src2 (string path s "info.jdn"))
(def infofile-src (cond (fexists infofile-src1) infofile-src1 (def infofile-src (cond
(fexists infofile-src1) infofile-src1
(fexists infofile-src2) infofile-src2)) (fexists infofile-src2) infofile-src2))
(def info (-?> infofile-src slurp parse)) (def info (-?> infofile-src slurp parse))
(def bundle-name (get config :name (get info :name))) (def bundle-name (get config :name (get info :name)))
(assertf bundle-name "unable to infer bundle name for %v, use :name argument" path) (assertf bundle-name
"unable to infer bundle name for %v, use :name argument or add :name to info file" path)
(assertf (not (string/check-set "\\/" bundle-name)) (assertf (not (string/check-set "\\/" bundle-name))
"bundle name %v cannot contain path separators" bundle-name) "bundle name %v cannot contain path separators" bundle-name)
(assert (next bundle-name) "cannot use empty bundle-name") (assert (next bundle-name) "cannot use empty bundle-name")
(assertf (not (fexists (get-manifest-filename bundle-name))) (assertf (not (fexists (get-manifest-filename bundle-name)))
"bundle %v is already installed" bundle-name) "bundle %v is already installed" bundle-name)
# Check bscript
(def bscript-src1 (string path s "bundle" s "init.janet"))
(def bscript-src2 (string path s "bundle.janet"))
(def bscript-src (cond
(fexists bscript-src1) bscript-src1
(fexists bscript-src2) bscript-src2))
# Setup installed paths # Setup installed paths
(prime-bundle-paths) (prime-bundle-paths)
(os/mkdir (bundle-dir bundle-name)) (os/mkdir (bundle-dir bundle-name))
# Copy infofile # Copy aliased infofile
(def infofile-dest (bundle-file bundle-name "info.jdn")) (when (fexists infofile-src2)
(when infofile-src (copyfile infofile-src infofile-dest)) (copyfile infofile-src2 (bundle-file bundle-name "info.jdn")))
# Copy aliased initfile # Copy aliased bscript
(def initfile-alias (string path s "bundle.janet")) (when (fexists bscript-src2)
(def initfile-dest (bundle-file bundle-name "init.janet")) (copyfile bscript-src2 (bundle-file bundle-name "init.janet")))
(when (fexists initfile-alias) (copyfile initfile-alias initfile-dest))
# Copy some files into the new location unconditionally # Copy some files into the new location unconditionally
(def implicit-sources (string path s "bundle")) (def implicit-sources (string path s "bundle"))
(when (= :directory (os/stat implicit-sources :mode)) (when (= :directory (os/stat implicit-sources :mode))
@@ -4337,8 +4375,7 @@
(merge-into man config) (merge-into man config)
(sync-manifest man) (sync-manifest man)
(edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name))
(when (os/stat infofile-dest :mode) (when info
(def info (-> infofile-dest slurp parse))
(def deps (seq [d :in (get info :dependencies @[])] (def deps (seq [d :in (get info :dependencies @[])]
(string (if (dictionary? d) (get d :name) d)))) (string (if (dictionary? d) (get d :name) d))))
(def missing (filter (complement bundle/installed?) deps)) (def missing (filter (complement bundle/installed?) deps))
@@ -4346,12 +4383,13 @@
(error (string "missing dependencies " (string/join missing ", ")))) (error (string "missing dependencies " (string/join missing ", "))))
(put man :dependencies deps) (put man :dependencies deps)
(put man :info info)) (put man :info info))
(def module (get-bundle-module bundle-name))
(def clean (get config :clean)) (def clean (get config :clean))
(def check (get config :check)) (def check (get config :check))
(def module (get-bundle-module bundle-name))
(def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k))) (def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k)))
(put man :hooks all-hooks) (put man :hooks all-hooks)
(do-hook module bundle-name :dependencies man) (do-hook module bundle-name :dependencies man) # deprecated, use :postdeps
(do-hook module bundle-name :postdeps man)
(when clean (when clean
(do-hook module bundle-name :clean man)) (do-hook module bundle-name :clean man))
(do-hook module bundle-name :build man) (do-hook module bundle-name :build man)
@@ -4361,15 +4399,21 @@
(when check (when check
(do-hook module bundle-name :check man))) (do-hook module bundle-name :check man)))
(print "installed " bundle-name) (print "installed " bundle-name)
(when (get man :has-bin-script) (when (or (get man :has-exe)
# remove eventually
(get man :has-bin-script))
(def binpath (string (dyn *syspath*) s "bin")) (def binpath (string (dyn *syspath*) s "bin"))
(eprintf "executable scripts have been installed to %s" binpath)) (eprintf "executable files have been installed to %s" binpath))
(when (get man :has-man)
(def manpath (string (dyn *syspath*) s "man"))
(eprintf "man pages have been installed to %s" manpath))
bundle-name) bundle-name)
(defn- bundle/pack (defn- bundle/pack
"Take an installed bundle and create a bundle source directory that can be used to ``Take an installed bundle and create a bundle source directory that can be
reinstall the bundle on a compatible system. This is used to create backups for installed used to reinstall the bundle on a compatible system. This is used to create
bundles without rebuilding, or make a prebuilt bundle for other systems." backups for installed bundles without rebuilding, or make a prebuilt bundle
for other systems.``
[bundle-name dest-dir &opt is-backup] [bundle-name dest-dir &opt is-backup]
(var i 0) (var i 0)
(def man (bundle/manifest bundle-name)) (def man (bundle/manifest bundle-name))
@@ -4399,9 +4443,9 @@
dest-dir) dest-dir)
(defn bundle/replace (defn bundle/replace
"Reinstall an existing bundle from a new directory. Similar to bundle/reinstall, ``Reinstall an existing bundle from a new directory. Similar to
but installs the replacement bundle from any directory. This is necesarry to replace a package without bundle/reinstall, but installs the replacement bundle from any directory.
breaking any dependencies." This is necessary to replace a package without breaking any dependencies.``
[bundle-name path &keys new-config] [bundle-name path &keys new-config]
(def manifest (bundle/manifest bundle-name)) (def manifest (bundle/manifest bundle-name))
(def config (get manifest :config @{})) (def config (get manifest :config @{}))
@@ -4428,7 +4472,7 @@
bundle-name) bundle-name)
(defn bundle/add-directory (defn bundle/add-directory
"Add a directory during the install process relative to `(dyn *syspath*)`" "Add a directory during an install relative to `(dyn *syspath*)`."
[manifest dest &opt chmod-mode] [manifest dest &opt chmod-mode]
(def files (get-files manifest)) (def files (get-files manifest))
(def s (sep)) (def s (sep))
@@ -4456,7 +4500,7 @@
ret) ret)
(defn bundle/add-file (defn bundle/add-file
"Add files during an install relative to `(dyn *syspath*)`" "Add a file during an install relative to `(dyn *syspath*)`."
[manifest src &opt dest chmod-mode] [manifest src &opt dest chmod-mode]
(default dest src) (default dest src)
(def files (get-files manifest)) (def files (get-files manifest))
@@ -4473,9 +4517,9 @@
absdest) absdest)
(defn bundle/add (defn bundle/add
"Add files and directories during a bundle install relative to `(dyn *syspath*)`. ``Add a file or directory during an install relative to `(dyn *syspath*)`.
Added files and directories will be recorded in the bundle manifest such that they are properly tracked Added files and directories will be recorded in the bundle manifest such
and removed during an upgrade or uninstall." that they are properly tracked and removed during an upgrade or uninstall.``
[manifest src &opt dest chmod-mode] [manifest src &opt dest chmod-mode]
(default dest src) (default dest src)
(def s (sep)) (def s (sep))
@@ -4490,20 +4534,31 @@
(errorf "bad path %s - file is a %s" src mode))) (errorf "bad path %s - file is a %s" src mode)))
(defn bundle/add-bin (defn bundle/add-bin
`` ``Add a file to the "bin" subdirectory of the current syspath. By default,
Shorthand for adding scripts during an install. Scripts will be installed to files will be set to be executable.``
`(string (dyn *syspath*) "/bin")` by default and will be set to be executable. [manifest src &opt filename chmod-mode]
``
[manifest src &opt dest chmod-mode]
(def s (sep)) (def s (sep))
(default dest (last (string/split s src))) (default filename (last (string/split s src)))
(default chmod-mode 8r755) (default chmod-mode 8r755)
(os/mkdir (string (dyn *syspath*) s "bin")) (os/mkdir (string (dyn *syspath*) s "bin"))
(put manifest :has-bin-script true) (put manifest :has-exe true)
(bundle/add-file manifest src (string "bin" s dest) chmod-mode)) (put manifest :has-bin-script true) # remove eventually
(bundle/add-file manifest src (string "bin" s filename) chmod-mode))
(defn bundle/add-manpage
``Add a file to the man subdirectory of the current syspath. Files are
copied inside a directory `mansec`. By default, `mansec` is "man1".``
[manifest src &opt mansec]
(def s (sep))
(default mansec "man1")
(def filename (last (string/split s src)))
(os/mkdir (string (dyn *syspath*) s "man"))
(os/mkdir (string (dyn *syspath*) s "man" s mansec))
(put manifest :has-man true)
(bundle/add-file manifest src (string "man" s mansec s filename)))
(defn bundle/update-all (defn bundle/update-all
"Reinstall all bundles" "Reinstall all bundles."
[&keys configs] [&keys configs]
(each bundle (bundle/topolist) (each bundle (bundle/topolist)
(bundle/reinstall bundle ;(kvs configs))))) (bundle/reinstall bundle ;(kvs configs)))))
@@ -4515,7 +4570,10 @@
### ###
# conditional compilation for reduced os # conditional compilation for reduced os
(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&]))) (def- getenv-raw (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
(defn- getenv-alias [env-var &opt dflt]
(def x (getenv-raw env-var dflt))
(if (= x "") nil x)) # empty string is coerced to nil
(defn- run-main (defn- run-main
[env subargs arg] [env subargs arg]
@@ -4638,7 +4696,7 @@
--reinstall (-B) name : Reinstall a bundle by bundle name --reinstall (-B) name : Reinstall a bundle by bundle name
--uninstall (-u) name : Uninstall a bundle by bundle name --uninstall (-u) name : Uninstall a bundle by bundle name
--update-all (-U) : Reinstall all installed bundles --update-all (-U) : Reinstall all installed bundles
--prune (-P) : Uninstalled all bundles that are orphaned --prune (-P) : Uninstall all bundles that are orphaned
--list (-L) : List all installed bundles --list (-L) : List all installed bundles
-- : Stop handling options -- : Stop handling options
```) ```)
@@ -4890,14 +4948,15 @@
"src/core/wrap.c"]) "src/core/wrap.c"])
# Print janet.c to stdout # Print janet.c to stdout
(print "/* Amalgamated build - DO NOT EDIT */") (def image-only (has-value? boot/args "image-only"))
(print "/* " (if image-only "Image-only" "Amalgamated") " build - DO NOT EDIT */")
(print "/* Generated from janet version " janet/version "-" janet/build " */") (print "/* Generated from janet version " janet/version "-" janet/build " */")
(print "#define JANET_BUILD \"" janet/build "\"") (print "#define JANET_BUILD \"" janet/build "\"")
(print ```#define JANET_AMALG```) (print ```#define JANET_AMALG```)
(defn do-one-file (defn do-one-file
[fname] [fname]
(unless (has-value? boot/args "image-only") (unless image-only
(print "\n/* " fname " */") (print "\n/* " fname " */")
(print "#line 0 \"" fname "\"\n") (print "#line 0 \"" fname "\"\n")
(def source (slurp fname)) (def source (slurp fname))

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H #define JANETCONF_H
#define JANET_VERSION_MAJOR 1 #define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 39 #define JANET_VERSION_MINOR 40
#define JANET_VERSION_PATCH 0 #define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA "" #define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.39.0" #define JANET_VERSION "1.40.0"
/* #define JANET_BUILD "local" */ /* #define JANET_BUILD "local" */

View File

@@ -66,7 +66,7 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
JanetBuildConfig modconf = getter(); JanetBuildConfig modconf = getter();
JanetBuildConfig host = janet_config_current(); JanetBuildConfig host = janet_config_current();
if (host.major != modconf.major || if (host.major != modconf.major ||
host.minor < modconf.minor || host.minor != modconf.minor ||
host.bits != modconf.bits) { host.bits != modconf.bits) {
char errbuf[128]; char errbuf[128];
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)", snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
@@ -746,6 +746,7 @@ typedef struct SandboxOption {
static const SandboxOption sandbox_options[] = { static const SandboxOption sandbox_options[] = {
{"all", JANET_SANDBOX_ALL}, {"all", JANET_SANDBOX_ALL},
{"chroot", JANET_SANDBOX_CHROOT},
{"env", JANET_SANDBOX_ENV}, {"env", JANET_SANDBOX_ENV},
{"ffi", JANET_SANDBOX_FFI}, {"ffi", JANET_SANDBOX_FFI},
{"ffi-define", JANET_SANDBOX_FFI_DEFINE}, {"ffi-define", JANET_SANDBOX_FFI_DEFINE},
@@ -771,6 +772,7 @@ JANET_CORE_FN(janet_core_sandbox,
"Disable feature sets to prevent the interpreter from using certain system resources. " "Disable feature sets to prevent the interpreter from using certain system resources. "
"Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n" "Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n" "* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
"* :chroot - disallow calling `os/posix-chroot`\n"
"* :env - disallow reading and write env variables\n" "* :env - disallow reading and write env variables\n"
"* :ffi - disallow FFI (recommended if disabling anything else)\n" "* :ffi - disallow FFI (recommended if disabling anything else)\n"
"* :ffi-define - disallow loading new FFI modules and binding new functions\n" "* :ffi-define - disallow loading new FFI modules and binding new functions\n"

View File

@@ -117,6 +117,9 @@ typedef struct {
double sec; double sec;
JanetVM *vm; JanetVM *vm;
JanetFiber *fiber; JanetFiber *fiber;
#ifdef JANET_WINDOWS
HANDLE cancel_event;
#endif
} JanetThreadedTimeout; } JanetThreadedTimeout;
#define JANET_MAX_Q_CAPACITY 0x7FFFFFF #define JANET_MAX_Q_CAPACITY 0x7FFFFFF
@@ -604,12 +607,7 @@ void janet_ev_init_common(void) {
#endif #endif
} }
#ifdef JANET_WINDOWS #if JANET_ANDROID
static VOID CALLBACK janet_timeout_stop(ULONG_PTR ptr) {
UNREFERENCED_PARAMETER(ptr);
ExitThread(0);
}
#elif JANET_ANDROID
static void janet_timeout_stop(int sig_num) { static void janet_timeout_stop(int sig_num) {
if (sig_num == SIGUSR1) { if (sig_num == SIGUSR1) {
pthread_exit(0); pthread_exit(0);
@@ -620,10 +618,14 @@ static void janet_timeout_stop(int sig_num) {
static void handle_timeout_worker(JanetTimeout to, int cancel) { static void handle_timeout_worker(JanetTimeout to, int cancel) {
if (!to.has_worker) return; if (!to.has_worker) return;
#ifdef JANET_WINDOWS #ifdef JANET_WINDOWS
(void) cancel; if (cancel && to.worker_event) {
QueueUserAPC(janet_timeout_stop, to.worker, 0); SetEvent(to.worker_event);
}
WaitForSingleObject(to.worker, INFINITE); WaitForSingleObject(to.worker, INFINITE);
CloseHandle(to.worker); CloseHandle(to.worker);
if (to.worker_event) {
CloseHandle(to.worker_event);
}
#else #else
#ifdef JANET_ANDROID #ifdef JANET_ANDROID
if (cancel) janet_assert(!pthread_kill(to.worker, SIGUSR1), "pthread_kill"); if (cancel) janet_assert(!pthread_kill(to.worker, SIGUSR1), "pthread_kill");
@@ -693,10 +695,20 @@ static void janet_timeout_cb(JanetEVGenericMessage msg) {
static DWORD WINAPI janet_timeout_body(LPVOID ptr) { static DWORD WINAPI janet_timeout_body(LPVOID ptr) {
JanetThreadedTimeout tto = *(JanetThreadedTimeout *)ptr; JanetThreadedTimeout tto = *(JanetThreadedTimeout *)ptr;
janet_free(ptr); janet_free(ptr);
SleepEx((DWORD)(tto.sec * 1000), TRUE); JanetTimestamp wait_begin = ts_now();
DWORD duration = (DWORD)round(tto.sec * 1000);
DWORD res = WAIT_TIMEOUT;
JanetTimestamp wait_end = ts_now();
for (DWORD i = 1; res == WAIT_TIMEOUT && (wait_end - wait_begin) < duration; i++) {
res = WaitForSingleObject(tto.cancel_event, (duration + i));
wait_end = ts_now();
}
/* only send interrupt message if result is WAIT_TIMEOUT */
if (res == WAIT_TIMEOUT) {
janet_interpreter_interrupt(tto.vm); janet_interpreter_interrupt(tto.vm);
JanetEVGenericMessage msg = {0}; JanetEVGenericMessage msg = {0};
janet_ev_post_event(tto.vm, janet_timeout_cb, msg); janet_ev_post_event(tto.vm, janet_timeout_cb, msg);
}
return 0; return 0;
} }
#else #else
@@ -839,6 +851,34 @@ static int janet_chanat_gc(void *p, size_t s) {
return 0; return 0;
} }
static void janet_chanat_remove_vmref(JanetQueue *fq) {
JanetChannelPending *pending = fq->data;
if (fq->head <= fq->tail) {
for (int32_t i = fq->head; i < fq->tail; i++) {
if (pending[i].thread == &janet_vm) pending[i].thread = NULL;
}
} else {
for (int32_t i = fq->head; i < fq->capacity; i++) {
if (pending[i].thread == &janet_vm) pending[i].thread = NULL;
}
for (int32_t i = 0; i < fq->tail; i++) {
if (pending[i].thread == &janet_vm) pending[i].thread = NULL;
}
}
}
static int janet_chanat_gcperthread(void *p, size_t s) {
(void) s;
JanetChannel *chan = p;
janet_chan_lock(chan);
/* Make sure that the internals of the threaded channel no longer reference _this_ thread. Replace
* those references with NULL. */
janet_chanat_remove_vmref(&chan->read_pending);
janet_chanat_remove_vmref(&chan->write_pending);
janet_chan_unlock(chan);
return 0;
}
static void janet_chanat_mark_fq(JanetQueue *fq) { static void janet_chanat_mark_fq(JanetQueue *fq) {
JanetChannelPending *pending = fq->data; JanetChannelPending *pending = fq->data;
if (fq->head <= fq->tail) { if (fq->head <= fq->tail) {
@@ -921,8 +961,9 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
int is_read = (mode == JANET_CP_MODE_CHOICE_READ) || (mode == JANET_CP_MODE_READ); int is_read = (mode == JANET_CP_MODE_CHOICE_READ) || (mode == JANET_CP_MODE_READ);
if (is_read) { if (is_read) {
JanetChannelPending reader; JanetChannelPending reader;
if (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) { while (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) {
JanetVM *vm = reader.thread; JanetVM *vm = reader.thread;
if (!vm) continue;
JanetEVGenericMessage msg; JanetEVGenericMessage msg;
msg.tag = reader.mode; msg.tag = reader.mode;
msg.fiber = reader.fiber; msg.fiber = reader.fiber;
@@ -930,11 +971,13 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
msg.argp = channel; msg.argp = channel;
msg.argj = x; msg.argj = x;
janet_ev_post_event(vm, janet_thread_chan_cb, msg); janet_ev_post_event(vm, janet_thread_chan_cb, msg);
break;
} }
} else { } else {
JanetChannelPending writer; JanetChannelPending writer;
if (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) { while (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) {
JanetVM *vm = writer.thread; JanetVM *vm = writer.thread;
if (!vm) continue;
JanetEVGenericMessage msg; JanetEVGenericMessage msg;
msg.tag = writer.mode; msg.tag = writer.mode;
msg.fiber = writer.fiber; msg.fiber = writer.fiber;
@@ -942,6 +985,7 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
msg.argp = channel; msg.argp = channel;
msg.argj = janet_wrap_nil(); msg.argj = janet_wrap_nil();
janet_ev_post_event(vm, janet_thread_chan_cb, msg); janet_ev_post_event(vm, janet_thread_chan_cb, msg);
break;
} }
} }
} }
@@ -1005,7 +1049,9 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode
msg.argi = (int32_t) reader.sched_id; msg.argi = (int32_t) reader.sched_id;
msg.argp = channel; msg.argp = channel;
msg.argj = x; msg.argj = x;
if (vm) {
janet_ev_post_event(vm, janet_thread_chan_cb, msg); janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
} else { } else {
if (reader.mode == JANET_CP_MODE_CHOICE_READ) { if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
janet_schedule(reader.fiber, make_read_result(channel, x)); janet_schedule(reader.fiber, make_read_result(channel, x));
@@ -1060,7 +1106,9 @@ static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int i
msg.argi = (int32_t) writer.sched_id; msg.argi = (int32_t) writer.sched_id;
msg.argp = channel; msg.argp = channel;
msg.argj = janet_wrap_nil(); msg.argj = janet_wrap_nil();
if (vm) {
janet_ev_post_event(vm, janet_thread_chan_cb, msg); janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
} else { } else {
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) { if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
janet_schedule(writer.fiber, make_write_result(channel)); janet_schedule(writer.fiber, make_write_result(channel));
@@ -1324,7 +1372,9 @@ JANET_CORE_FN(cfun_channel_close,
msg.tag = JANET_CP_MODE_CLOSE; msg.tag = JANET_CP_MODE_CLOSE;
msg.argi = (int32_t) writer.sched_id; msg.argi = (int32_t) writer.sched_id;
msg.argj = janet_wrap_nil(); msg.argj = janet_wrap_nil();
if (vm) {
janet_ev_post_event(vm, janet_thread_chan_cb, msg); janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
} else { } else {
if (janet_fiber_can_resume(writer.fiber)) { if (janet_fiber_can_resume(writer.fiber)) {
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) { if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
@@ -1345,7 +1395,9 @@ JANET_CORE_FN(cfun_channel_close,
msg.tag = JANET_CP_MODE_CLOSE; msg.tag = JANET_CP_MODE_CLOSE;
msg.argi = (int32_t) reader.sched_id; msg.argi = (int32_t) reader.sched_id;
msg.argj = janet_wrap_nil(); msg.argj = janet_wrap_nil();
if (vm) {
janet_ev_post_event(vm, janet_thread_chan_cb, msg); janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
} else { } else {
if (janet_fiber_can_resume(reader.fiber)) { if (janet_fiber_can_resume(reader.fiber)) {
if (reader.mode == JANET_CP_MODE_CHOICE_READ) { if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
@@ -1438,7 +1490,10 @@ const JanetAbstractType janet_channel_type = {
NULL, /* compare */ NULL, /* compare */
NULL, /* hash */ NULL, /* hash */
janet_chanat_next, janet_chanat_next,
JANET_ATEND_NEXT NULL, /* call */
NULL, /* length */
NULL, /* bytes */
janet_chanat_gcperthread
}; };
/* Main event loop */ /* Main event loop */
@@ -2175,7 +2230,7 @@ void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGenericMessage ms
event.cb = cb; event.cb = cb;
int fd = vm->selfpipe[1]; int fd = vm->selfpipe[1];
/* handle a bit of back pressure before giving up. */ /* handle a bit of back pressure before giving up. */
int tries = 4; int tries = 20;
while (tries > 0) { while (tries > 0) {
int status; int status;
do { do {
@@ -3227,7 +3282,13 @@ JANET_CORE_FN(cfun_ev_deadline,
tto->vm = &janet_vm; tto->vm = &janet_vm;
tto->fiber = tocheck; tto->fiber = tocheck;
#ifdef JANET_WINDOWS #ifdef JANET_WINDOWS
HANDLE worker = CreateThread(NULL, 0, janet_timeout_body, tto, 0, NULL); HANDLE cancel_event = CreateEvent(NULL, TRUE, FALSE, NULL);
if (NULL == cancel_event) {
janet_free(tto);
janet_panic("failed to create cancel event");
}
tto->cancel_event = cancel_event;
HANDLE worker = CreateThread(NULL, 0, janet_timeout_body, tto, CREATE_SUSPENDED, NULL);
if (NULL == worker) { if (NULL == worker) {
janet_free(tto); janet_free(tto);
janet_panic("failed to create thread"); janet_panic("failed to create thread");
@@ -3242,6 +3303,10 @@ JANET_CORE_FN(cfun_ev_deadline,
#endif #endif
to.has_worker = 1; to.has_worker = 1;
to.worker = worker; to.worker = worker;
#ifdef JANET_WINDOWS
to.worker_event = cancel_event;
ResumeThread(worker);
#endif
} else { } else {
to.has_worker = 0; to.has_worker = 0;
} }

View File

@@ -633,7 +633,7 @@ JANET_CORE_FN(cfun_filewatch_add,
"* `:modified`\n\n" "* `:modified`\n\n"
"* `:renamed-old`\n\n" "* `:renamed-old`\n\n"
"* `:renamed-new`\n\n" "* `:renamed-new`\n\n"
"On Linux, events will a `:type` corresponding to the possible flags, excluding `:all`.\n" "On Linux, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n"
"") { "") {
janet_arity(argc, 2, -1); janet_arity(argc, 2, -1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);

View File

@@ -346,6 +346,9 @@ static void janet_deinit_block(JanetGCObject *mem) {
break; break;
case JANET_MEMORY_ABSTRACT: { case JANET_MEMORY_ABSTRACT: {
JanetAbstractHead *head = (JanetAbstractHead *)mem; JanetAbstractHead *head = (JanetAbstractHead *)mem;
if (head->type->gcperthread) {
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
}
if (head->type->gc) { if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed"); janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
} }
@@ -497,9 +500,12 @@ void janet_sweep() {
/* If not visited... */ /* If not visited... */
if (!janet_truthy(items[i].value)) { if (!janet_truthy(items[i].value)) {
void *abst = janet_unwrap_abstract(items[i].key); void *abst = janet_unwrap_abstract(items[i].key);
JanetAbstractHead *head = janet_abstract_head(abst);
if (head->type->gcperthread) {
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
}
if (0 == janet_abstract_decref(abst)) { if (0 == janet_abstract_decref(abst)) {
/* Run finalizer */ /* Run finalizer */
JanetAbstractHead *head = janet_abstract_head(abst);
if (head->type->gc) { if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed"); janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
} }
@@ -672,8 +678,11 @@ void janet_clear_memory(void) {
for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) { for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
if (janet_checktype(items[i].key, JANET_ABSTRACT)) { if (janet_checktype(items[i].key, JANET_ABSTRACT)) {
void *abst = janet_unwrap_abstract(items[i].key); void *abst = janet_unwrap_abstract(items[i].key);
if (0 == janet_abstract_decref(abst)) {
JanetAbstractHead *head = janet_abstract_head(abst); JanetAbstractHead *head = janet_abstract_head(abst);
if (head->type->gcperthread) {
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
}
if (0 == janet_abstract_decref(abst)) {
if (head->type->gc) { if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed"); janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
} }

View File

@@ -66,6 +66,8 @@
#ifdef JANET_APPLE #ifdef JANET_APPLE
#include <crt_externs.h> #include <crt_externs.h>
#define environ (*_NSGetEnviron()) #define environ (*_NSGetEnviron())
#include <AvailabilityMacros.h>
int chroot(const char *dirname);
#else #else
extern char **environ; extern char **environ;
#endif #endif
@@ -81,8 +83,14 @@ extern char **environ;
#ifndef JANET_SPAWN_NO_CHDIR #ifndef JANET_SPAWN_NO_CHDIR
#ifdef __GLIBC__ #ifdef __GLIBC__
#define JANET_SPAWN_CHDIR #define JANET_SPAWN_CHDIR
#elif defined(JANET_APPLE) /* Some older versions may not work here. */ #elif defined(JANET_APPLE)
/* The posix_spawn_file_actions_addchdir_np function
* has only been implemented since macOS 10.15 */
#if defined(MAC_OS_X_VERSION_10_15) && (MAC_OS_X_VERSION_MIN_REQUIRED >= MAC_OS_X_VERSION_10_15)
#define JANET_SPAWN_CHDIR #define JANET_SPAWN_CHDIR
#else
#define JANET_SPAWN_NO_CHDIR
#endif
#elif defined(__FreeBSD__) /* Not all BSDs work, for example openBSD doesn't seem to support this */ #elif defined(__FreeBSD__) /* Not all BSDs work, for example openBSD doesn't seem to support this */
#define JANET_SPAWN_CHDIR #define JANET_SPAWN_CHDIR
#endif #endif
@@ -1534,6 +1542,28 @@ JANET_CORE_FN(os_posix_fork,
#endif #endif
} }
JANET_CORE_FN(os_posix_chroot,
"(os/posix-chroot dirname)",
"Call `chroot` to change the root directory to `dirname`. "
"Not supported on all systems (POSIX only).") {
janet_sandbox_assert(JANET_SANDBOX_CHROOT);
janet_fixarity(argc, 1);
#ifdef JANET_WINDOWS
(void) argv;
janet_panic("not supported on Windows");
#else
const char *root = janet_getcstring(argv, 0);
int result;
do {
result = chroot(root);
} while (result == -1 && errno == EINTR);
if (result == -1) {
janet_panic(janet_strerror(errno));
}
return janet_wrap_nil();
#endif
}
#ifdef JANET_EV #ifdef JANET_EV
/* Runs in a separate thread */ /* Runs in a separate thread */
static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) { static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
@@ -2842,6 +2872,7 @@ void janet_lib_os(JanetTable *env) {
JANET_CORE_REG("os/touch", os_touch), JANET_CORE_REG("os/touch", os_touch),
JANET_CORE_REG("os/realpath", os_realpath), JANET_CORE_REG("os/realpath", os_realpath),
JANET_CORE_REG("os/cd", os_cd), JANET_CORE_REG("os/cd", os_cd),
JANET_CORE_REG("os/posix-chroot", os_posix_chroot),
#ifndef JANET_NO_UMASK #ifndef JANET_NO_UMASK
JANET_CORE_REG("os/umask", os_umask), JANET_CORE_REG("os/umask", os_umask),
#endif #endif

View File

@@ -1060,20 +1060,12 @@ void janet_buffer_format(
break; break;
} }
case 's': { case 's': {
JanetByteView bytes = janet_getbytes(argv, arg); const char *s = janet_getcbytes(argv, arg);
const uint8_t *s = bytes.bytes;
int32_t l = bytes.len;
if (form[2] == '\0') if (form[2] == '\0')
janet_buffer_push_bytes(b, s, l); janet_buffer_push_cstring(b, s);
else { else {
if (l != (int32_t) strnlen((const char *) s, l))
janet_panic("string contains zeros");
if (!strchr(form, '.') && l >= 100) {
janet_panic("no precision and string is too long to be formatted");
} else {
nb = snprintf(item, MAX_ITEM, form, s); nb = snprintf(item, MAX_ITEM, form, s);
} }
}
break; break;
} }
case 'V': { case 'V': {

View File

@@ -26,7 +26,8 @@
#include "state.h" #include "state.h"
#endif #endif
/* Run a string */ /* Run a string of code. The return value is a set of error flags, JANET_DO_ERROR_RUNTIME, JANET_DO_ERROR_COMPILE, and JANET_DOR_ERROR_PARSE if
* any errors were encountered in those phases. More information is printed to stderr. */
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) { 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; int errflags = 0, done = 0;
@@ -55,11 +56,10 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret); JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) { if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
janet_stacktrace_ext(fiber, ret, ""); janet_stacktrace_ext(fiber, ret, "");
errflags |= 0x01; errflags |= JANET_DO_ERROR_RUNTIME;
done = 1; done = 1;
} }
} else { } else {
ret = janet_wrap_string(cres.error);
int32_t line = (int32_t) parser->line; int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column; int32_t col = (int32_t) parser->column;
if ((cres.error_mapping.line > 0) && if ((cres.error_mapping.line > 0) &&
@@ -67,15 +67,19 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
line = cres.error_mapping.line; line = cres.error_mapping.line;
col = cres.error_mapping.column; col = cres.error_mapping.column;
} }
JanetString ctx = janet_formatc("%s:%d:%d: compile error",
sourcePath, line, col);
JanetString errstr = janet_formatc("%s: %s",
(const char *)ctx,
(const char *)cres.error);
ret = janet_wrap_string(errstr);
if (cres.macrofiber) { if (cres.macrofiber) {
janet_eprintf("%s:%d:%d: compile error", sourcePath, janet_eprintf("%s", (const char *)ctx);
line, col);
janet_stacktrace_ext(cres.macrofiber, ret, ""); janet_stacktrace_ext(cres.macrofiber, ret, "");
} else { } else {
janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath, janet_eprintf("%s\n", (const char *)errstr);
line, col, (const char *)cres.error);
} }
errflags |= 0x02; errflags |= JANET_DO_ERROR_COMPILE;
done = 1; done = 1;
} }
} }
@@ -88,12 +92,14 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
done = 1; done = 1;
break; break;
case JANET_PARSE_ERROR: { case JANET_PARSE_ERROR: {
const char *e = janet_parser_error(parser); errflags |= JANET_DO_ERROR_PARSE;
errflags |= 0x04;
ret = janet_cstringv(e);
int32_t line = (int32_t) parser->line; int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column; int32_t col = (int32_t) parser->column;
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e); JanetString errstr = janet_formatc("%s:%d:%d: parse error: %s",
sourcePath, line, col,
janet_parser_error(parser));
ret = janet_wrap_string(errstr);
janet_eprintf("%s\n", (const char *)errstr);
done = 1; done = 1;
break; break;
} }
@@ -121,6 +127,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
janet_loop(); janet_loop();
if (fiber) { if (fiber) {
janet_gcunroot(janet_wrap_fiber(fiber)); janet_gcunroot(janet_wrap_fiber(fiber));
if (!errflags)
ret = fiber->last_value; ret = fiber->last_value;
} }
} }

View File

@@ -23,8 +23,11 @@
#ifndef JANET_STATE_H_defined #ifndef JANET_STATE_H_defined
#define JANET_STATE_H_defined #define JANET_STATE_H_defined
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h> #include <janet.h>
#include <stdint.h> #include <stdint.h>
#endif
#ifdef JANET_EV #ifdef JANET_EV
#ifdef JANET_WINDOWS #ifdef JANET_WINDOWS
@@ -65,6 +68,7 @@ typedef struct {
int has_worker; int has_worker;
#ifdef JANET_WINDOWS #ifdef JANET_WINDOWS
HANDLE worker; HANDLE worker;
HANDLE worker_event;
#else #else
pthread_t worker; pthread_t worker;
#endif #endif

View File

@@ -147,6 +147,7 @@ extern "C" {
|| defined(__s390x__) /* S390 64-bit */ \ || defined(__s390x__) /* S390 64-bit */ \
|| defined(__s390__) /* S390 32-bit */ \ || defined(__s390__) /* S390 32-bit */ \
|| defined(__ARMEB__) /* ARM big endian */ \ || defined(__ARMEB__) /* ARM big endian */ \
|| defined(__AARCH64EB__) /* ARM64 big endian */ \
|| ((defined(__CC_ARM) || defined(__ARMCC__)) /* ARM RealView compiler */ \ || ((defined(__CC_ARM) || defined(__ARMCC__)) /* ARM RealView compiler */ \
&& defined(__BIG_ENDIAN)) && defined(__BIG_ENDIAN))
#define JANET_BIG_ENDIAN 1 #define JANET_BIG_ENDIAN 1
@@ -1188,6 +1189,7 @@ struct JanetAbstractType {
Janet(*call)(void *p, int32_t argc, Janet *argv); Janet(*call)(void *p, int32_t argc, Janet *argv);
size_t (*length)(void *p, size_t len); size_t (*length)(void *p, size_t len);
JanetByteView(*bytes)(void *p, size_t len); JanetByteView(*bytes)(void *p, size_t len);
int (*gcperthread)(void *data, size_t len);
}; };
/* Some macros to let us add extra types to JanetAbstract types without /* Some macros to let us add extra types to JanetAbstract types without
@@ -1207,7 +1209,8 @@ struct JanetAbstractType {
#define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL #define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL
#define JANET_ATEND_CALL NULL,JANET_ATEND_LENGTH #define JANET_ATEND_CALL NULL,JANET_ATEND_LENGTH
#define JANET_ATEND_LENGTH NULL,JANET_ATEND_BYTES #define JANET_ATEND_LENGTH NULL,JANET_ATEND_BYTES
#define JANET_ATEND_BYTES #define JANET_ATEND_BYTES NULL,JANET_ATEND_GCPERTHREAD
#define JANET_ATEND_GCPERTHREAD
struct JanetReg { struct JanetReg {
const char *name; const char *name;
@@ -1465,10 +1468,10 @@ JANET_API int32_t janet_abstract_incref(void *abst);
JANET_API int32_t janet_abstract_decref(void *abst); JANET_API int32_t janet_abstract_decref(void *abst);
/* Expose channel utilities */ /* Expose channel utilities */
JanetChannel *janet_channel_make(uint32_t limit); JANET_API JanetChannel *janet_channel_make(uint32_t limit);
JanetChannel *janet_channel_make_threaded(uint32_t limit); JANET_API JanetChannel *janet_channel_make_threaded(uint32_t limit);
JanetChannel *janet_getchannel(const Janet *argv, int32_t n); JANET_API JanetChannel *janet_getchannel(const Janet *argv, int32_t n);
JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, JanetChannel *dflt); JANET_API JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, JanetChannel *dflt);
JANET_API int janet_channel_give(JanetChannel *channel, Janet x); JANET_API int janet_channel_give(JanetChannel *channel, Janet x);
JANET_API int janet_channel_take(JanetChannel *channel, Janet *out); JANET_API int janet_channel_take(JanetChannel *channel, Janet *out);
@@ -1616,6 +1619,9 @@ JANET_API JanetTable *janet_core_env(JanetTable *replacements);
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements); JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
/* Execute strings */ /* Execute strings */
#define JANET_DO_ERROR_RUNTIME 0x01
#define JANET_DO_ERROR_COMPILE 0x02
#define JANET_DO_ERROR_PARSE 0x04
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out); JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out); JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
@@ -1894,6 +1900,7 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
#define JANET_SANDBOX_FFI_USE 2048 #define JANET_SANDBOX_FFI_USE 2048
#define JANET_SANDBOX_FFI_JIT 4096 #define JANET_SANDBOX_FFI_JIT 4096
#define JANET_SANDBOX_SIGNAL 8192 #define JANET_SANDBOX_SIGNAL 8192
#define JANET_SANDBOX_CHROOT 16384
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT) #define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP) #define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN) #define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)

View File

@@ -50,6 +50,11 @@
(def errsym (keyword (gensym))) (def errsym (keyword (gensym)))
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg)) ~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defmacro assert-error-value
[msg errval & forms]
(def e (gensym))
~(assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
(defn check-compile-error (defn check-compile-error
[form] [form]
(def result (compile form)) (def result (compile form))

View File

@@ -1023,4 +1023,11 @@
(assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"} (assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"}
@{:key1 "value1" [@"key2"] @"value2"}) "deep= mutable keys") @{:key1 "value1" [@"key2"] @"value2"}) "deep= mutable keys")
# different try overloads
(assert (= (try (error :error) ([] :caught)) :caught))
(assert (= (try (error :error) ([e] e)) :error))
(assert (= (try (error :error) ([e fib] [e (fiber? fib)])) [:error true]))
# regression test for #1659
(assert (= (try (error :error) ([_ _] :caught)) :caught))
(end-suite) (end-suite)

View File

@@ -117,8 +117,17 @@
(assert (= 0 (length (bundle/list))) "bundles are listed correctly 7") (assert (= 0 (length (bundle/list))) "bundles are listed correctly 7")
(assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8") (assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8")
# Try installing a bundle that is missing bundle script
(assert-error-value "bundle missing bundle script"
"bundle must contain bundle.janet or bundle/init.janet"
(bundle/install "./examples/sample-bad-bundle1"))
(assert (= 0 (length (bundle/list))) "check failure 0")
(assert (= 0 (length (bundle/topolist))) "check failure 1")
# Try installing a bundle that fails check # Try installing a bundle that fails check
(assert-error "bad test" (bundle/install "./examples/sample-bad-bundle" :check true)) (assert-error-value "bundle check hook fails"
"Check failed!"
(bundle/install "./examples/sample-bad-bundle2" :check true))
(assert (= 0 (length (bundle/list))) "check failure 0") (assert (= 0 (length (bundle/list))) "check failure 0")
(assert (= 0 (length (bundle/topolist))) "check failure 1") (assert (= 0 (length (bundle/topolist))) "check failure 1")

58
test/suite-ev2.janet Normal file
View File

@@ -0,0 +1,58 @@
# 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
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
# Issue #1629
(def thread-channel (ev/thread-chan 100))
(def super (ev/thread-chan 10))
(defn worker []
(while true
(def item (ev/take thread-channel))
(when (= item :deadline)
(ev/deadline 0.1 nil (fiber/current) true))))
(ev/thread worker nil :n super)
(ev/give thread-channel :item)
(ev/sleep 0.05)
(ev/give thread-channel :item)
(ev/sleep 0.05)
(ev/give thread-channel :deadline)
(ev/sleep 0.05)
(ev/give thread-channel :item)
(ev/sleep 0.05)
(ev/give thread-channel :item)
(ev/sleep 0.15)
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
# Another variant
(def thread-channel (ev/thread-chan 100))
(def super (ev/thread-chan 10))
(defn worker []
(while true
(def item (ev/take thread-channel))
(when (= item :deadline)
(ev/deadline 0.1))))
(ev/thread worker nil :n super)
(ev/give thread-channel :deadline)
(ev/sleep 0.2)
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
(end-suite)

View File

@@ -136,5 +136,8 @@
"keyword slice") "keyword slice")
(assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice") (assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice")
# Check string formatting, #1600
(assert (= "" (string/format "%.99s" @"")) "string/format %s buffer")
(end-suite) (end-suite)

View File

@@ -37,6 +37,12 @@
Version="$(var.Version)" Version="$(var.Version)"
Manufacturer="$(var.Manufacturer)" Manufacturer="$(var.Manufacturer)"
UpgradeCode="$(var.UpgradeCode)"> UpgradeCode="$(var.UpgradeCode)">
<!--
perUser means destination will be under user's %AppData% directory,
not Program Files or similar.
see: https://learn.microsoft.com/en-us/windows/win32/msi/installation-context
-->
<Package Compressed="yes" <Package Compressed="yes"
InstallScope="perUser" InstallScope="perUser"
Manufacturer="$(var.Manufacturer)" Manufacturer="$(var.Manufacturer)"