Kestrel-3

GLOBAL {
    zerovec : g_utils;
    max;
    streq;
    copystr;
    replacestr;
}

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_syntax_error     = 100;		// Generic syntax error
    err_int_expr_expected;		// Int expression expected
    err_int_str_expr_expected;		// Int *or* string expression expected
    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

    ed_col;
    ed_code;
    ed_sizeof;

    // Expression Descriptor fields
    expr_type = 0;
    expr_value;
    expr_string;
    expr_sizeof = expr_string + (256 >> B2Wsh) + 1;

    // Expression Types
    et_unknown = 0;
    et_integer;
    et_string;

    // Scanner symbol types
    scs_char_upb = 255;
    scs_identifier;
    scs_byte;
    scs_2byte;
    scs_4byte;

    scs_equ;
    scs_include;
    scs_file;
    scs_line;
    scs_gv;
    scs_gref;
    scs_integer;
    scs_string;
    scs_endstreamch = endstreamch;

    // Intermediate Representation order codes
    IR_LIT = 1000;
    IR_DWORD;
}

		IF !errp DO RETURN
	}
}

AND dword_part(s, d, errp, expr) BE {
	expression(s, d, errp, expr)
	IF !errp DO RETURN


	IF expr!expr_type = et_integer DO {
		dynvec_put_at(d, IR_LIT, d!dv_length)
		dynvec_put_at(d, expr!expr_value, d!dv_length)
		dynvec_put_at(d, IR_DWORD, d!dv_length)
		RETURN
	}

	IF expr!expr_type = et_string DO {
		LET s = @expr!expr_string

		FOR i = 1 TO s%0 DO {
			dynvec_put_at(d, IR_LIT, d!dv_length)
			dynvec_put_at(d, s%i, d!dv_length)
			dynvec_put_at(d, IR_DWORD, d!dv_length)
		}
		RETURN
	}

	error(errp, s, err_int_str_expr_expected) <> RETURN
}

AND expression(s, d, errp, expr) BE {
	LET sym = scanner_sym(s)

	IF sym = scs_integer DO {
		expr!expr_type := et_integer
		expr!expr_value := scanner_value(s)
		scanner_next(s)
		RETURN
	}

	IF sym = scs_string DO {
		expr!expr_type := et_string
		replacestr(@expr!expr_string, scanner_label(s))
		scanner_next(s)
		RETURN
	}

	error(errp, s, err_syntax_error)
}

