calog/tests/testEngineMyBasic.c

// testEngineMyBasic.c -- my-basic on context threads under the actor model. Verifies a
// host native is serviced on the host thread, and that several my-basic contexts run
// concurrently without corruption -- my-basic keeps process-global state, so the engine
// serializes my-basic work with a lock; this is the test that would race without it.
// Built under ASan+UBSan (make test) and ThreadSanitizer (make tsanmb).

#define _POSIX_C_SOURCE 200809L

#include "calog.h"

#include <stdatomic.h>
#include <stdio.h>
#include <time.h>

#define CHECK(cond, msg) checkImpl((cond), (msg), __FILE__, __LINE__)

#define PUMP_LIMIT       4000
#define CONTEXT_COUNT    3

// A value well beyond 32 bits: my-basic's int_t is a 64-bit long long in calog's fork, so this
// round-trips as a literal, through arithmetic, and both across the host boundary. 5e9 > 2^32.
#define WIDE_VALUE       5000000000LL
#define WIDE_ADDEND      1000000000LL
#define WIDE_SUM         (WIDE_VALUE + WIDE_ADDEND)

static CalogT          *calog     = NULL;
static _Atomic int32_t  bumpCount = 0;
static _Atomic uint64_t bumpCtxId = 0xFFFFu;
static _Atomic int64_t  reportedValue = 0;
static int32_t          testsRun    = 0;
static int32_t          testsFailed = 0;

