mirror of
https://github.com/janet-lang/janet
synced 2024-11-29 03:19:54 +00:00
Merge branch 'master' into ev
This commit is contained in:
Calvin Rose
commit
ce2079104a
@ -667,6 +667,68 @@
|
||||
[xs]
|
||||
(get xs (- (length xs) 1)))
|
||||
|
||||
## Polymorphic comparisons
|
||||
|
||||
(defn compare-primitive
|
||||
"Compare x and y using primitive operators.
|
||||
Returns -1,0,1 for x < y, x = y, x > y respectively.
|
||||
Present mostly for constructing 'compare' methods in prototypes."
|
||||
[x y]
|
||||
(cond
|
||||
(= x y) 0
|
||||
(< x y) -1
|
||||
(> x y) 1))
|
||||
|
||||
(defn compare
|
||||
"Polymorphic compare. Returns -1,0,1 for x < y, x = y, x > y respectively.
|
||||
Differs from the primitive comparators in that it first checks to
|
||||
see whether either x or y implement a 'compare' method which can
|
||||
compare x and y. If so it uses that compare method. If not, it
|
||||
delegates to the primitive comparators."
|
||||
[x y]
|
||||
(or
|
||||
(when-let [f (get x :compare)] (f x y))
|
||||
(when-let [f (get y :compare)
|
||||
fyx (f y x)] (- fyx))
|
||||
(compare-primitive x y)))
|
||||
|
||||
(defn- compare-reduce [op xs]
|
||||
(var r true)
|
||||
(loop [i :range [0 (- (length xs) 1)]
|
||||
:let [c (compare (xs i) (xs (+ i 1)))
|
||||
ok (op c 0)]
|
||||
:when (not ok)]
|
||||
(set r false)
|
||||
(break))
|
||||
r)
|
||||
|
||||
(defn compare=
|
||||
"Equivalent of '=' but using compare function instead of primitive comparator"
|
||||
[& xs]
|
||||
(compare-reduce = xs))
|
||||
|
||||
(defn compare<
|
||||
"Equivalent of '<' but using compare function instead of primitive comparator"
|
||||
[& xs]
|
||||
(compare-reduce < xs))
|
||||
|
||||
(defn compare<=
|
||||
"Equivalent of '<=' but using compare function instead of primitive comparator"
|
||||
[& xs]
|
||||
(compare-reduce <= xs))
|
||||
|
||||
(defn compare>
|
||||
"Equivalent of '>' but using compare function instead of primitive comparator"
|
||||
[& xs]
|
||||
(compare-reduce > xs))
|
||||
|
||||
(defn compare>=
|
||||
"Equivalent of '>=' but using compare function instead of primitive comparator"
|
||||
[& xs]
|
||||
(compare-reduce >= xs))
|
||||
|
||||
(put _env 'compare-reduce nil)
|
||||
|
||||
###
|
||||
###
|
||||
### Indexed Combinators
|
||||
|
||||
@ -197,6 +197,122 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||
}
|
||||
|
||||
// Code to support polymorphic comparison.
|
||||
//
|
||||
// int/u64 and int/s64 support a "compare" method that allows
|
||||
// comparison to each other, and to Janet numbers, using the
|
||||
// "compare" "compare<" ... functions.
|
||||
//
|
||||
// In the following code explicit casts are sometimes used to help
|
||||
// make it clear when int/float conversions are happening.
|
||||
//
|
||||
static int64_t compare_double_double(double x, double y) {
|
||||
return (x < y) ? -1 : ((x > y) ? 1 : 0);
|
||||
}
|
||||
|
||||
static int64_t compare_int64_double(int64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if ((y > ((double) - MAX_INT_IN_DBL)) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) INT64_MAX)) {
|
||||
return -1;
|
||||
} else if (y < ((double) INT64_MIN)) {
|
||||
return 1;
|
||||
} else {
|
||||
int64_t yi = (int64_t) y;
|
||||
return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
|
||||
}
|
||||
}
|
||||
|
||||
static int64_t compare_uint64_double(uint64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if (y < 0) {
|
||||
return 1;
|
||||
} else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) UINT64_MAX)) {
|
||||
return -1;
|
||||
} else {
|
||||
uint64_t yi = (uint64_t) y;
|
||||
return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_S64)
|
||||
janet_panic("compare method requires int/s64 as first argument");
|
||||
int64_t x = janet_unwrap_s64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double y = janet_unwrap_number(argv[1]);
|
||||
return janet_wrap_number(compare_int64_double(x, y));
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(argv[1]);
|
||||
if (janet_abstract_type(abst) == &janet_s64_type) {
|
||||
int64_t y = *(int64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_u64_type) {
|
||||
// comparing signed to unsigned -- be careful!
|
||||
uint64_t y = *(uint64_t *)abst;
|
||||
if (x < 0) {
|
||||
return janet_wrap_number(-1);
|
||||
} else if (y > INT64_MAX) {
|
||||
return janet_wrap_number(-1);
|
||||
} else {
|
||||
int64_t y2 = (int64_t) y;
|
||||
return janet_wrap_number((x < y2) ? -1 : (x > y2 ? 1 : 0));
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_U64) // is this needed?
|
||||
janet_panic("compare method requires int/u64 as first argument");
|
||||
uint64_t x = janet_unwrap_u64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double y = janet_unwrap_number(argv[1]);
|
||||
return janet_wrap_number(compare_uint64_double(x, y));
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(argv[1]);
|
||||
if (janet_abstract_type(abst) == &janet_u64_type) {
|
||||
uint64_t y = *(uint64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_s64_type) {
|
||||
// comparing unsigned to signed -- be careful!
|
||||
int64_t y = *(int64_t *)abst;
|
||||
if (y < 0) {
|
||||
return janet_wrap_number(1);
|
||||
} else if (x > INT64_MAX) {
|
||||
return janet_wrap_number(1);
|
||||
} else {
|
||||
int64_t x2 = (int64_t) x;
|
||||
return janet_wrap_number((x2 < y) ? -1 : (x2 > y ? 1 : 0));
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#define OPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
@ -266,14 +382,6 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define COMPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T v1 = janet_unwrap_##type(argv[0]); \
|
||||
T v2 = janet_unwrap_##type(argv[1]); \
|
||||
return janet_wrap_boolean(v1 oper v2); \
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
@ -316,13 +424,6 @@ OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
OPMETHOD(int64_t, s64, lshift, <<)
|
||||
OPMETHOD(int64_t, s64, rshift, >>)
|
||||
COMPMETHOD(int64_t, s64, lt, <)
|
||||
COMPMETHOD(int64_t, s64, gt, >)
|
||||
COMPMETHOD(int64_t, s64, le, <=)
|
||||
COMPMETHOD(int64_t, s64, ge, >=)
|
||||
COMPMETHOD(int64_t, s64, eq, ==)
|
||||
COMPMETHOD(int64_t, s64, ne, !=)
|
||||
|
||||
OPMETHOD(uint64_t, u64, add, +)
|
||||
OPMETHOD(uint64_t, u64, sub, -)
|
||||
OPMETHODINVERT(uint64_t, u64, subi, -)
|
||||
@ -336,18 +437,13 @@ OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
OPMETHOD(uint64_t, u64, lshift, <<)
|
||||
OPMETHOD(uint64_t, u64, rshift, >>)
|
||||
COMPMETHOD(uint64_t, u64, lt, <)
|
||||
COMPMETHOD(uint64_t, u64, gt, >)
|
||||
COMPMETHOD(uint64_t, u64, le, <=)
|
||||
COMPMETHOD(uint64_t, u64, ge, >=)
|
||||
COMPMETHOD(uint64_t, u64, eq, ==)
|
||||
COMPMETHOD(uint64_t, u64, ne, !=)
|
||||
|
||||
#undef OPMETHOD
|
||||
#undef DIVMETHOD
|
||||
#undef DIVMETHOD_SIGNED
|
||||
#undef COMPMETHOD
|
||||
|
||||
|
||||
static JanetMethod it_s64_methods[] = {
|
||||
{"+", cfun_it_s64_add},
|
||||
{"r+", cfun_it_s64_add},
|
||||
@ -361,12 +457,6 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"rmod", cfun_it_s64_modi},
|
||||
{"%", cfun_it_s64_rem},
|
||||
{"r%", cfun_it_s64_remi},
|
||||
{"<", cfun_it_s64_lt},
|
||||
{">", cfun_it_s64_gt},
|
||||
{"<=", cfun_it_s64_le},
|
||||
{">=", cfun_it_s64_ge},
|
||||
{"=", cfun_it_s64_eq},
|
||||
{"!=", cfun_it_s64_ne},
|
||||
{"&", cfun_it_s64_and},
|
||||
{"r&", cfun_it_s64_and},
|
||||
{"|", cfun_it_s64_or},
|
||||
@ -375,6 +465,7 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"r^", cfun_it_s64_xor},
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
{"compare", cfun_it_s64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
@ -392,12 +483,6 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"rmod", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_modi},
|
||||
{"<", cfun_it_u64_lt},
|
||||
{">", cfun_it_u64_gt},
|
||||
{"<=", cfun_it_u64_le},
|
||||
{">=", cfun_it_u64_ge},
|
||||
{"=", cfun_it_u64_eq},
|
||||
{"!=", cfun_it_u64_ne},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
@ -406,6 +491,7 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"r^", cfun_it_u64_xor},
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
{"compare", cfun_it_u64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
@ -1224,17 +1224,16 @@ static Janet os_rename(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet os_realpath(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
#ifdef JANET_NO_REALPATH
|
||||
(void) argv;
|
||||
janet_panic("os/realpath not supported on this platform");
|
||||
#else
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
char *dest = _fullpath(NULL, src, _MAX_PATH);
|
||||
#else
|
||||
char *dest = realpath(src, NULL);
|
||||
#endif
|
||||
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
|
||||
Janet ret = janet_cstringv(dest);
|
||||
free(dest);
|
||||
return ret;
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_permission_string(int32_t argc, Janet *argv) {
|
||||
|
||||
@ -206,6 +206,29 @@ tail:
|
||||
return (result) ? NULL : text;
|
||||
}
|
||||
|
||||
case RULE_THRU:
|
||||
case RULE_TO: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
const uint8_t *next_text;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
while (text < s->text_end) {
|
||||
CapState cs2 = cap_save(s);
|
||||
next_text = peg_rule(s, rule_a, text);
|
||||
if (next_text) {
|
||||
if (rule[0] == RULE_TO) cap_load(s, cs2);
|
||||
break;
|
||||
}
|
||||
text++;
|
||||
}
|
||||
up1(s);
|
||||
if (text >= s->text_end) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
return rule[0] == RULE_TO ? text : next_text;
|
||||
}
|
||||
|
||||
case RULE_BETWEEN: {
|
||||
uint32_t lo = rule[1];
|
||||
uint32_t hi = rule[2];
|
||||
@ -765,6 +788,12 @@ static void spec_error(Builder *b, int32_t argc, const Janet *argv) {
|
||||
static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_DROP);
|
||||
}
|
||||
static void spec_to(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_TO);
|
||||
}
|
||||
static void spec_thru(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_THRU);
|
||||
}
|
||||
|
||||
/* Rule of the form [rule, tag] */
|
||||
static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
|
||||
@ -895,6 +924,8 @@ static const SpecialPair peg_specials[] = {
|
||||
{"sequence", spec_sequence},
|
||||
{"set", spec_set},
|
||||
{"some", spec_some},
|
||||
{"thru", spec_thru},
|
||||
{"to", spec_to},
|
||||
};
|
||||
|
||||
/* Compile a janet value into a rule and return the rule index. */
|
||||
@ -997,6 +1028,14 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
const Janet *tup = janet_unwrap_tuple(peg);
|
||||
int32_t len = janet_tuple_length(tup);
|
||||
if (len == 0) peg_panic(b, "tuple in grammar must have non-zero length");
|
||||
if (janet_checkint(tup[0])) {
|
||||
int32_t n = janet_unwrap_integer(tup[0]);
|
||||
if (n < 0) {
|
||||
peg_panicf(b, "expected non-negative integer, got %d", n);
|
||||
}
|
||||
spec_repeat(b, len, tup);
|
||||
break;
|
||||
}
|
||||
if (!janet_checktype(tup[0], JANET_SYMBOL))
|
||||
peg_panicf(b, "expected grammar command, found %v", tup[0]);
|
||||
const uint8_t *sym = janet_unwrap_symbol(tup[0]);
|
||||
@ -1180,6 +1219,8 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
case RULE_ERROR:
|
||||
case RULE_DROP:
|
||||
case RULE_NOT:
|
||||
case RULE_TO:
|
||||
case RULE_THRU:
|
||||
/* [rule] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
|
||||
@ -138,11 +138,6 @@ extern "C" {
|
||||
#define JANET_NO_UTC_MKTIME
|
||||
#endif
|
||||
|
||||
/* Add some windows flags */
|
||||
#ifdef JANET_WINDOWS
|
||||
#define JANET_NO_REALPATH
|
||||
#endif
|
||||
|
||||
/* Define how global janet state is declared */
|
||||
#ifdef JANET_SINGLE_THREADED
|
||||
#define JANET_THREAD_LOCAL
|
||||
@ -1658,6 +1653,8 @@ typedef enum {
|
||||
RULE_ERROR, /* [rule] */
|
||||
RULE_DROP, /* [rule] */
|
||||
RULE_BACKMATCH, /* [tag] */
|
||||
RULE_TO, /* [rule] */
|
||||
RULE_THRU, /* [rule] */
|
||||
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
|
||||
} JanetPegOpcode;
|
||||
|
||||
|
||||
@ -334,5 +334,86 @@
|
||||
(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
|
||||
(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3)) "table constructor duplicate keys")
|
||||
|
||||
## Polymorphic comparison -- Issue #272
|
||||
|
||||
# confirm polymorphic comparison delegation to primitive comparators:
|
||||
(assert (= 0 (compare-primitive 3 3)) "compare-primitive integers (1)")
|
||||
(assert (= -1 (compare-primitive 3 5)) "compare-primitive integers (2)")
|
||||
(assert (= 1 (compare-primitive "foo" "bar")) "compare-primitive strings")
|
||||
(assert (= 0 (compare 1 1)) "compare integers (1)")
|
||||
(assert (= -1 (compare 1 2)) "compare integers (2)")
|
||||
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
|
||||
|
||||
(assert (compare< 1 2 3 4 5 6) "compare less than integers")
|
||||
(assert (not (compare> 1 2 3 4 5 6)) "compare not greater than integers")
|
||||
(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
|
||||
(assert (compare> 6 5 4 3 2 1) "compare greater than integers")
|
||||
(assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
|
||||
(assert (not (compare< 6.0 5.0 4.0 3.0 2.0 1.0)) "compare less than reals")
|
||||
(assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
|
||||
(assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "compare less than or equal to reals")
|
||||
(assert (compare>= 6 5 4 4 3 2 1) "compare greater than or equal to integers")
|
||||
(assert (compare>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "compare greater than or equal to reals")
|
||||
(assert (compare< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
"hi"
|
||||
(quote hello)
|
||||
:hello
|
||||
(array 1 2 3)
|
||||
(tuple 1 2 3)
|
||||
(table "a" "b" "c" "d")
|
||||
(struct 1 2 3 4)
|
||||
(buffer "hi")
|
||||
(fn [x] (+ x x))
|
||||
print) "compare type ordering")
|
||||
|
||||
# test polymorphic compare with 'objects' (table/setproto)
|
||||
(def mynum
|
||||
@{:type :mynum :v 0 :compare
|
||||
(fn [self other]
|
||||
(case (type other)
|
||||
:number (compare-primitive (self :v) other)
|
||||
:table (when (= (get other :type) :mynum)
|
||||
(compare-primitive (self :v) (other :v)))))})
|
||||
|
||||
(let [n3 (table/setproto @{:v 3} mynum)]
|
||||
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
|
||||
(assert (= -1 (compare n3 4)) "compare object to num (2)")
|
||||
(assert (= 1 (compare (table/setproto @{:v 4} mynum) n3)) "compare object to object")
|
||||
(assert (compare< 2 n3 4) "compare< poly")
|
||||
(assert (compare> 4 n3 2) "compare> poly")
|
||||
(assert (compare<= 2 3 n3 4) "compare<= poly")
|
||||
(assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
|
||||
(assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
|
||||
|
||||
(let [
|
||||
MAX_INT_64_STRING "9223372036854775807"
|
||||
MAX_UINT_64_STRING "18446744073709551615"
|
||||
MAX_INT_IN_DBL_STRING "9007199254740991"
|
||||
NAN (math/log -1)
|
||||
INF (/ 1 0)
|
||||
MINUS_INF (/ -1 0)
|
||||
|
||||
compare-poly-tests
|
||||
[
|
||||
[(int/s64 3) (int/u64 3) 0]
|
||||
[(int/s64 -3) (int/u64 3) -1]
|
||||
[(int/s64 3) (int/u64 2) 1]
|
||||
[(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
|
||||
[(int/u64 3) 3 0] [(int/u64 3) 4 -1] [(int/u64 3) -9 1]
|
||||
[3 (int/s64 3) 0] [3 (int/s64 4) -1] [3 (int/s64 -5) 1]
|
||||
[3 (int/u64 3) 0] [3 (int/u64 4) -1] [3 (int/u64 2) 1]
|
||||
[(int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING) -1]
|
||||
[(int/s64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
|
||||
[(int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
|
||||
[(+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING) 1]
|
||||
[(int/s64 0) INF -1] [(int/u64 0) INF -1]
|
||||
[MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
|
||||
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]
|
||||
]]
|
||||
(each [x y c] compare-poly-tests
|
||||
(assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c)))
|
||||
)
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@ -288,4 +288,23 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
# Issue #412
|
||||
(assert (peg/match '(* "a" (> -1 "a") "b") "abc") "lookhead does not move cursor")
|
||||
|
||||
(def peg3
|
||||
~{:main (* "(" (thru ")"))})
|
||||
|
||||
(def peg4 (peg/compile ~(* (thru "(") '(to ")"))))
|
||||
|
||||
(assert (peg/match peg3 "(12345)") "peg thru 1")
|
||||
(assert (not (peg/match peg3 " (12345)")) "peg thru 2")
|
||||
(assert (not (peg/match peg3 "(12345")) "peg thru 3")
|
||||
|
||||
(assert (= "abc" (0 (peg/match peg4 "123(abc)"))) "peg thru/to 1")
|
||||
(assert (= "abc" (0 (peg/match peg4 "(abc)"))) "peg thru/to 2")
|
||||
(assert (not (peg/match peg4 "123(abc")) "peg thru/to 3")
|
||||
|
||||
(def peg5 (peg/compile [3 "abc"]))
|
||||
|
||||
(assert (:match peg5 "abcabcabc") "repeat alias 1")
|
||||
(assert (:match peg5 "abcabcabcac") "repeat alias 2")
|
||||
(assert (not (:match peg5 "abcabc")) "repeat alias 3")
|
||||
|
||||
(end-suite)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user