AND next_sym(s) BE {
	LET n, i, ch, label = 0, 0, ?, s!sc_label

	skip_blanks(s)

	ch := s!sc_ch

	IF ch = '"' DO {
		ch := rdch()
		i := 1
		WHILE (i < 256) & (ch ~= '"') DO {
			label%i := ch
			i := i + 1
			ch := rdch()
			s!sc_col := s!sc_col + 1
		}
		IF ch = '"' DO ch := rdch() <> s!sc_col := s!sc_col + 1
		s!sc_ch := ch
		label%0 := i-1
		s!sc_sym := scs_string
		RETURN
	}

	IF ch = '0' DO {
		ch := rdch()
		TEST (ch = 'x') | (ch = 'X')
		THEN {
			// Hex constant
			ch := rdch()

GET "globals_dynvec"
GET "globals_scanner"
GET "globals_utils"
GET "globals_parser"


LET testlist() = VALOF {
	MANIFEST { ntests = 3 }
	LET tl = getvec(ntests)
	tl!0 := ntests
	tl!1 := test_single_dword
	tl!2 := test_single_dword_chain
	tl!3 := test_single_dword_string
	RESULTIS tl
}


// Parser Tests: Simple listings

AND test_single_dword(r) = VALOF {

	IF scb DO endstream(scb)
	RESULTIS err
}

AND free_errors(p) BE {
	WHILE p DO {
		LET dsc = p
		writef("%s:%n:%n:%n*n", dsc!ed_filename, dsc!ed_line, dsc!ed_col, dsc!ed_code)
		p := dsc!ed_next
		IF dsc!ed_filename DO freevec(dsc!ed_filename)
		freevec(dsc)
	}
}

AND test_single_dword_chain(r) = VALOF {

	UNLESS EQ(d!dv_length, 12, 100) DO GOTO unwind
	FOR i = 0 TO 11 DO UNLESS EQ(dynvec_at(d, i), expected!i, 200+i) DO GOTO unwind

	err := 0

unwind:
	IF errlist DO free_errors(errlist)
	IF d DO dynvec_free(d)
	IF s DO scanner_free(s)
	IF scb DO endstream(scb)
	RESULTIS err
}

AND test_single_dword_string(r) = VALOF {
	LET err = failat
	LET scb, s, d = 0, 0, 0
	LET expected = TABLE IR_LIT, 6, IR_DWORD,
	                     IR_LIT, 'A', IR_DWORD,
	                     IR_LIT, 'b', IR_DWORD,
	                     IR_LIT, 'a', IR_DWORD,
	                     IR_LIT, 'c', IR_DWORD,
	                     IR_LIT, 'a', IR_DWORD,
	                     IR_LIT, 'b', IR_DWORD
	LET errlist = 0

	IF r DO RESULTIS r
	testid := "test_single_dword_string"

	writef("============*n")
	scb := findinoutput("RAM:")
	UNLESS NEQ(scb, 0, 0) DO GOTO unwind
	{
		LET outs = output()
		selectoutput(scb)
		writef(".dword 6, *"Abacab*"*n")
		selectoutput(outs)
		rewindstream(scb)
	}

	s := make_scanner()
	UNLESS NEQ(s, 0, 1) DO GOTO unwind
	UNLESS EQ(scanner_get_stream(s, scb, "RAM:"), TRUE, 3) DO GOTO unwind
	scanner_nextchar(s)
	scanner_next(s)

	d := make_dynvec()
	UNLESS NEQ(d, 0, 4) DO GOTO unwind

	parse(s, d, @errlist)
	UNLESS EQ(errlist, 0, 5) DO GOTO unwind

	UNLESS EQ(d!dv_length, 21, 100) DO GOTO unwind
	FOR i = 0 TO 20 DO UNLESS EQ(dynvec_at(d, i), expected!i, 200+i) DO GOTO unwind

	err := 0

unwind:
	IF errlist DO free_errors(errlist)
	IF d DO dynvec_free(d)
	IF s DO scanner_free(s)
	IF scb DO endstream(scb)
	RESULTIS err
}

GET "libhdr"
GET "manifest"
GET "globals_bud"
GET "globals_scanner"


LET testlist() = VALOF {
	MANIFEST { ntests = 11 }
	LET tl = getvec(ntests)
	tl!0 := ntests
	tl!1 := test_new_scanner
	tl!2 := test_get_file
	tl!3 := test_get_sym_eof
	tl!4 := test_get_sym_ident
	tl!5 := test_get_keyword
	tl!6 := test_get_decimal_literal
	tl!7 := test_get_hex_literal
	tl!8 := test_get_binary_literal
	tl!9 := test_get_octal_literal
	tl!10 := test_get_punctuation
	tl!11 := test_get_string
	RESULTIS tl
}

// Scanner Tests: Creation

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

}

AND test_get_punctuation(r) = VALOF {
	LET s, scb, err = 0, 0, failat
	LET syms = TABLE '`', '~', '!', '@', '#', '$', '%', '^',
	                 '&', '**', '(', ')', '-', '=', '+', '[',
	                 '{', ']', '}', '\', '|', ';', ':', '*'',
	                 ',', '/', '?'
	IF r DO RESULTIS r
	testid := "test_get_punctuation"

	s := make_scanner()
	UNLESS NEQ(s, 0, 0) DO GOTO unwind

	scb := findinoutput("RAM:")
	UNLESS NEQ(scb, 0, 1) DO GOTO unwind
	{
		LET outs = output()
		selectoutput(scb)
		writef("` ~ ! @ # $ %% ^ ")
		writef("& ** ( ) - = + [ ")
		writef("{ ] } \ | ; : ' ")
		writef(", / ?")
		selectoutput(outs)
		rewindstream(scb)
	}
	UNLESS EQ(scanner_get_stream(s, scb, "RAM:"), TRUE, 2) DO GOTO unwind
	scanner_nextchar(s)

	FOR i = 0 TO 22 DO {
		scanner_next(s)
		UNLESS EQ(scanner_sym(s), syms!i, 100+i) DO GOTO unwind
	}

	err := 0

unwind:
	IF scb DO endstream(scb)
	IF s DO scanner_free(s)
	RESULTIS err
}

AND test_get_string(r) = VALOF {
	LET s, scb, err = 0, 0, failat
	LET expected = "Hello world"

	IF r DO RESULTIS r
	testid := "test_get_string"

	s := make_scanner()
	UNLESS NEQ(s, 0, 0) DO GOTO unwind

	scb := findinoutput("RAM:")
	UNLESS NEQ(scb, 0, 1) DO GOTO unwind
	{
		LET outs = output()
		selectoutput(scb)
		writef("*"Hello world*"")
		selectoutput(outs)
		rewindstream(scb)
	}
	UNLESS EQ(scanner_get_stream(s, scb, "RAM:"), TRUE, 2) DO GOTO unwind
	scanner_nextchar(s)
	scanner_next(s)
	UNLESS EQ(scanner_sym(s), scs_string, 100) DO GOTO unwind
	FOR i = 0 TO expected%0 DO UNLESS EQ(expected%i, scanner_label(s)%i, 101) DO GOTO unwind

	err := 0

unwind:
	IF scb DO endstream(scb)
	IF s DO scanner_free(s)
	RESULTIS err
}

    UNLESS actual%0 = expected%0 DO RESULTIS FALSE
    FOR i = 1 TO actual%0 DO UNLESS actual%i = expected%i DO RESULTIS FALSE
    RESULTIS TRUE
}

AND copystr(src) = VALOF {
    LET dst = getvec((src%0 >> B2Wsh)+1)
    IF dst DO replacestr(dst, src)
    RESULTIS dst
}

AND replacestr(dst, src) BE FOR i = 0 TO src%0 DO dst%i := src%i