Merge branch 'master' into armtest

CHANGELOG.md

@@ -1,7 +1,8 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
-## ??? - Unreleased
+## 1.29.1 - 2023-06-19
+- Add support for passing booleans to PEGs for "always" and "never" matching.
 - Allow dictionary types for `take` and `drop`
 - Fix bug with closing channels while other fibers were waiting on them - `ev/take`, `ev/give`, and `ev/select`  will now return the correct (documented) value when another fiber closes the channel.
 - Add `ffi/calling-conventions` to show all available calling conventions for FFI.

Makefile

@@ -195,9 +195,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
 ########################
 
 ifeq ($(UNAME), Darwin)
-SONAME=libjanet.1.28.dylib
+SONAME=libjanet.1.29.dylib
 else
-SONAME=libjanet.so.1.28
+SONAME=libjanet.so.1.29
 endif
 
 build/c/shell.c: src/mainclient/shell.c

meson.build

@@ -20,7 +20,7 @@
 
 project('janet', 'c',
   default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.28.0')
+  version : '1.29.1')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')

src/boot/boot.janet

@@ -668,14 +668,20 @@
   (def len (length bindings))
   (if (= 0 len) (error "expected at least 1 binding"))
   (if (odd? len) (error "expected an even number of bindings"))
+  (def res (gensym))
   (defn aux [i]
     (if (>= i len)
-      tru
+      ~(do (set ,res ,tru) true)
       (do
         (def bl (in bindings i))
         (def br (in bindings (+ 1 i)))
-        (tuple 'if (tuple 'def bl br) (aux (+ 2 i)) fal))))
+        (if (symbol? bl)
-  (aux 0))
+          ~(if (def ,bl ,br) ,(aux (+ 2 i)))
+          ~(if (def ,(def sym (gensym)) ,br)
+             (do (def ,bl ,sym) ,(aux (+ 2 i))))))))
+  ~(do
+     (var ,res nil)
+     (if ,(aux 0) ,res ,fal)))
 
 (defmacro when-let
   "Same as `(if-let bindings (do ;body))`."

src/conf/janetconf.h

@@ -4,10 +4,10 @@
 #define JANETCONF_H
 
 #define JANET_VERSION_MAJOR 1
-#define JANET_VERSION_MINOR 28
+#define JANET_VERSION_MINOR 29
-#define JANET_VERSION_PATCH 0
+#define JANET_VERSION_PATCH 1
-#define JANET_VERSION_EXTRA "-dev"
+#define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.28.0-dev"
+#define JANET_VERSION "1.29.1"
 
 /* #define JANET_BUILD "local" */
 

src/core/capi.c

@@ -273,6 +273,14 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
     return janet_unwrap_integer(x);
 }
 