static int32_t blobEcho(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t blobLen(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t bump(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void    checkImpl(bool condition, const char *message, const char *file, int32_t line);
static int64_t evalAndReport(const char *script);
static int32_t makeBlob(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t makeBlob2(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeAdd(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeGetAdder(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeGetWide(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t report(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void    testBinaryStrings(void);
static void    testConcurrentContexts(void);
static void    testForeignFunction(void);
static void    testHostNative(void);
static void    testWideInteger(void);


static int32_t blobEcho(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
    (void)userData;
    calogValueNil(result);
    if (argCount != 1 || args[0].type != calogStringE) {
        return calogFail(result, calogErrArgE, "blobEcho expects one string");
    }
    // Hand the same bytes straight back; the script re-ingresses them, exercising the egress ->
    // ingress round-trip for a binary buffer (the httpd tcpRecv -> manipulate -> tcpSend path).
    return calogValueString(result, args[0].as.s.bytes, args[0].as.s.length);
}


static int32_t blobLen(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
    (void)userData;
    calogValueNil(result);
    if (argCount != 1 || args[0].type != calogStringE) {
        return calogFail(result, calogErrArgE, "blobLen expects one string");
    }
    // Reports the egress byte length: a byte buffer must arrive as a length-3 string, not truncated
    // to length 1 at the embedded NUL.
    calogValueInt(result, args[0].as.s.length);
    return calogOkE;
}


static int32_t bump(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
    (void)args;
    (void)argCount;
    (void)userData;
    atomic_store(&bumpCtxId, calogCurrentId());
    atomic_fetch_add(&bumpCount, 1);
    calogValueNil(result);
    return calogOkE;
}


static void checkImpl(bool condition, const char *message, const char *file, int32_t line) {
    testsRun++;
    if (!condition) {
        testsFailed++;
        printf("FAIL %s:%d  %s\n", file, line, message);
    }
}


// Open a fresh my-basic context, run `script` (which must end by calling bump()), pump until it
// finishes, and return whatever the script last handed to report(). Serialises the boilerplate the
// foreign-function and wide-integer tests share.
static int64_t evalAndReport(const char *script) {
    CalogContextT  *ctx;
    struct timespec ts = { 0, 500000 };
    int32_t         i;

    ctx = calogContextOpen(calog, &calogMyBasicEngine);
    atomic_store(&bumpCount, 0);
    atomic_store(&reportedValue, 0);
    calogContextEval(ctx, script);
    for (i = 0; i < PUMP_LIMIT && atomic_load(&bumpCount) < 1; i++) {
        calogPump(calog);
        nanosleep(&ts, NULL);
    }
    calogContextClose(ctx);
    return atomic_load(&reportedValue);
}


static int32_t makeBlob(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
    (void)args;
    (void)argCount;
    (void)userData;
    // A 3-byte binary value with an embedded NUL ('a', 0x00, 'b'). Because it holds a NUL, it
    // ingresses to my-basic as a byte buffer rather than a (truncated) string.
    return calogValueString(result, "a\0b", 3);
}


static int32_t makeBlob2(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
    (void)args;
    (void)argCount;
    (void)userData;
    // Same length as makeBlob() but differs only AFTER the NUL, so a NUL-terminated compare would
    // wrongly call it equal -- the byte compare must look past the NUL.
    return calogValueString(result, "a\0c", 3);
}


static int32_t nativeAdd(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
    (void)userData;
    calogValueNil(result);
    if (argCount != 2 || args[0].type != calogIntE || args[1].type != calogIntE) {
        return calogFail(result, calogErrArgE, "add expects two integers");
    }
    calogValueInt(result, args[0].as.i + args[1].as.i);
    return calogOkE;
}


static int32_t nativeGetAdder(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
    CalogFnT *callable;
    int32_t   status;

    (void)args;
    (void)argCount;
    (void)userData;
    calogValueNil(result);
    // Hand the script a host-owned function value; invoking it from BASIC routes back to nativeAdd.
    status = calogFnFromNative(&callable, calog, nativeAdd, NULL);
    if (status != calogOkE) {
        return calogFail(result, status, "getAdder could not allocate");
    }
    calogValueFn(result, callable);
    return calogOkE;
}


static int32_t nativeGetWide(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
    (void)args;
    (void)argCount;
    (void)userData;
    // A 64-bit value handed into the script, to prove ingress no longer clamps at 2^31.
    calogValueInt(result, WIDE_VALUE);
    return calogOkE;
}


static int32_t report(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
    (void)userData;
    calogValueNil(result);
    if (argCount != 1 || args[0].type != calogIntE) {
        return calogFail(result, calogErrArgE, "report expects one integer");
    }
    atomic_store(&reportedValue, args[0].as.i);
    return calogOkE;
}


// Binary byte buffers: my-basic's faithful handling of calog strings that carry embedded NUL bytes,
// via the adapter's usertype-ref BYTE type. Non-zero sentinels (42, 11) are reported on success so a
// script that errored (leaving reportedValue at 0) fails the check instead of passing silently.
static void testBinaryStrings(void) {
    int64_t got;

    // Egress: a byte buffer handed to a native arrives as a full length-3 string, not truncated to 1.
    got = evalAndReport("report(blobLen(makeBlob()))\nbump()");
    CHECK(got == 3, "a byte buffer egresses to the host as a full-length binary string");

    // byteLen sees the true byte count.
    got = evalAndReport("b = makeBlob()\nreport(byteLen(b))\nbump()");
    CHECK(got == 3, "byteLen reports the full length including the embedded NUL");

    // byteAt reads every byte, the embedded NUL included.
    got = evalAndReport(
        "b = makeBlob()\n"
        "r = 0\n"
        "IF byteAt(b, 0) = 97 THEN\n"
        "IF byteAt(b, 1) = 0 THEN\n"
        "IF byteAt(b, 2) = 98 THEN\n"
        "r = 42\n"
        "ENDIF\nENDIF\nENDIF\n"
        "report(r)\nbump()");
    CHECK(got == 42, "byteAt reads each byte including the embedded NUL as 0");

    // '+' concatenates byte buffers and the interior NUL survives.
    got = evalAndReport(
        "b = makeBlob()\n"
        "c = b + b\n"
        "r = 0\n"
        "IF byteLen(c) = 6 THEN\n"
        "IF byteAt(c, 4) = 0 THEN\n"
        "IF byteAt(c, 3) = 97 THEN\n"
        "r = 42\n"
        "ENDIF\nENDIF\nENDIF\n"
        "report(r)\nbump()");
    CHECK(got == 42, "the + operator concatenates byte buffers and preserves the interior NUL");

    // Mixed concat: a text prefix plus a binary body (the httpd response-building case).
    got = evalAndReport(
        "b = makeBlob()\n"
        "c = \"X\" + b\n"
        "r = 0\n"
        "IF byteLen(c) = 4 THEN\n"
        "IF byteAt(c, 0) = 88 THEN\n"
        "r = 42\n"
        "ENDIF\nENDIF\n"
        "report(r)\nbump()");
    CHECK(got == 42, "a string prefix concatenates with a byte buffer (string + bytes)");

    // Content equality via the fork's comparison patch: distinct buffers, identical bytes.
    got = evalAndReport("b = makeBlob()\nd = makeBlob()\nIF b = d THEN\nreport(11)\nELSE\nreport(22)\nENDIF\nbump()");
    CHECK(got == 11, "= compares byte buffers by content (equal content compares equal)");

    // ...and buffers that differ only past the NUL compare unequal.
    got = evalAndReport("b = makeBlob()\ne = makeBlob2()\nIF b = e THEN\nreport(11)\nELSE\nreport(22)\nENDIF\nbump()");
    CHECK(got == 22, "= distinguishes byte buffers that differ only after the NUL");

    // A byte buffer works as a content-addressed dict key (the hash and cmp hooks agree).
    got = evalAndReport(
        "m = DICT()\n"
        "b = makeBlob()\n"
        "e = makeBlob2()\n"
        "SET(m, b, 10)\n"
        "SET(m, e, 20)\n"
        "report(GET(m, makeBlob()))\nbump()");
    CHECK(got == 10, "a byte buffer is a content-addressed dict key");

    // byteSlice extracts a sub-range, NUL included, clamped to the buffer.
    got = evalAndReport(
        "b = makeBlob()\n"
        "s = byteSlice(b, 1, 2)\n"
        "r = 0\n"
        "IF byteLen(s) = 2 THEN\n"
        "IF byteAt(s, 0) = 0 THEN\n"
        "IF byteAt(s, 1) = 98 THEN\n"
        "r = 42\n"
        "ENDIF\nENDIF\nENDIF\n"
        "report(r)\nbump()");
    CHECK(got == 42, "byteSlice extracts a byte sub-range spanning the NUL");

    // byteConcat joins several parts (byte buffers and strings) into one buffer.
    got = evalAndReport("report(byteLen(byteConcat(makeBlob(), \"X\", makeBlob())))\nbump()");
    CHECK(got == 7, "byteConcat joins byte buffers and strings (3 + 1 + 3 = 7)");

    // Round-trip: egress to a native and back keeps the bytes.
    got = evalAndReport("report(byteLen(blobEcho(makeBlob())))\nbump()");
    CHECK(got == 3, "a byte buffer round-trips out to a native and back intact");

    // strToByte / byteToStr round-trip NUL-free text.
    got = evalAndReport("IF byteToStr(strToByte(\"hi\")) = \"hi\" THEN\nreport(11)\nELSE\nreport(22)\nENDIF\nbump()");
    CHECK(got == 11, "strToByte and byteToStr round-trip NUL-free text");
}


static void testConcurrentContexts(void) {
    CalogContextT  *ctxs[CONTEXT_COUNT];
    struct timespec ts = { 0, 500000 };
    int32_t         i;

    // The scripts allocate (list creation) as they run so the parallel execution paths
    // churn my-basic's now-atomic allocation counter concurrently -- the case that
    // raced before the vendored patch (see make tsanmb).
    atomic_store(&bumpCount, 0);
    for (i = 0; i < CONTEXT_COUNT; i++) {
        ctxs[i] = calogContextOpen(calog, &calogMyBasicEngine);
        calogContextEval(ctxs[i], "a = list(1, 2, 3)\nb = list(4, 5, 6)\nbump()");
    }
    for (i = 0; i < PUMP_LIMIT && atomic_load(&bumpCount) < CONTEXT_COUNT; i++) {
        calogPump(calog);
        nanosleep(&ts, NULL);
    }
    CHECK(atomic_load(&bumpCount) == CONTEXT_COUNT, "several concurrent my-basic contexts all reached the host native");
    for (i = 0; i < CONTEXT_COUNT; i++) {
        calogContextClose(ctxs[i]);
    }
}


static void testForeignFunction(void) {
    int64_t got;

    // getAdder() yields a host callable; calogInvoke(fn, ...) calls it from BASIC. This is the
    // my-basic side of function-into-script -- the fork's usertype-ref + calogInvoke native.
    got = evalAndReport("f = getAdder()\nreport(calogInvoke(f, 2, 3))\nbump()");
    CHECK(got == 5, "my-basic invoked a host function value handed into the script");
}


static void testHostNative(void) {
    CalogContextT  *ctx;
    struct timespec ts = { 0, 500000 };
    int32_t         i;

    ctx = calogContextOpen(calog, &calogMyBasicEngine);
    CHECK(ctx != NULL, "opened a my-basic context");
    atomic_store(&bumpCount, 0);
    calogContextEval(ctx, "bump()");
    for (i = 0; i < PUMP_LIMIT && atomic_load(&bumpCount) < 1; i++) {
        calogPump(calog);
        nanosleep(&ts, NULL);
    }
    CHECK(atomic_load(&bumpCount) == 1, "the my-basic script's native call ran");
    CHECK(atomic_load(&bumpCtxId) == 0, "the native ran on the host thread (id 0)");
    calogContextClose(ctx);
}


static void testWideInteger(void) {
    int64_t got;

    // A >2^32 literal: exercises strtoll parsing and the 64-bit int_t, then egress to the host.
    got = evalAndReport("report(5000000000)\nbump()");
    CHECK(got == WIDE_VALUE, "my-basic parsed and returned a 64-bit integer literal");

    // Ingress (getWide, no clamp) + 64-bit arithmetic in BASIC + egress back to the host.
    got = evalAndReport("report(getWide() + 1000000000)\nbump()");
    CHECK(got == WIDE_SUM, "my-basic round-tripped a 64-bit value through arithmetic");

    // ABS() must use llabs, not the 32-bit C abs(), now that int_t is 64-bit.
    got = evalAndReport("report(ABS(0 - 5000000000))\nbump()");
    CHECK(got == WIDE_VALUE, "my-basic ABS() preserves a 64-bit magnitude (no int truncation)");
}


int main(void) {
    calog = calogCreate();
    if (calog == NULL) {
        printf("calog create failed\n");
        return 1;
    }
    calogRegister(calog, "blobEcho", blobEcho, NULL);
    calogRegister(calog, "blobLen", blobLen, NULL);
    calogRegister(calog, "bump", bump, NULL);
    calogRegister(calog, "getAdder", nativeGetAdder, NULL);
    calogRegister(calog, "getWide", nativeGetWide, NULL);
    calogRegister(calog, "makeBlob", makeBlob, NULL);
    calogRegister(calog, "makeBlob2", makeBlob2, NULL);
    calogRegister(calog, "report", report, NULL);

    testHostNative();
    testConcurrentContexts();
    testForeignFunction();
    testWideInteger();
    testBinaryStrings();

    calogDestroy(calog);

    printf("\n%d checks, %d failed\n", testsRun, testsFailed);
    fflush(stdout);
    if (testsFailed != 0) {
        return 1;
    }
    return 0;
}