1
0
mirror of https://github.com/janet-lang/janet synced 2024-06-25 22:53:16 +00:00

Merge branch 'master' into threads-3

This commit is contained in:
Calvin Rose 2019-12-04 22:39:30 -06:00
commit 1a4035b02c
18 changed files with 280 additions and 55 deletions

View File

@ -18,6 +18,18 @@ All notable changes to this project will be documented in this file.
contains `(quit some-value)`, the value of that module returned to `(require "somemod")`
is the return value. This lets module writers completely customize a module without writing
a loader.
- Add nested quasiquotation.
- Add `os/cryptorand`
- Add `prinf` and `eprinf` to be have like `printf` and `eprintf`. The latter two functions
now including a trailing newline, like the other print functions.
- Add nan?
- Add `janet_in` to C API.
- Add `truthy?`
- Add `os/environ`
- Use `(doc)` with no arguments to see available bindings and dynamic bindings.
- `jpm` will use `CC` and `AR` environment variables when compiling programs.
- Add `comptime` macro for compile time evaluation.
- Numerous small bug fixes and usability improvements.
### 1.5.1 - 2019-11-16
- Fix bug when printing buffer to self in some edge cases.

View File

@ -108,9 +108,9 @@
# Compilation Defaults
#
(def default-compiler (if is-win "cl" "cc"))
(def default-linker (if is-win "link" "cc"))
(def default-archiver (if is-win "lib" "ar"))
(def default-compiler (or (os/getenv "CC") (if is-win "cl.exe" "cc")))
(def default-linker (or (os/getenv "CC") (if is-win "link.exe" "cc")))
(def default-archiver (or (os/getenv "AR") (if is-win "lib.exe" "ar")))
# Detect threads
(def env (fiber/getenv (fiber/current)))
@ -322,7 +322,7 @@
(defn- link-c
"Link object files together to make a native module."
[opts target & objects]
(def ld (opt opts :linker default-linker))
(def linker (opt opts (if is-win :linker :compiler) default-linker))
(def cflags (getcflags opts))
(def lflags [;(opt opts :lflags default-lflags)
;(if (opts :static) [] dynamic-lflags)])
@ -330,8 +330,8 @@
(check-cc)
(print "linking " target "...")
(if is-win
(shell ld ;lflags (string "/OUT:" target) ;objects (win-import-library))
(shell ld ;cflags `-o` target ;objects ;lflags))))
(shell linker ;lflags (string "/OUT:" target) ;objects (win-import-library))
(shell linker ;cflags `-o` target ;objects ;lflags))))
(defn- archive-c
"Link object files together to make a static library."
@ -868,9 +868,10 @@ Keys are:
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH.
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
--libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH.
--compiler : C compiler to use for natives. Defaults to cc (cl on windows).
--archiver : C compiler to use for static libraries. Defaults to ar (lib on windows).
--linker : C linker to use for linking natives. Defaults to cc (link on windows).
--compiler : C compiler to use for natives. Defaults to $CC or cc (cl.exe on windows).
--archiver : C compiler to use for static libraries. Defaults to $AR ar (lib.exe on windows).
--linker : C linker to use for linking natives. Defaults to link.exe on windows, not used on
other platforms.
--pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git
Flags are:

11
jpm.1
View File

@ -60,23 +60,24 @@ Linking statically might be a better idea, even in that case. Defaults to
$JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
.TP
.BR \-\-compiler=cc
.BR \-\-compiler=$CC
Sets the compiler used for compiling native modules and standalone executables. Defaults
to cc.
.TP
.BR \-\-linker=ld
Sets the linker used to create native modules and executables.
.BR \-\-linker
Sets the linker used to create native modules and executables. Only used on windows, where
it defaults to link.exe.
.TP
.BR \-\-pkglist=https://github.com/janet-lang/pkgs.git
Sets the git repository for the package listing used to resolve shorthand package names.
.TP
.BR \-\-archiver=ar
.BR \-\-archiver=$AR
Sets the command used for creating static libraries, use for linking into the standalone executable.
Native modules are compiled twice, once a normal native module (shared object), and once as an
archive.
archive. Defaults to ar.
.SH COMMANDS
.TP

View File

@ -73,6 +73,7 @@
nil)
# Basic predicates
(defn nan? "Check if x is NaN" [x] (not= x x))
(defn even? "Check if x is even." [x] (== 0 (% x 2)))
(defn odd? "Check if x is odd." [x] (not= 0 (% x 2)))
(defn zero? "Check if x is zero." [x] (== x 0))
@ -325,6 +326,11 @@
(def ,binding ,i)
,body))))
(defn- check-indexed [x]
(if (indexed? x)
x
(error (string "expected tuple for range, got " x))))
(defn- loop1
[body head i]
@ -354,11 +360,11 @@
(def {(+ i 2) object} head)
(let [rest (loop1 body head (+ i 3))]
(case verb
:range (let [[start stop step] object]
:range (let [[start stop step] (check-indexed object)]
(for-template binding start stop (or step 1) < + [rest]))
:keys (keys-template binding object false [rest])
:pairs (keys-template binding object true [rest])
:down (let [[start stop step] object]
:down (let [[start stop step] (check-indexed object)]
(for-template binding start stop (or step 1) > - [rest]))
:in (each-template binding object [rest])
:iterate (iterate-template binding object rest)
@ -415,6 +421,7 @@
(loop1 body head 0))
(put _env 'loop1 nil)
(put _env 'check-indexed nil)
(put _env 'for-template nil)
(put _env 'iterate-template nil)
(put _env 'each-template nil)
@ -1843,6 +1850,7 @@
(res)
(error (res :error))))
<<<<<<< HEAD
(def make-image-dict
"A table used in combination with marshal to marshal code (images), such that
@ -1854,6 +1862,11 @@
by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict)."
@{})
(def comptime
"(comptime x)\n\n
Evals x at compile time and returns the result. Similar to a top level unquote."
:macro eval)
(defn make-image
"Create an image from an environment returned by require.
Returns the image source as a string."
@ -2216,7 +2229,9 @@
(+= i (dohandler (string/slice arg 1) i))
(do
(set *no-file* false)
(dofile arg :prefix "" :exit *exit-on-error* :evaluator evaluator)
(def env (make-env))
(put env :args (array/slice args i))
(dofile arg :prefix "" :exit *exit-on-error* :evaluator evaluator :env env)
(set i lenargs))))
(when (and (not *compile-only*) (or *should-repl* *no-file*))

View File

@ -273,7 +273,8 @@ static const JanetReg array_cfuns[] = {
"Takes a slice of array or tuple from start to end. The range is half open, "
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
"end of the array. By default, start is 0 and end is the length of the array. "
"Returns a new array.")
"Note that index -1 is synonymous with index (length arrtup) to allow a full "
"negative slice range. Returns a new array.")
},
{
"array/concat", cfun_array_concat,

View File

@ -569,15 +569,24 @@ static int macroexpand1(
return 0;
/* Evaluate macro */
JanetFiber *fiberp = NULL;
JanetFunction *macro = janet_unwrap_function(macroval);
int32_t arity = janet_tuple_length(form) - 1;
JanetFiber *fiberp = janet_fiber(macro, 64, arity, form + 1);
if (NULL == fiberp) {
int32_t minar = macro->def->min_arity;
int32_t maxar = macro->def->max_arity;
const uint8_t *es = NULL;
if (minar >= 0 && arity < minar)
es = janet_formatc("macro arity mismatch, expected at least %d, got %d", minar, arity);
if (maxar >= 0 && arity > maxar)
es = janet_formatc("macro arity mismatch, expected at most %d, got %d", maxar, arity);
c->result.macrofiber = NULL;
janetc_error(c, es);
}
/* Set env */
fiberp->env = c->env;
int lock = janet_gclock();
JanetSignal status = janet_pcall(
macro,
janet_tuple_length(form) - 1,
form + 1,
&x,
&fiberp);
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &x);
janet_gcunlock(lock);
if (status != JANET_SIGNAL_OK) {
const uint8_t *es = janet_formatc("(macro) %V", x);

View File

@ -153,9 +153,44 @@ static Janet cfun_rng_int(int32_t argc, Janet *argv) {
}
}
static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
uint32_t word = janet_rng_u32(rng);
buf[0] = word & 0xFF;
buf[1] = (word >> 8) & 0xFF;
buf[2] = (word >> 16) & 0xFF;
buf[3] = (word >> 24) & 0xFF;
}
static Janet cfun_rng_buffer(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
int32_t n = janet_getnat(argv, 1);
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, n);
/* Split into first part (that is divisible by 4), and rest */
int32_t first_part = n & ~3;
int32_t second_part = n - first_part;
/* Get first part in chunks of 4 bytes */
janet_buffer_extra(buffer, n);
uint8_t *buf = buffer->data + buffer->count;
for (int32_t i = 0; i < first_part; i += 4) rng_get_4bytes(rng, buf + i);
buffer->count += first_part;
/* Get remaining 0 - 3 bytes */
if (second_part) {
uint8_t wordbuf[4] = {0};
rng_get_4bytes(rng, wordbuf);
janet_buffer_push_bytes(buffer, wordbuf, second_part);
}
return janet_wrap_buffer(buffer);
}
static const JanetMethod rng_methods[] = {
{"uniform", cfun_rng_uniform},
{"int", cfun_rng_int},
{"buffer", cfun_rng_buffer},
{NULL, NULL}
};
@ -175,8 +210,13 @@ static Janet janet_rand(int32_t argc, Janet *argv) {
/* Seed the random number generator */
static Janet janet_srand(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
int32_t x = janet_getinteger(argv, 0);
janet_rng_seed(&janet_vm_rng, (uint32_t) x);
if (janet_checkint(argv[0])) {
uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
janet_rng_seed(&janet_vm_rng, seed);
} else {
JanetByteView bytes = janet_getbytes(argv, 0);
janet_rng_longseed(&janet_vm_rng, bytes.bytes, bytes.len);
}
return janet_wrap_nil();
}
@ -255,8 +295,8 @@ static const JanetReg math_cfuns[] = {
{
"math/seedrandom", janet_srand,
JDOC("(math/seedrandom seed)\n\n"
"Set the seed for the random number generator. 'seed' should be "
"an integer.")
"Set the seed for the random number generator. seed should be "
"an integer or a buffer.")
},
{
"math/cos", janet_cos,
@ -391,6 +431,12 @@ static const JanetReg math_cfuns[] = {
"Extract a random random integer in the range [0, max] from the RNG. If "
"no max is given, the default is 2^31 - 1.")
},
{
"math/rng-buffer", cfun_rng_buffer,
JDOC("(math/rng-buffer rng n &opt buf)\n\n"
"Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is "
"provided, otherwise appends to the given buffer. Returns the buffer.")
},
{
"math/hypot", janet_hypot,
JDOC("(math/hypot a b)\n\n"
@ -422,6 +468,7 @@ static const JanetReg math_cfuns[] = {
/* Module entry point */
void janet_lib_math(JanetTable *env) {
janet_core_cfuns(env, NULL, math_cfuns);
janet_register_abstract_type(&JanetRNG_type);
#ifdef JANET_BOOTSTRAP
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
JDOC("The value pi."));

View File

@ -25,8 +25,6 @@
#include "util.h"
#endif
#include <stdlib.h>
#ifndef JANET_REDUCED_OS
#include <time.h>
@ -36,6 +34,8 @@
#include <string.h>
#include <sys/stat.h>
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
#ifdef JANET_WINDOWS
#include <windows.h>
#include <direct.h>
@ -473,12 +473,13 @@ static Janet os_sleep(int32_t argc, Janet *argv) {
#ifdef JANET_WINDOWS
Sleep((DWORD)(delay * 1000));
#else
int rc;
struct timespec ts;
ts.tv_sec = (time_t) delay;
ts.tv_nsec = (delay <= UINT32_MAX)
? (long)((delay - ((uint32_t)delay)) * 1000000000)
: 0;
nanosleep(&ts, NULL);
RETRY_EINTR(rc, nanosleep(&ts, &ts));
#endif
return janet_wrap_nil();
}
@ -497,6 +498,64 @@ static Janet os_cwd(int32_t argc, Janet *argv) {
return janet_cstringv(ptr);
}
static Janet os_cryptorand(int32_t argc, Janet *argv) {
JanetBuffer *buffer;
const char *genericerr = "unable to get sufficient random data";
janet_arity(argc, 1, 2);
int32_t offset;
int32_t n = janet_getinteger(argv, 0);
if (n < 0) janet_panic("expected positive integer");
if (argc == 2) {
buffer = janet_getbuffer(argv, 1);
offset = buffer->count;
} else {
offset = 0;
buffer = janet_buffer(n);
}
/* We could optimize here by adding setcount_uninit */
janet_buffer_setcount(buffer, offset + n);
#ifdef JANET_WINDOWS
for (int32_t i = offset; i < buffer->count; i += sizeof(unsigned int)) {
unsigned int v;
if (rand_s(&v))
janet_panic(genericerr);
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < buffer->count); j++) {
buffer->data[i + j] = v & 0xff;
v = v >> 8;
}
}
#elif defined(__linux__) || defined(__APPLE__)
/* We should be able to call getrandom on linux, but it doesn't seem
to be uniformly supported on linux distros. Macos may support
arc4random_buf, but it needs investigation.
In both cases, use this fallback path for now... */
int rc;
int randfd;
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY));
if (randfd < 0)
janet_panic(genericerr);
while (n > 0) {
ssize_t nread;
RETRY_EINTR(nread, read(randfd, buffer->data + offset, n));
if (nread <= 0) {
RETRY_EINTR(rc, close(randfd));
janet_panic(genericerr);
}
offset += nread;
n -= nread;
}
RETRY_EINTR(rc, close(randfd));
#elif defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__)
(void) errmsg;
arc4random_buf(buffer->data + offset, n);
#else
janet_panic("cryptorand currently unsupported on this platform");
#endif
return janet_wrap_buffer(buffer);
}
static Janet os_date(int32_t argc, Janet *argv) {
janet_arity(argc, 0, 2);
(void) argv;
@ -981,6 +1040,11 @@ static const JanetReg os_cfuns[] = {
JDOC("(os/cwd)\n\n"
"Returns the current working directory.")
},
{
"os/cryptorand", os_cryptorand,
JDOC("(os/cryptorand n &opt buf)\n\n"
"Get or append n bytes of good quality random data provided by the os. Returns a new buffer or buf.")
},
{
"os/date", os_date,
JDOC("(os/date &opt time local)\n\n"

View File

@ -888,7 +888,7 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
peg = janet_table_get_ex(grammar, peg, &grammar);
if (!grammar || janet_checktype(peg, JANET_NIL))
peg_panic(b, "unkown rule");
peg_panic(b, "unknown rule");
b->form = peg;
b->grammar = grammar;
}

View File

@ -55,7 +55,11 @@ static JanetSlot qq_slots(JanetFopts opts, JanetSlot *slots, int makeop) {
return target;
}
static JanetSlot quasiquote(JanetFopts opts, Janet x) {
static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
if (depth == 0) {
janetc_cerror(opts.compiler, "quasiquote too deeply nested");
return janetc_cslot(janet_wrap_nil());
}
JanetSlot *slots = NULL;
switch (janet_type(x)) {
default:
@ -66,11 +70,18 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
len = janet_tuple_length(tup);
if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) {
const uint8_t *head = janet_unwrap_symbol(tup[0]);
if (!janet_cstrcmp(head, "unquote"))
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
if (!janet_cstrcmp(head, "unquote")) {
if (level == 0) {
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
} else {
level--;
}
} else if (!janet_cstrcmp(head, "quasiquote")) {
level++;
}
}
for (i = 0; i < len; i++)
janet_v_push(slots, quasiquote(opts, tup[i]));
janet_v_push(slots, quasiquote(opts, tup[i], depth - 1, level));
return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR)
? JOP_MAKE_BRACKET_TUPLE
: JOP_MAKE_TUPLE);
@ -79,7 +90,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
int32_t i;
JanetArray *array = janet_unwrap_array(x);
for (i = 0; i < array->count; i++)
janet_v_push(slots, quasiquote(opts, array->data[i]));
janet_v_push(slots, quasiquote(opts, array->data[i], depth - 1, level));
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
}
case JANET_TABLE:
@ -88,8 +99,8 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
int32_t len, cap = 0;
janet_dictionary_view(x, &kvs, &len, &cap);
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
JanetSlot key = quasiquote(opts, kv->key);
JanetSlot value = quasiquote(opts, kv->value);
JanetSlot key = quasiquote(opts, kv->key, depth - 1, level);
JanetSlot value = quasiquote(opts, kv->value, depth - 1, level);
key.flags &= ~JANET_SLOT_SPLICED;
value.flags &= ~JANET_SLOT_SPLICED;
janet_v_push(slots, key);
@ -106,7 +117,7 @@ static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *a
janetc_cerror(opts.compiler, "expected 1 argument");
return janetc_cslot(janet_wrap_nil());
}
return quasiquote(opts, argv[0]);
return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
}
static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv) {

View File

@ -525,7 +525,8 @@ static const JanetReg string_cfuns[] = {
"Returns a substring from a byte sequence. The substring is from "
"index start inclusive to index end exclusive. All indexing "
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
"from the end of the string.")
"from the end of the string. Note that index -1 is synonymous with "
"index (length bytes) to allow a full negative slice range. ")
},
{
"string/repeat", cfun_string_repeat,

View File

@ -354,15 +354,25 @@ static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
int32_t count;
const Janet *items;
if (janet_indexed_view(argv[0], &items, &count)) {
int32_t realcount = 0;
JanetThread **threads = janet_smalloc(sizeof(JanetThread *) * count);
/* Select on multiple threads */
for (int32_t i = 0; i < count; i++) {
JanetThread *thread = janet_getthread(items, i);
if (thread->rx != NULL) threads[realcount++] = thread;
if (count == 0) {
janet_panics("expected at least 1 thread");
}
if (count == 1) {
JanetThread *thread = janet_getthread(items, 0);
if (NULL == thread->rx) janet_panic("channel has closed");
status = janet_channel_receive(thread->rx, &out, thread->decode, 0);
} else {
/* Select */
int32_t realcount = 0;
JanetThread **threads = janet_smalloc(sizeof(JanetThread *) * count);
/* Select on multiple threads */
for (int32_t i = 0; i < count; i++) {
JanetThread *thread = janet_getthread(items, i);
if (thread->rx != NULL) threads[realcount++] = thread;
}
status = janet_channel_select(realcount, threads, &out);
janet_sfree(threads);
}
status = janet_channel_select(realcount, threads, &out);
janet_sfree(threads);
} else {
/* Get from one thread */
JanetThread *thread = janet_getthread(argv, 0);
@ -411,7 +421,7 @@ static const JanetReg threadlib_cfuns[] = {
{
"thread/receive", cfun_thread_receive,
JDOC("(thread/receive threads)\n\n"
"Get a value sent to thread. Will block if there is no value was sent to this thread "
"Get a value sent to 1 or more threads. Will block if no value was sent to this thread "
"yet. threads can also be an array or tuple of threads, in which case "
"thread/receive will select on the first thread to return a value. Returns "
"the message sent to the thread.")

View File

@ -143,7 +143,10 @@ static const JanetReg tuple_cfuns[] = {
JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
"Take a sub sequence of an array or tuple from index start "
"inclusive to index end exclusive. If start or end are not provided, "
"they default to 0 and the length of arrtup respectively."
"they default to 0 and the length of arrtup respectively. "
"'start' and 'end' can also be negative to indicate indexing "
"from the end of the input. Note that index -1 is synonymous with "
"index '(length arrtup)' to allow a full negative slice range. "
"Returns the new tuple.")
},
{

View File

@ -229,7 +229,8 @@ Janet janet_get(Janet ds, Janet key) {
return (type->get)(abst, key);
}
case JANET_ARRAY:
case JANET_TUPLE: {
case JANET_TUPLE:
case JANET_BUFFER: {
if (!janet_checkint(key)) return janet_wrap_nil();
int32_t index = janet_unwrap_integer(key);
if (index < 0) return janet_wrap_nil();
@ -237,6 +238,10 @@ Janet janet_get(Janet ds, Janet key) {
JanetArray *a = janet_unwrap_array(ds);
if (index >= a->count) return janet_wrap_nil();
return a->data[index];
} else if (t == JANET_BUFFER) {
JanetBuffer *b = janet_unwrap_buffer(ds);
if (index >= b->count) return janet_wrap_nil();
return janet_wrap_integer(b->data[index]);
} else {
const Janet *t = janet_unwrap_tuple(ds);
if (index >= janet_tuple_length(t)) return janet_wrap_nil();

View File

@ -233,9 +233,13 @@ typedef struct {
/***** START SECTION TYPES *****/
#ifdef JANET_WINDOWS
// Must be defined before including stdlib.h
#define _CRT_RAND_S
#endif
#include <stdlib.h>
#include <stdint.h>
#include <string.h>
#include <stdlib.h>
#include <stdarg.h>
#include <setjmp.h>
#include <stddef.h>

View File

@ -55,6 +55,8 @@
(assert (= (get @{} 1) nil) "get nil from empty table")
(assert (= (get {:boop :bap} :boop) :bap) "get non nil from struct")
(assert (= (get @{:boop :bap} :boop) :bap) "get non nil from table")
(assert (= (get @"\0" 0) 0) "get non nil from buffer")
(assert (= (get @"\0" 1) nil) "get nil from buffer oob")
(assert (put @{} :boop :bap) "can add to empty table")
(assert (put @{1 3} :boop :bap) "can add to non-empty table")

View File

@ -208,6 +208,11 @@
(for i 0 75
(test-rng (math/rng (:int seedrng))))
(assert (deep-not= (-> 123 math/rng (:buffer 16))
(-> 456 math/rng (:buffer 16))) "math/rng-buffer 1")
(assert-no-error "math/rng-buffer 2" (math/seedrandom "abcdefg"))
# OS Date test
(assert (deep= {:year-day 0
@ -238,4 +243,38 @@
# Issue #183 - just parse it :)
1e-4000000000000000000000
# Ensure randomness puts n of pred into our buffer eventually
(defn cryptorand-check
[n pred]
(def max-attempts 10000)
(var attempts 0)
(while (not= attempts max-attempts)
(def cryptobuf (os/cryptorand 10))
(when (= n (count pred cryptobuf))
(break))
(++ attempts))
(not= attempts max-attempts))
(def v (math/rng-int (math/rng (os/time)) 100))
(assert (cryptorand-check 0 |(= $ v)) "cryptorand skips value sometimes")
(assert (cryptorand-check 1 |(= $ v)) "cryptorand has value sometimes")
(do
(def buf (buffer/new-filled 1))
(os/cryptorand 1 buf)
(assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer")
(assert (= (length buf) 2) "cryptorand appends to buffer"))
# Nested quasiquotation
(def nested ~(a ~(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
(assert (deep= nested '(a ~(b ,(+ 1 2) ,(foo 4 d) e) f)) "nested quasiquote")
# Top level unquote
(defn constantly
[]
(comptime (math/random)))
(assert (= (constantly) (constantly)) "comptime 1")
(end-suite)

View File

@ -1,4 +1,4 @@
#!/bin/bash
#!/usr/bin/env bash
# Format all code with astyle