diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index c620c513..2f5cb19c 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -74,3 +74,18 @@ jobs: run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine - name: Test the project run: make test UNAME=MINGW RUN=wine + + test-arm-linux: + name: Build and test ARM32 cross compilation + runs-on: ubuntu-latest + steps: + - name: Checkout the repository + uses: actions/checkout@master + - name: Setup qemu and cross compiler + run: | + sudo apt-get update + sudo apt-get install gcc-arm-linux-gnueabi qemu-user + - name: Compile the project + run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc + - name: Test the project + run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test diff --git a/src/core/ev.c b/src/core/ev.c index 28585d9f..17fe442e 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -401,7 +401,7 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) { } janet_marshal_abstract(ctx, p); janet_marshal_int(ctx, (int32_t) s->flags); - janet_marshal_int64(ctx, (intptr_t) s->methods); + janet_marshal_ptr(ctx, s->methods); #ifdef JANET_WINDOWS /* TODO - ref counting to avoid situation where a handle is closed or GCed * while in transit, and it's value gets reused. DuplicateHandle does not work @@ -438,7 +438,7 @@ static void *janet_stream_unmarshal(JanetMarshalContext *ctx) { p->_mask = 0; p->state = NULL; p->flags = (uint32_t) janet_unmarshal_int(ctx); - p->methods = (void *) janet_unmarshal_int64(ctx); + p->methods = janet_unmarshal_ptr(ctx); #ifdef JANET_WINDOWS p->handle = (JanetHandle) janet_unmarshal_int64(ctx); #else diff --git a/src/core/marsh.c b/src/core/marsh.c index becab902..b4dae0ba 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -362,6 +362,15 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) { pushint(st, value); } +/* Only use in unsafe - don't marshal pointers otherwise */ +void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) { +#ifdef JANET_32 + janet_marshal_int(ctx, (intptr_t) ptr); +#else + janet_marshal_int64(ctx, (intptr_t) ptr); +#endif +} + void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) { MarshalState *st = (MarshalState *)(ctx->m_state); pushbyte(st, value); @@ -1165,6 +1174,15 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) { return read64(st, &(ctx->data)); } +void *janet_unmarshal_ptr(JanetMarshalContext *ctx) { + UnmarshalState *st = (UnmarshalState *)(ctx->u_state); +#ifdef JANET_32 + return (void *) ((intptr_t) readint(st, &(ctx->data))); +#else + return (void *) ((intptr_t) read64(st, &(ctx->data))); +#endif +} + uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) { UnmarshalState *st = (UnmarshalState *)(ctx->u_state); MARSH_EOS(st, ctx->data); diff --git a/src/core/specials.c b/src/core/specials.c index 4f2b9740..d4da602e 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -357,7 +357,8 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt if (has_drop && can_destructure_lhs && rhs_is_indexed) { /* Code is of the form (def [a b] [1 2]), avoid the allocation of two tuples */ - JanetView view_lhs, view_rhs; + JanetView view_lhs = {0}; + JanetView view_rhs = {0}; janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len); janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len); int found_amp = 0; diff --git a/src/core/value.c b/src/core/value.c index 37ca4041..3a071cda 100644 --- a/src/core/value.c +++ b/src/core/value.c @@ -698,11 +698,16 @@ Janet janet_lengthv(Janet x) { const JanetAbstractType *type = janet_abstract_type(abst); if (type->length != NULL) { size_t len = type->length(abst, janet_abstract_size(abst)); - if ((uint64_t) len <= (uint64_t) JANET_INTMAX_INT64) { - return janet_wrap_number((double) len); + /* If len is always less then double, we can never overflow */ +#ifdef JANET_32 + return janet_wrap_number(len); +#else + if (len < (size_t) JANET_INTMAX_INT64) { + return janet_wrap_number(len); } else { janet_panicf("integer length %u too large", len); } +#endif } Janet argv[1] = { x }; return janet_mcall("length", 1, argv); diff --git a/src/core/vm.c b/src/core/vm.c index dd8b7e57..12f990c9 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -138,7 +138,7 @@ vm_pcnext();\ }\ } -#define _vm_bitop_immediate(op, type1)\ +#define _vm_bitop_immediate(op, type1, rangecheck, msg)\ {\ Janet op1 = stack[B];\ if (!janet_checktype(op1, JANET_NUMBER)) {\ @@ -147,13 +147,15 @@ stack[A] = janet_mcall(#op, 2, _argv);\ vm_checkgc_pcnext();\ } else {\ - type1 x1 = (type1) janet_unwrap_number(op1);\ + double y1 = janet_unwrap_number(op1);\ + if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\ + type1 x1 = (type1) y1;\ stack[A] = janet_wrap_number((type1) (x1 op CS));\ vm_pcnext();\ }\ } -#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t); -#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t); +#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t, janet_checkintrange, "32-bit signed integers"); +#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers"); #define _vm_binop(op, wrap)\ {\ Janet op1 = stack[B];\ @@ -170,13 +172,17 @@ }\ } #define vm_binop(op) _vm_binop(op, janet_wrap_number) -#define _vm_bitop(op, type1)\ +#define _vm_bitop(op, type1, rangecheck, msg)\ {\ Janet op1 = stack[B];\ Janet op2 = stack[C];\ if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\ - type1 x1 = (type1) janet_unwrap_number(op1);\ - int32_t x2 = janet_unwrap_integer(op2);\ + double y1 = janet_unwrap_number(op1);\ + double y2 = janet_unwrap_number(op2);\ + if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\ + if (!janet_checkintrange(y2)) { vm_commit(); janet_panicf("rhs must be valid 32-bit signed integer, got %f", op2); }\ + type1 x1 = (type1) y1;\ + int32_t x2 = (int32_t) y2;\ stack[A] = janet_wrap_number((type1) (x1 op x2));\ vm_pcnext();\ } else {\ @@ -185,8 +191,8 @@ vm_checkgc_pcnext();\ }\ } -#define vm_bitop(op) _vm_bitop(op, int32_t) -#define vm_bitopu(op) _vm_bitop(op, uint32_t) +#define vm_bitop(op) _vm_bitop(op, int32_t, janet_checkintrange, "32-bit signed integers") +#define vm_bitopu(op) _vm_bitop(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers") #define vm_compop(op) \ {\ Janet op1 = stack[B];\ diff --git a/src/include/janet.h b/src/include/janet.h index 3f6b8982..34cfa06a 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -2053,6 +2053,7 @@ JANET_API int janet_cryptorand(uint8_t *out, size_t n); JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value); JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value); JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value); +JANET_API void janet_marshal_ptr(JanetMarshalContext *ctx, const void *value); JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value); JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len); JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x); @@ -2062,6 +2063,7 @@ JANET_API void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size); JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx); JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx); JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx); +JANET_API void *janet_unmarshal_ptr(JanetMarshalContext *ctx); JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx); JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len); JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx); diff --git a/test/suite-corelib.janet b/test/suite-corelib.janet index 165207d5..8f590658 100644 --- a/test/suite-corelib.janet +++ b/test/suite-corelib.janet @@ -30,10 +30,12 @@ (assert (= 1 (brshift 4 2)) "right shift") # unsigned shift (assert (= 32768 (brushift 0x80000000 16)) "right shift unsigned 1") -(assert (= -32768 (brshift 0x80000000 16)) "right shift unsigned 2") +(assert-error "right shift unsigned 2" (= -32768 (brshift 0x80000000 16))) +(assert (= -1 (brshift -1 16)) "right shift unsigned 3") # non-immediate forms (assert (= 32768 (brushift 0x80000000 (+ 0 16))) "right shift unsigned non-immediate") -(assert (= -32768 (brshift 0x80000000 (+ 0 16))) "right shift non-immediate") +(assert-error "right shift non-immediate" (= -32768 (brshift 0x80000000 (+ 0 16)))) +(assert (= -1 (brshift -1 (+ 0 16))) "right shift non-immediate 2") (assert (= 32768 (blshift 1 (+ 0 15))) "left shift non-immediate") # 7e46ead (assert (< 1 2 3 4 5 6) "less than integers") diff --git a/test/suite-ev.janet b/test/suite-ev.janet index 184743d1..ccecdf4e 100644 --- a/test/suite-ev.janet +++ b/test/suite-ev.janet @@ -25,38 +25,41 @@ # 5e1a8c86f (def janet (dyn :executable)) +# Subprocess should inherit the "RUN" parameter for fancy testing +(def run (filter next (string/split " " (os/getenv "SUBRUN" "")))) + (repeat 10 - (let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})] + (let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})] (os/proc-wait p) (def x (:read (p :out) :all)) (assert (deep= "hello" (string/trim x)) "capture stdout from os/spawn pre close.")) - (let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})] + (let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})] (def x (:read (p :out) 1024)) (os/proc-wait p) (assert (deep= "hello" (string/trim x)) "capture stdout from os/spawn post close.")) - (let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px + (let [p (os/spawn [;run janet "-e" `(file/read stdin :line)`] :px {:in :pipe})] (:write (p :in) "hello!\n") (assert-no-error "pipe stdin to process" (os/proc-wait p)))) -(let [p (os/spawn [janet "-e" `(print (file/read stdin :line))`] :px +(let [p (os/spawn [;run janet "-e" `(print (file/read stdin :line))`] :px {:in :pipe :out :pipe})] (:write (p :in) "hello!\n") (def x (:read (p :out) 1024)) (assert-no-error "pipe stdin to process 2" (os/proc-wait p)) (assert (= "hello!" (string/trim x)) "round trip pipeline in process")) -(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)] +(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)] (os/proc-kill p) (def retval (os/proc-wait p)) (assert (not= retval 24) "Process was *not* terminated by parent")) -(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)] +(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)] (os/proc-kill p false :term) (def retval (os/proc-wait p)) (assert (not= retval 24) "Process was *not* terminated by parent")) @@ -66,7 +69,7 @@ (defn calc-1 "Run subprocess, read from stdout, then wait on subprocess." [code] - (let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px + (let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})] (os/proc-wait p) (def output (:read (p :out) :all)) @@ -86,7 +89,7 @@ to 10 bytes instead of :all `` [code] - (let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px + (let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})] (def output (:read (p :out) 10)) (os/proc-wait p) @@ -104,18 +107,18 @@ # a1cc5ca04 (assert-no-error "file writing 1" (with [f (file/temp)] - (os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f}))) + (os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f}))) (assert-no-error "file writing 2" (with [f (file/open "unique.txt" :w)] - (os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f}) + (os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f}) (file/flush f))) # Issue #593 # a1cc5ca04 (assert-no-error "file writing 3" (def outfile (file/open "unique.txt" :w)) - (os/execute [janet "-e" "(pp (seq [i :range (1 10)] i))"] :p + (os/execute [;run janet "-e" "(pp (seq [i :range (1 10)] i))"] :p {:out outfile}) (file/flush outfile) (file/close outfile) @@ -256,7 +259,7 @@ (ev/cancel fiber "boop") # f0dbc2e -(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self") +(assert (os/execute [;run janet "-e" `(+ 1 2 3)`] :xp) "os/execute self") # Test some channel # e76b8da26 diff --git a/test/suite-os.janet b/test/suite-os.janet index 881f24cf..e9bd465e 100644 --- a/test/suite-os.janet +++ b/test/suite-os.janet @@ -21,6 +21,9 @@ (import ./helper :prefix "" :exit true) (start-suite) +(def janet (dyn :executable)) +(def run (filter next (string/split " " (os/getenv "SUBRUN" "")))) + # OS Date test # 719f7ba0c (assert (deep= {:year-day 0 @@ -118,14 +121,14 @@ # os/execute with environment variables # issue #636 - 7e2c433ab -(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe +(assert (= 0 (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe (merge (os/environ) {"HELLO" "WORLD"}))) "os/execute with env") # os/execute regressions # 427f7c362 (for i 0 10 - (assert (= i (os/execute [(dyn :executable) "-e" + (assert (= i (os/execute [;run janet "-e" (string/format "(os/exit %d)" i)] :p)) (string "os/execute " i))) @@ -138,7 +141,7 @@ "/dev/null")) (os/open path :w)) (with [dn (devnull)] - (os/execute [(dyn :executable) + (os/execute [;run janet "-e" "(print :foo) (eprint :bar)"] :px