411 lines
14 KiB
C
411 lines
14 KiB
C
// testEngineS7.c -- s7 Scheme on a context thread, driven the host way: register
|
|
// natives, open a context, fire-and-forget a script, and calogPump on the host thread.
|
|
// Verifies host-thread dispatch, the inline escape hatch, the sec-10 cross-thread
|
|
// callback, the error handler, and concurrent contexts.
|
|
|
|
#define _POSIX_C_SOURCE 200809L
|
|
|
|
#include "calog.h"
|
|
|
|
#include <stdatomic.h>
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
#include <time.h>
|
|
|
|
#define CHECK(cond, msg) checkImpl((cond), (msg), __FILE__, __LINE__)
|
|
|
|
#define PUMP_LIMIT 4000
|
|
|
|
// s7 keeps a small, bounded set of interned "permanent" strings that s7_free
|
|
// intentionally does not reclaim (its memory model favors one long-lived interpreter).
|
|
// That is an s7 characteristic, not a calog defect, so suppress exactly that allocation
|
|
// site to keep the leak check meaningful. LSan calls this weak hook automatically.
|
|
const char *__lsan_default_suppressions(void);
|
|
const char *__lsan_default_suppressions(void) {
|
|
return "leak:make_permanent_string\n";
|
|
}
|
|
|
|
static CalogT *calog = NULL;
|
|
static _Atomic int64_t reportedValue = 0;
|
|
static _Atomic uint64_t reportedCtxId = 0xFFFFu;
|
|
static _Atomic uint64_t inlineCtxId = 0xFFFFu;
|
|
static _Atomic int32_t bumpCount = 0;
|
|
static _Atomic bool scriptDone = false;
|
|
static _Atomic int32_t errorCount = 0;
|
|
static _Atomic uint64_t errorCtxId = 0;
|
|
static CalogFnT *_Atomic storedCb = NULL;
|
|
static char storedName[32] = { 0 };
|
|
static _Atomic int32_t nameLen = -1;
|
|
static int32_t testsRun = 0;
|
|
static int32_t testsFailed = 0;
|
|
|
|
static void checkImpl(bool condition, const char *message, const char *file, int32_t line);
|
|
static int32_t nativeAdd(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
|
|
static int32_t nativeBump(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
|
|
static int32_t nativeDone(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 nativeMakeUser(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
|
|
static int32_t nativeMapAge(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
|
|
static int32_t nativeReport(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
|
|
static int32_t nativeReportInline(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
|
|
static int32_t nativeReportName(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
|
|
static int32_t nativeSetCb(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
|
|
static void onError(uint64_t contextId, const char *message, void *userData);
|
|
static void pumpUntilDone(void);
|
|
static void testConcurrentContexts(void);
|
|
static void testCrossThreadCallback(void);
|
|
static void testForeignFunction(void);
|
|
static void testHostAndInlineNatives(void);
|
|
static void testMapIngress(void);
|
|
static void testMaterializedRecord(void);
|
|
static void testScriptError(void);
|
|
|
|
|
|
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);
|
|
}
|
|
}
|
|
|
|
|
|
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 nativeBump(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
|
|
(void)args;
|
|
(void)argCount;
|
|
(void)userData;
|
|
atomic_fetch_add(&bumpCount, 1);
|
|
calogValueNil(result);
|
|
return calogOkE;
|
|
}
|
|
|
|
|
|
static int32_t nativeDone(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
|
|
(void)args;
|
|
(void)argCount;
|
|
(void)userData;
|
|
atomic_store(&scriptDone, true);
|
|
calogValueNil(result);
|
|
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);
|
|
// A host-owned function value handed to the script; calling it routes back here.
|
|
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 nativeMakeUser(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
|
|
CalogAggT *user;
|
|
CalogValueT key;
|
|
CalogValueT val;
|
|
int32_t status;
|
|
|
|
(void)args;
|
|
(void)argCount;
|
|
(void)userData;
|
|
calogValueNil(result);
|
|
status = calogAggCreate(&user, calogMapE);
|
|
if (status != calogOkE) {
|
|
return calogFail(result, status, "makeUser could not allocate");
|
|
}
|
|
calogValueString(&key, "name", 4);
|
|
calogValueString(&val, "ada", 3);
|
|
calogAggSet(user, &key, &val);
|
|
calogValueString(&key, "age", 3);
|
|
calogValueInt(&val, 36);
|
|
calogAggSet(user, &key, &val);
|
|
calogValueAgg(result, user);
|
|
return calogOkE;
|
|
}
|
|
|
|
|
|
static int32_t nativeMapAge(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
|
|
CalogValueT key;
|
|
CalogValueT *found;
|
|
|
|
(void)userData;
|
|
calogValueNil(result);
|
|
if (argCount != 1 || args[0].type != calogAggE) {
|
|
return calogFail(result, calogErrArgE, "mapAge expects a map");
|
|
}
|
|
// Read a field out of a map the script built and handed to C (aggregate ingress).
|
|
calogValueString(&key, "age", 3);
|
|
found = calogAggGet(args[0].as.agg, &key);
|
|
calogValueFree(&key);
|
|
if (found != NULL && found->type == calogIntE) {
|
|
atomic_store(&reportedValue, found->as.i);
|
|
}
|
|
return calogOkE;
|
|
}
|
|
|
|
|
|
static int32_t nativeReport(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(&reportedCtxId, calogCurrentId());
|
|
atomic_store(&reportedValue, args[0].as.i);
|
|
return calogOkE;
|
|
}
|
|
|
|
|
|
static int32_t nativeReportInline(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
|
|
(void)args;
|
|
(void)argCount;
|
|
(void)userData;
|
|
atomic_store(&inlineCtxId, calogCurrentId());
|
|
calogValueNil(result);
|
|
return calogOkE;
|
|
}
|
|
|
|
|
|
static int32_t nativeReportName(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
|
|
size_t length;
|
|
|
|
(void)userData;
|
|
calogValueNil(result);
|
|
if (argCount != 1 || args[0].type != calogStringE) {
|
|
return calogFail(result, calogErrArgE, "reportName expects one string");
|
|
}
|
|
length = (size_t)args[0].as.s.length;
|
|
if (length >= sizeof(storedName)) {
|
|
length = sizeof(storedName) - 1;
|
|
}
|
|
memcpy(storedName, args[0].as.s.bytes, length);
|
|
storedName[length] = '\0';
|
|
atomic_store(&nameLen, (int32_t)length);
|
|
return calogOkE;
|
|
}
|
|
|
|
|
|
static int32_t nativeSetCb(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
|
|
(void)userData;
|
|
calogValueNil(result);
|
|
if (argCount != 1 || args[0].type != calogFnE) {
|
|
return calogFail(result, calogErrArgE, "setCb expects one function");
|
|
}
|
|
calogFnRetain(args[0].as.fn);
|
|
atomic_store(&storedCb, args[0].as.fn);
|
|
return calogOkE;
|
|
}
|
|
|
|
|
|
static void onError(uint64_t contextId, const char *message, void *userData) {
|
|
(void)message;
|
|
(void)userData;
|
|
atomic_store(&errorCtxId, contextId);
|
|
atomic_fetch_add(&errorCount, 1);
|
|
}
|
|
|
|
|
|
static void pumpUntilDone(void) {
|
|
struct timespec ts = { 0, 500000 };
|
|
int errorsBefore;
|
|
int i;
|
|
|
|
errorsBefore = atomic_load(&errorCount);
|
|
for (i = 0; i < PUMP_LIMIT; i++) {
|
|
calogPump(calog);
|
|
if (atomic_load(&scriptDone) || atomic_load(&errorCount) != errorsBefore) {
|
|
calogPump(calog);
|
|
return;
|
|
}
|
|
nanosleep(&ts, NULL);
|
|
}
|
|
}
|
|
|
|
|
|
static void testHostAndInlineNatives(void) {
|
|
CalogContextT *ctx;
|
|
|
|
ctx = calogContextOpen(calog, &calogS7Engine);
|
|
CHECK(ctx != NULL, "opened an s7 context");
|
|
|
|
atomic_store(&scriptDone, false);
|
|
calogContextEval(ctx, "(begin (report 42) (reportInline 1) (done))");
|
|
pumpUntilDone();
|
|
|
|
CHECK(atomic_load(&reportedValue) == 42, "host native received the argument");
|
|
CHECK(atomic_load(&reportedCtxId) == 0, "default native ran on the host thread (id 0)");
|
|
CHECK(atomic_load(&inlineCtxId) == calogContextId(ctx), "inline native ran on the script's own thread");
|
|
|
|
calogContextClose(ctx);
|
|
}
|
|
|
|
|
|
static void testMaterializedRecord(void) {
|
|
CalogContextT *ctx;
|
|
|
|
ctx = calogContextOpen(calog, &calogS7Engine);
|
|
atomic_store(&scriptDone, false);
|
|
atomic_store(&nameLen, -1);
|
|
atomic_store(&reportedValue, 0);
|
|
calogContextEval(ctx, "(begin (define u (makeUser)) (report (u \"age\")) (reportName (u \"name\")) (done))");
|
|
pumpUntilDone();
|
|
|
|
CHECK(atomic_load(&reportedValue) == 36, "read an int field from a materialized record map");
|
|
CHECK(atomic_load(&nameLen) == 3 && memcmp(storedName, "ada", 3) == 0, "read a string field from a materialized record map");
|
|
|
|
calogContextClose(ctx);
|
|
}
|
|
|
|
|
|
static void testMapIngress(void) {
|
|
CalogContextT *ctx;
|
|
|
|
ctx = calogContextOpen(calog, &calogS7Engine);
|
|
atomic_store(&scriptDone, false);
|
|
atomic_store(&reportedValue, 0);
|
|
// The script builds a hash-table and hands it to a native, which reads a field.
|
|
calogContextEval(ctx, "(begin (define m (make-hash-table)) (hash-table-set! m \"age\" 9) (mapAge m) (done))");
|
|
pumpUntilDone();
|
|
|
|
CHECK(atomic_load(&reportedValue) == 9, "native read a field from a map the script built");
|
|
|
|
calogContextClose(ctx);
|
|
}
|
|
|
|
|
|
static void testCrossThreadCallback(void) {
|
|
CalogContextT *ctx;
|
|
CalogFnT *callback;
|
|
CalogValueT arg;
|
|
CalogValueT result;
|
|
int32_t status;
|
|
|
|
ctx = calogContextOpen(calog, &calogS7Engine);
|
|
atomic_store(&scriptDone, false);
|
|
atomic_store(&storedCb, NULL);
|
|
calogContextEval(ctx, "(begin (define (cb x) (+ x 100)) (setCb cb) (done))");
|
|
pumpUntilDone();
|
|
|
|
callback = atomic_load(&storedCb);
|
|
CHECK(callback != NULL, "an s7 procedure was captured as a CalogFnT");
|
|
|
|
calogValueInt(&arg, 7);
|
|
status = calogFnInvoke(callback, &arg, 1, &result);
|
|
CHECK(status == calogOkE && result.type == calogIntE && result.as.i == 107, "cross-thread callable invoke routed to the owner");
|
|
calogValueFree(&result);
|
|
calogValueFree(&arg);
|
|
calogFnRelease(callback);
|
|
|
|
calogContextClose(ctx);
|
|
}
|
|
|
|
|
|
static void testForeignFunction(void) {
|
|
CalogContextT *ctx;
|
|
|
|
ctx = calogContextOpen(calog, &calogS7Engine);
|
|
atomic_store(&scriptDone, false);
|
|
atomic_store(&reportedValue, 0);
|
|
// The script receives a host-owned function value and applies it.
|
|
calogContextEval(ctx, "(begin (report ((getAdder) 2 3)) (done))");
|
|
pumpUntilDone();
|
|
|
|
CHECK(atomic_load(&reportedValue) == 5, "script called a foreign function value pushed in from the host");
|
|
|
|
calogContextClose(ctx);
|
|
}
|
|
|
|
|
|
static void testScriptError(void) {
|
|
CalogContextT *ctx;
|
|
int32_t before;
|
|
|
|
ctx = calogContextOpen(calog, &calogS7Engine);
|
|
before = atomic_load(&errorCount);
|
|
atomic_store(&scriptDone, false);
|
|
calogContextEval(ctx, "@@@ not valid scheme @@@");
|
|
pumpUntilDone();
|
|
|
|
CHECK(atomic_load(&errorCount) == before + 1, "a fire-and-forget script error reached the error handler");
|
|
CHECK(atomic_load(&errorCtxId) == calogContextId(ctx), "the error names the failing context");
|
|
|
|
calogContextClose(ctx);
|
|
}
|
|
|
|
|
|
static void testConcurrentContexts(void) {
|
|
CalogContextT *ctxs[3];
|
|
struct timespec ts = { 0, 500000 };
|
|
int32_t i;
|
|
|
|
atomic_store(&bumpCount, 0);
|
|
for (i = 0; i < 3; i++) {
|
|
ctxs[i] = calogContextOpen(calog, &calogS7Engine);
|
|
calogContextEval(ctxs[i], "(begin (bump) (bump) (bump))");
|
|
}
|
|
for (i = 0; i < PUMP_LIMIT && atomic_load(&bumpCount) < 9; i++) {
|
|
calogPump(calog);
|
|
nanosleep(&ts, NULL);
|
|
}
|
|
CHECK(atomic_load(&bumpCount) == 9, "three concurrent contexts all dispatched to the host thread");
|
|
for (i = 0; i < 3; i++) {
|
|
calogContextClose(ctxs[i]);
|
|
}
|
|
}
|
|
|
|
|
|
int main(void) {
|
|
calog = calogCreate();
|
|
if (calog == NULL) {
|
|
printf("calog create failed\n");
|
|
return 1;
|
|
}
|
|
calogSetErrorHandler(calog, onError, NULL);
|
|
calogRegister(calog, "report", nativeReport, NULL);
|
|
calogRegister(calog, "setCb", nativeSetCb, NULL);
|
|
calogRegister(calog, "done", nativeDone, NULL);
|
|
calogRegister(calog, "bump", nativeBump, NULL);
|
|
calogRegister(calog, "makeUser", nativeMakeUser, NULL);
|
|
calogRegister(calog, "reportName", nativeReportName, NULL);
|
|
calogRegister(calog, "getAdder", nativeGetAdder, NULL);
|
|
calogRegister(calog, "mapAge", nativeMapAge, NULL);
|
|
calogRegisterInline(calog, "reportInline", nativeReportInline, NULL);
|
|
|
|
testHostAndInlineNatives();
|
|
testMaterializedRecord();
|
|
testMapIngress();
|
|
testCrossThreadCallback();
|
|
testForeignFunction();
|
|
testScriptError();
|
|
testConcurrentContexts();
|
|
|
|
calogDestroy(calog);
|
|
|
|
printf("\n%d checks, %d failed\n", testsRun, testsFailed);
|
|
fflush(stdout);
|
|
if (testsFailed != 0) {
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|