+uint32_t janet_getuinteger(const Janet *argv, int32_t n) {
+    Janet x = argv[n];
+    if (!janet_checkuint(x)) {
+        janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x);
+    }
+    return janet_unwrap_integer(x);
+}
+
 int64_t janet_getinteger64(const Janet *argv, int32_t n) {
 #ifdef JANET_INT_TYPES
     return janet_unwrap_s64(argv[n]);
@@ -290,7 +298,7 @@ uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
     return janet_unwrap_u64(argv[n]);
 #else
     Janet x = argv[n];
-    if (!janet_checkint64(x)) {
+    if (!janet_checkuint64(x)) {
         janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
     }
     return (uint64_t) janet_unwrap_number(x);

src/core/compile.c

@@ -746,12 +746,14 @@ static int macroexpand1(
     int lock = janet_gclock();
     Janet mf_kw = janet_ckeywordv("macro-form");
     janet_table_put(c->env, mf_kw, x);
+    Janet ml_kw = janet_ckeywordv("macro-lints");
+    if (c->lints) {
+        janet_table_put(c->env, ml_kw, janet_wrap_array(c->lints));
+    }
     Janet tempOut;
     JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
     janet_table_put(c->env, mf_kw, janet_wrap_nil());
-    if (c->lints) {
+    janet_table_put(c->env, ml_kw, janet_wrap_nil());
-        janet_table_put(c->env, janet_ckeywordv("macro-lints"), janet_wrap_array(c->lints));
-    }
     janet_gcunlock(lock);
     if (status != JANET_SIGNAL_OK) {
         const uint8_t *es = janet_formatc("(macro) %V", tempOut);

src/core/os.c

@@ -1145,14 +1145,16 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
         posix_spawn_file_actions_addclose(&actions, pipe_in);
     } else if (new_in != JANET_HANDLE_NONE && new_in != 0) {
         posix_spawn_file_actions_adddup2(&actions, new_in, 0);
-        posix_spawn_file_actions_addclose(&actions, new_in);
+        if (new_in != new_out && new_in != new_err)
+            posix_spawn_file_actions_addclose(&actions, new_in);
     }
     if (pipe_out != JANET_HANDLE_NONE) {
         posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
         posix_spawn_file_actions_addclose(&actions, pipe_out);
     } else if (new_out != JANET_HANDLE_NONE && new_out != 1) {
         posix_spawn_file_actions_adddup2(&actions, new_out, 1);
-        posix_spawn_file_actions_addclose(&actions, new_out);
+        if (new_out != new_err)
+            posix_spawn_file_actions_addclose(&actions, new_out);
     }
     if (pipe_err != JANET_HANDLE_NONE) {
         posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
@@ -1437,11 +1439,11 @@ JANET_CORE_FN(os_isatty,
     FILE *f = (argc == 1) ? janet_getfile(argv, 0, NULL) : stdout;
 #ifdef JANET_WINDOWS
     int fd = _fileno(f);
-    if (fd == -1) janet_panicv(janet_ev_lasterr());
+    if (fd == -1) janet_panic("not a valid stream");
     return janet_wrap_boolean(_isatty(fd));
 #else
     int fd = fileno(f);
-    if (fd == -1) janet_panicv(janet_ev_lasterr());
+    if (fd == -1) janet_panic(strerror(errno));
     return janet_wrap_boolean(isatty(fd));
 #endif
 }

src/core/peg.c

@@ -1261,6 +1261,13 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
         default:
             peg_panic(b, "unexpected peg source");
             return 0;
+
+        case JANET_BOOLEAN: {
+            int n = janet_unwrap_boolean(peg);
+            Reserve r = reserve(b, 2);
+            emit_1(r, n ? RULE_NCHAR : RULE_NOTNCHAR, 0);
+            break;
+        }
         case JANET_NUMBER: {
             int32_t n = peg_getinteger(b, peg);
             Reserve r = reserve(b, 2);

src/core/util.c

@@ -805,6 +805,13 @@ int janet_checkint(Janet x) {
     return janet_checkintrange(dval);
 }
 
+int janet_checkuint(Janet x) {
+    if (!janet_checktype(x, JANET_NUMBER))
+        return 0;
+    double dval = janet_unwrap_number(x);
+    return janet_checkuintrange(dval);
+}
+
 int janet_checkint64(Janet x) {
     if (!janet_checktype(x, JANET_NUMBER))
         return 0;
@@ -816,7 +823,7 @@ int janet_checkuint64(Janet x) {
     if (!janet_checktype(x, JANET_NUMBER))
         return 0;
     double dval = janet_unwrap_number(x);
-    return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
+    return janet_checkuint64range(dval);
 }
 
 int janet_checksize(Janet x) {

src/core/vm.c

@@ -147,8 +147,8 @@
             stack[A] = janet_mcall(#op, 2, _argv);\
             vm_checkgc_pcnext();\
         } else {\
-            type1 x1 = (type1) janet_unwrap_integer(op1);\
+            type1 x1 = (type1) janet_unwrap_number(op1);\
-            stack[A] = janet_wrap_integer(x1 op CS);\
+            stack[A] = janet_wrap_number((type1) (x1 op CS));\
             vm_pcnext();\
         }\
     }
@@ -175,9 +175,9 @@
         Janet op1 = stack[B];\
         Janet op2 = stack[C];\
         if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
-            type1 x1 = (type1) janet_unwrap_integer(op1);\
+            type1 x1 = (type1) janet_unwrap_number(op1);\
             int32_t x2 = janet_unwrap_integer(op2);\
-            stack[A] = janet_wrap_integer(x1 op x2);\
+            stack[A] = janet_wrap_number((type1) (x1 op x2));\
             vm_pcnext();\
         } else {\
             vm_commit();\
@@ -980,7 +980,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
             if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
                 vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
             }
-            janet_stack_frame(stack)->pc = pc;
+            vm_commit();
             if (janet_fiber_funcframe(fiber, func)) {
                 int32_t n = fiber->stacktop - fiber->stackstart;
                 janet_panicf("%v called with %d argument%s, expected %d",

src/include/janet.h

@@ -868,12 +868,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
 #endif
 
 JANET_API int janet_checkint(Janet x);
+JANET_API int janet_checkuint(Janet x);
 JANET_API int janet_checkint64(Janet x);
 JANET_API int janet_checkuint64(Janet x);
 JANET_API int janet_checksize(Janet x);
 JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
 #define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
+#define janet_checkuintrange(x) ((x) >= 0 && (x) <= UINT32_MAX && (x) == (uint32_t)(x))
 #define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
+#define janet_checkuint64range(x) ((x) >= 0 && (x) <= JANET_INTMAX_DOUBLE && (x) == (uint64_t)(x))
 #define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
 #define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
 

test/suite-boot.janet

@@ -129,6 +129,13 @@
 (assert (= (if-let [a my-array k (next a 5)] :t :f) :f) "if-let 4")
 (assert (= (if-let [[a b] my-array] a) 1) "if-let 5")
 (assert (= (if-let [{:a a :b b} {:a 1 :b 2}] b) 2) "if-let 6")
+(assert (= (if-let [[a b] nil] :t :f) :f) "if-let 7")
+
+# #1191
+(var cnt 0)
+(defmacro upcnt [] (++ cnt))
+(assert (= (if-let [a true b true c true] nil (upcnt)) nil) "issue #1191")
+(assert (= cnt 1) "issue #1191")
 
 (assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
 (def myfun (juxt + - * /))
@@ -879,5 +886,22 @@
 (assert (= (thunk) 1) "delay 3")
 (assert (= counter 1) "delay 4")
 
-(end-suite)
+# maclintf
+(def env (table/clone (curenv)))
+((compile '(defmacro foo [] (maclintf :strict "oops")) env :anonymous))
+(def lints @[])
+(compile (tuple/setmap '(foo) 1 2) env :anonymous lints)
+(assert (deep= lints @[[:strict 1 2 "oops"]]) "maclintf 1")
 
+(def env (table/clone (curenv)))
+((compile '(defmacro foo [& body] (maclintf :strict "foo-oops") ~(do ,;body)) env :anonymous))
+((compile '(defmacro bar [] (maclintf :strict "bar-oops")) env :anonymous))
+(def lints @[])
+# Compile (foo (bar)), but with explicit source map values
+(def bar-invoke (tuple/setmap '(bar) 3 4))
+(compile (tuple/setmap ~(foo ,bar-invoke) 1 2) env :anonymous lints)
+(assert (deep= lints @[[:strict 1 2 "foo-oops"]
+                       [:strict 3 4 "bar-oops"]])
+        "maclintf 2")
+
+(end-suite)

test/suite-os.janet

@@ -94,9 +94,9 @@
   (assert (= (length buf) 2) "cryptorand appends to buffer"))
 
 # 80db68210
-(assert-no-error (os/clock :realtime) "realtime clock")
+(assert-no-error "realtime clock" (os/clock :realtime))
-(assert-no-error (os/clock :cputime) "cputime clock")
+(assert-no-error "cputime clock" (os/clock :cputime))
-(assert-no-error (os/clock :monotonic) "monotonic clock")
+(assert-no-error "monotonic clock" (os/clock :monotonic))
 
 (def before (os/clock :monotonic))
 (def after (os/clock :monotonic))
@@ -129,5 +129,20 @@
                             (string/format "(os/exit %d)" i)] :p))
           (string "os/execute " i)))
 
+# os/execute IO redirection
+(assert-no-error "IO redirection"
+                 (defn devnull []
+                   (def os (os/which))
+                   (def path (if (or (= os :mingw) (= os :windows))
+                               "NUL"
+                               "/dev/null"))
+                   (os/open path :w))
+                 (with [dn (devnull)]
+                   (os/execute [(dyn :executable)
+                                "-e"
+                                "(print :foo) (eprint :bar)"]
+                               :px
+                               {:out dn :err dn})))
+
 (end-suite)