Kestrel-3

/**************************************************************
 *
 * BCPL Unit-Test Driver -- AssemRV's Standard Unit Test Engine
 *
 **************************************************************/










LET start() = VALOF {
    LET result1, tl = 0, testlist()
    testid := -1

    FOR i = 1 TO tl!0 DO result1 := (tl!i)(result1)

    TEST result1
    THEN writef("*nFAILED; grep tag is *"AND %s*"*n*n", testid)
    ELSE writef("*nPASSED*n*n")

    // If needed, each test procedure sets the result2 global.
    RESULTIS result1
}

AND EQ(actual, expected, field) = VALOF {

/*****************************************************************************
 *
 * DYNAMIC VECTORS (DYNVECS)
 *
 * These are vectors that can grow on-demand, and allow both cell- and
 * byte-level access.  Cells are always aligned to host-machine native cell
 * sizes.  So, if you need unaligned access to cells, you will need to
 * construct them manually using byte accessors.
 *
 *****************************************************************************/


LET make_dynvec() = VALOF {
    LET dv = getvec(dv_sizeof)
    IF dv DO {
        zerovec(dv, dv_sizeof)
    }
    RESULTIS dv
}

AND dynvec_free(dv) BE {
    UNLESS dv DO RETURN
    freevec(dv)
}

/*
** BCPL Unit-Test Driver -- AssemRV's Standard Unit Test Engine
*/


GLOBAL {
    testid: ug;
    testlist;

    EQ;
    NEQ;
}

GLOBAL {
    make_dynvec: g_dynvecs;
    dynvec_free;
}

GLOBAL {
    make_section : g_sections;
    section_free;
    section_lc;
    section_set_lc;
    section_largest_global_referenced;
    section_bufsize;
    section_write;
    section_byte_at;
    section_hword_at;
    section_word_at;
    section_dword_at;
    section_balign;
    section_p2align;
    section_emit_byte;
    section_emit_2byte;
    section_emit_4byte;
    section_emit_8byte;
    section_emit_hword;
    section_emit_word;
    section_emit_dword;
    section_emit_int;
    section_set_global_vector_entry;
}

GLOBAL {
    zerovec : g_utils;
    max;
}

MANIFEST {
    // By default, we want failed unit tests to die with CLI result 20.
    // This might one day be a parameter.
    failat           = 20;

    // These are stuffed into result2 to give the developer a crude
    // indication of why a test failed.  Ideally, these should be
    // taken from standard BCPL/Tripos error result codes as much as
    // possible.  For now, though, they're proprietary.
    err_no_memory    = 1;
    err_overflow     = 2;
    err_field        = 50000;		// Record field (n - err_field) not of expected value

    // Hunk format executables use these constants.
    HUNK_END         = 5000;
    HUNK_CODE;

    // Global Vector Constants
    g_sections       = ug + 200;
    g_parser         = g_sections + 100;
    g_dynvecs        = g_parser + 100;
    g_utils          = g_dynvecs + 100;

    // Dynamic vector descriptors
    dv_length        = 0;
    dv_capacity;
    dv_sizeof;

    // Section record fields
    s_lc             = 0;		// "Location Counter"; traditionally referred to as LC.
    s_largest_global;
    s_bufsize;
    s_buf;
    s_globinits;
    s_sizeof;

    // Section "globinit" Global Initializer binding fields
    gi_next           = 0;
    gi_global;
    gi_initializer;
    gi_sizeof;
}

set -e

echo ====== Sections ======
cintsys64 -c <<endcli
failat 20
bcpl from test_sections.b to test_sections
test_sections
endcli

echo "====== Dynamic Vectors (dynvecs) ======"
cintsys64 -c <<endcli
failat 20
bcpl from test_dynvec.b to test_dynvec
test_dynvec
endcli

// Initialization and Creation

LET make_section() = VALOF {
    LET s = getvec(s_sizeof)
    IF s DO zerovec(s, s_sizeof)
    RESULTIS s
}

AND section_free(s) BE {
    UNLESS s DO RETURN
    IF s!s_globinits DO {
        LET gi, ngi = s!s_globinits, ?
	WHILE gi DO {
	    ngi := gi!gi_next
	    freevec(gi)
	    gi := ngi
	}
    }
    freevec(s)
}


// Miscellaneous





AND section_expand_buffer(s, bytes) BE {
    LET newvec = ?

    bytes := (bytes + 1024 + 7) & -8  // so we don't have to allocate too often
    newvec := getvec(bytes >> B2Wsh)
    UNLESS newvec DO {

SECTION "BUD"

GET "libhdr"
GET "manifest"
GET "globals_bud"
GET "bud.b"
.

SECTION "utils"

GET "libhdr"
GET "manifest"
GET "globals_utils"
GET "utils.b"
.

SECTION "dynvec"

GET "libhdr"
GET "manifest"
GET "globals_utils"
GET "globals_dynvec"
GET "dynvec.b"
.

SECTION "test_dynvec"

GET "libhdr"
GET "manifest"
GET "globals_bud"
GET "globals_dynvec"


LET testlist() = VALOF {
    MANIFEST { ntests = 1 }
    LET tl = getvec(ntests)
    tl!0 := ntests
    tl!1 := test_new_dynvec
    RESULTIS tl
}


// Dynvec Tests: Creation

AND test_new_dynvec(r) = VALOF {
    LET err, d = failat, ?

    IF r DO RESULTIS r
    testid := "test_new_dynvec"

    d := make_dynvec()
    UNLESS NEQ(d, 0) DO GOTO unwind
    UNLESS EQ(d!dv_length, 0, 0) DO GOTO unwind
    UNLESS EQ(d!dv_capacity, 0, 1) DO GOTO unwind

    err := 0

unwind:
    IF d DO dynvec_free(d)
    RESULTIS err
}

SECTION "utils"

GET "libhdr"
GET "manifest"
GET "globals_utils"
GET "utils.b"
.

SECTION "BUD"

GET "libhdr"
GET "manifest"
GET "globals_bud"
GET "bud.b"
.

SECTION "sections"

GET "libhdr"
GET "manifest"
GET "globals_utils"
GET "globals_sections"
GET "sections.b"
.

SECTION "test_sections"

GET "libhdr"

GET "manifest"
GET "globals_bud"


GET "globals_sections"


LET testlist() = VALOF {
    MANIFEST { ntests = 6 }
    LET tl = getvec(ntests)
    tl!0 := ntests
    tl!1 := test_new_section

// Section Tests: Creation

AND test_new_section(r) = VALOF {
    LET err, s = failat, ?

    IF r DO RESULTIS r
    testid := "test_new_section"

    s := make_section()
    UNLESS NEQ(s, 0) DO GOTO unwind
    UNLESS EQ(section_lc(s), 0, 0) DO GOTO unwind
    UNLESS EQ(section_largest_global_referenced(s), 0, 1) DO GOTO unwind
    UNLESS EQ(section_bufsize(s), 0, 2) DO GOTO unwind

    err := 0

unwind:
    IF s DO section_free(s)
    RESULTIS err
}

AND test_emit_new_section(r) = VALOF {
    LET s, destv, actual, err = ?, ?, ?, failat

    IF r DO RESULTIS r
    testid := "test_emit_new_section"

    s := make_section()
    destv := getvec(50)
    UNLESS s & destv DO result2 := err_no_memory <> GOTO unwind

    actual := section_write(s, destv, 50)
    UNLESS EQ(actual, 4, -100) DO result2 := 1000 <> GOTO unwind

    UNLESS EQ(destv!0, HUNK_CODE, 0) DO GOTO unwind

// Section Tests: Assembly

AND test_emit_byte(r) = VALOF {
    LET err, s, b = failat, ?, ?
    LET dvec, n = ?, ?

    IF r DO RESULTIS r
    testid := "test_emit_byte"

    s := make_section()
    UNLESS s DO result2 := err_no_memory <> GOTO unwind

    section_emit_byte(s, #xAA)
    section_emit_byte(s, #x55)
    section_emit_byte(s, #xAA)

    b := section_byte_at(s, 0)

    // If this test passes, it's a good heuristic that the other
    // accessors will work as well, since each is defined in terms of
    // its immediate smaller components.

    LET s, err = ?, failat

    IF r DO RESULTIS r
    testid := "test_emit_hword_and_2byte"

    s := make_section()
    UNLESS s DO result2 := err_no_memory <> GOTO unwind

    // First, test p2align and 2byte

    section_emit_int(s, -1)
    section_emit_int(s, -1)
    UNLESS section_lc(s) >= 4 DO result2 := err_field - 100 <> GOTO unwind

// Section Tests: Globals Management

AND test_globinit(r) = VALOF {
    LET err, label, n, s, dvec = failat, ?, ?, 0, 0

    IF r THEN RESULTIS r
    testid := "test_globinit"

    s := make_section()
    UNLESS s DO result2 := err_no_memory <> GOTO unwind
    section_emit_dword(s, #xDEADBEEFFEEDFACE)
    label := section_lc(s)
    section_emit_dword(s, #x0BADC0DEDEADC0DE)

    UNLESS section_set_global_vector_entry(s, 1, label) DO result2 := -10 <> GOTO unwind
    UNLESS section_set_global_vector_entry(s, 42, #xBEEF) DO result2 := -11 <> GOTO unwind

    RESULTIS err
}

AND test_duplicate_globinit(r) = VALOF {
    LET err, label, n, s, dvec = failat, ?, ?, 0, 0

    IF r THEN RESULTIS r
    testid := "test_duplicate_globinit"

    s := make_section()
    UNLESS s DO result2 := err_no_memory <> GOTO unwind
    section_emit_dword(s, #xDEADBEEFFEEDFACE)
    label := section_lc(s)
    section_emit_dword(s, #x0BADC0DEDEADC0DE)

    UNLESS section_set_global_vector_entry(s, 1, label) DO result2 := -10 <> GOTO unwind
    UNLESS section_set_global_vector_entry(s, 42, #xBEEF) DO result2 := -11 <> GOTO unwind

/*****************************************************************************
 *
 * Miscellaneous Utilities
 *
 * I have no better place to put these, no better way to organize them.
 *
 ****************************************************************************/


LET zerovec(v, n) BE FOR i = 0 TO n-1 DO v!i := 0
AND max(a, b) = (a > b) -> a, b