mirrors
/
janet
mirror of https://github.com/janet-lang/janet
1
0
Fork 0
Code Issues 1 Releases Wiki Activity

Squashed commit of the following: 

commit fbb0711ae1
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 12:07:55 2023 -0500

    Distinguish between subprocess when testing.

commit 676b233566
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:59:17 2023 -0500

    Hack for qemu based testing (also should work with valgrind)

commit d7431c7cdb
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:54:04 2023 -0500

    Revert "Test removing 32bit ptr marshalling."

    This reverts commit 566b45ea44.

commit 566b45ea44
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:52:22 2023 -0500

    Test removing 32bit ptr marshalling.

commit ff2f71d2bc
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:42:10 2023 -0500

    Conditionally compile marshal_ptr code.

commit bd420aeb0e
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:38:34 2023 -0500

    Add range checking to bit-shift code to prevent undefined behavior.

commit b738319f8d
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:17:30 2023 -0500

    Remove range check on 32 bit arch since it will always pass.

commit 7248626235
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 10:56:45 2023 -0500

    Quiet some build warnings.

commit 141c1de946
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 10:50:13 2023 -0500

    Add marshal utilities for pointers.

commit c2d77d6720
Merge: 677b8a6f ff90b81e
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 10:40:35 2023 -0500

    Merge branch 'master' into armtest

commit 677b8a6f32
Author: Ico Doornekamp <ico@zevv.nl>
Date:   Mon Jun 12 21:01:26 2023 +0200

    Added ARM32 test
This commit is contained in:
Calvin Rose 2023-06-24 12:13:51 -05:00
parent ff90b81ec3
commit b219b146fa
10 changed files with 86 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
.github/workflows/test.yml vendored
View File

@ -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

4
src/core/ev.c
View File

@ -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

18
src/core/marsh.c
View File

@ -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);

3
src/core/specials.c
View File

@ -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;

9
src/core/value.c
View File

@ -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);

24
src/core/vm.c
View File

@ -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];\

2
src/include/janet.h
View File

@ -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);

6
test/suite-corelib.janet
View File

@ -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")

27
test/suite-ev.janet
View File

@ -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

9
test/suite-os.janet
View File

@ -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