test/test.sod: Abbreviate the T1 class nicknames.

[sod] / test / test.sod

/* -*-sod-*- */

code h: includes {
#include "sod.h"
}

code c: includes {
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include "test.h"
}

code c: early_user {
/*----- Preliminary definitions -------------------------------------------*/

/* Confuse the fragment scanner... */
#define LBRACE {
#define RBRACE }

static const char *test_name;
static int test_seq;

static void prepare(const char *name) { test_name = name; test_seq = 0; }

static void step(int q, const char *where)
{
  if (test_seq != q) {
    fprintf(stderr, "test %s (%s): step %d instead of %d\n",
	    test_name, where, q, test_seq);
    abort();
  }
  test_seq++;
}

static void done(int q, const char *where) { step(q, where); }

#define STRINGIFY_(x) #x
#define STRINGIFY(x) STRINGIFY_(x)
#define WHERE __FILE__ ":" STRINGIFY(__LINE__)
#define STEP(q) step((q), WHERE)
#define DONE(q) done((q), WHERE)

}

code c: (tests head)
  [user (tests head) tests (tests tail) main (user end)]
{
/*----- Test machinery ----------------------------------------------------*/

static void tests(void)
LBRACE
}
code c: (tests tail) {
RBRACE

}

code c: main {
/*----- Main program ------------------------------------------------------*/

int main(void)
{
  tests();
  return (0);
}

}

/*----- Various kinds of method combinations ------------------------------*/

code h: early_user {
struct item {
  struct item *next;
  const char *p;
};

}

code c: early_user {
static void *xmalloc(size_t n)
{
  void *p = malloc(n);
  if (!p) { perror("malloc"); exit(EXIT_FAILURE); }
  return (p);
}

static struct item *make_item(const char *p)
  { struct item *q = xmalloc(sizeof(*q)); q->p = p; return (q); }

static void free_list(struct item *i)
  { struct item *ii; while (i) { ii = i->next; free(i); i = ii; } }

static int check_list(struct item *i, ...)
{
  va_list ap;
  const char *p;
  int rc = -1;

  va_start(ap, i);
  for (;;) {
    p = va_arg(ap, const char *);
    if (!p) break;
    if (!i || strcmp(i->p, p) != 0) break;
    i = i->next;
  }
  if (!i) rc = 0;
  va_end(ap);
  return (rc);
}

struct vec { int *v; size_t n; };

static void free_vec(struct vec *v) { free(v->v); }

static int check_vec(struct vec *v, ...)
{
  va_list ap;
  int j;
  size_t i = 0;
  int rc = -1;

  va_start(ap, v);
  for (;;) {
    j = va_arg(ap, int);
    if (j < 0) break;
    if (i == v->n || j != v->v[i]) break;
    i++;
  }
  if (i == v->n) rc = 0;
  va_end(ap);
  return (rc);
}

}

[link = SodObject, nick = base]
class T1Base: SodObject {
  [combination = progn] void aprogn();
  [combination = sum] int asum();
  [combination = and] int aand();
  [combination = max] int amax();

  [combination = custom,
   empty = { sod_ret = 0; },
   decls = { struct item **head = &sod_ret; },
   each = { *head = sod_val; head = &sod_val->next; },
   after = { *head = 0; }]
  struct item *alist();

  [combination = custom,
   decls = { int *v; size_t i = 0; }, methty = <int>, count = n,
   empty = { sod_ret.v = 0; sod_ret.n = 0; },
   before = { v = xmalloc(n*sizeof(int)); },
   each = { v[i++] = sod_val; },
   after = { sod_ret.v = v; sod_ret.n = n; }]
  struct vec avec();
}

[link = T1Base, nick = mid]
class T1Mid: T1Base {
  void base.aprogn() { STEP(1); }
  int base.asum() { return 1; }
  int base.aand() { return 8; }
  int base.amax() { return 12; }
  struct item *base.alist() { return make_item("mid"); }
  int base.avec() { return 19; }
}

[link = T1Mid, nick = sub]
class T1Sub: T1Mid {
  void base.aprogn() { STEP(0); }
  int base.asum() { return 2; }
  int base.aand() { return 6; }
  int base.amax() { return 17; }
  struct item *base.alist() { return make_item("sub"); }
  int base.avec() { return 4; }
}

code c: tests {
  prepare("aggregate, base");
  { SOD_DECL(T1Base, t1, NO_KWARGS);
    struct item *l;
    struct vec v;
    STEP(0); T1Base_aprogn(t1); STEP(1);
    if (T1Base_asum(t1) == 0) STEP(2);
    if (T1Base_aand(t1) == 1) STEP(3);
    if (!t1->_vt->base.amax) STEP(4);
    l = T1Base_alist(t1);
    if (!l) STEP(5);
    v = T1Base_avec(t1);
    if (!v.n) STEP(6);
    DONE(7);
  }
  prepare("aggregate, mid");
  { SOD_DECL(T1Mid, t1, NO_KWARGS);
    struct item *l;
    struct vec v;
    STEP(0); T1Base_aprogn(t1); /* 1 */
    if (T1Base_asum(t1) == 1) STEP(2);
    if (T1Base_aand(t1) == 8) STEP(3);
    if (T1Base_amax(t1) == 12) STEP(4);
    l = T1Base_alist(t1);
    if (!check_list(l, "mid", (const char *)0)) STEP(5);
    free_list(l);
    v = T1Base_avec(t1);
    if (!check_vec(&v, 19, -1)) STEP(6);
    free_vec(&v);
    DONE(7);
  }
  prepare("aggregate, sub");
  { SOD_DECL(T1Sub, t1, NO_KWARGS);
    struct item *l;
    struct vec v;
    T1Base_aprogn(t1); /* 0, 1 */
    if (T1Base_asum(t1) == 3) STEP(2);
    if (T1Base_aand(t1) == 8) STEP(3);
    if (T1Base_amax(t1) == 17) STEP(4);
    l = T1Base_alist(t1);
    if (!check_list(l, "sub", "mid", (const char *)0)) STEP(5);
    free_list(l);
    v = T1Base_avec(t1);
    if (!check_vec(&v, 4, 19, -1)) STEP(6);
    free_vec(&v);
    DONE(7);
  }
}

/*----- Slot and user initargs --------------------------------------------*/

[link = SodObject, nick = t2]
class T2: SodObject {
  [initarg = x] int x = 0;

  initarg int y = 1;
  init { if (!y) STEP(0); }
}

code c: tests {
  prepare("initargs, defaults");
  { SOD_DECL(T2, t, NO_KWARGS);
    if (t->t2.x == 0) STEP(0);
    DONE(1);
  }
  prepare("initargs, explicit");
  { SOD_DECL(T2, t, KWARGS(K(x, 42) K(y, 0)));
    if (t->t2.x == 42) STEP(1);
    DONE(2);
  }
}

/*----- Keyword argument propagation --------------------------------------*/

[link = SodObject, nick = base]
class T3Base: SodObject {
  void m0(?int x) { STEP(x); }
  void m1(?) { }
}

[link = T3Base, nick = mid]
class T3Mid: T3Base {
  void base.m0(?int y) { STEP(y); CALL_NEXT_METHOD; }
  void base.m1(?) { STEP(4); CALL_NEXT_METHOD; }
}

[link = T3Mid, nick = sub]
class T3Sub: T3Mid {
  void base.m0(?int z) { STEP(z); CALL_NEXT_METHOD; }
  void base.m1(?int z) { STEP(z); CALL_NEXT_METHOD; }
}

code c: tests {
  prepare("kwargs");
  { SOD_DECL(T3Sub, t, NO_KWARGS);
    T3Base_m0(t, KWARGS(K(z, 0) K(y, 1) K(x, 2)));
    T3Base_m1(t, KWARGS(K(z, 3)));
    DONE(5);
  }
}

/*----- That's all, folks -------------------------------------------------*/