Handling requests to compile internal tests.

§1. To exercise some of these, run the intest test group :internal through Inform. The current roster is as follows:

enum HEADLINE_INTT
enum SENTENCE_INTT
enum DESCRIPTION_INTT
enum DIMENSIONS_INTT
enum EVALUATION_INTT
enum EQUATION_INTT
enum VERB_INTT
enum ADJECTIVE_INTT
enum ING_INTT
enum KIND_INTT
enum MAP_INTT
enum DASH_INTT
enum DASHLOG_INTT
enum REFINER_INTT
enum PATTERN_INTT

§2. The following are the names of the internal test cases, which are in English only and may change at any time without notice.

<internal-test-case-name> ::=
    headline |     ==> { HEADLINE_INTT, - }
    sentence |     ==> { SENTENCE_INTT, - }
    description |  ==> { DESCRIPTION_INTT, - }
    dimensions |   ==> { DIMENSIONS_INTT, - }
    evaluation |   ==> { EVALUATION_INTT, - }
    equation |     ==> { EQUATION_INTT, - }
    verb |         ==> { VERB_INTT, - }
    adjective |    ==> { ADJECTIVE_INTT, - }
    participle |   ==> { ING_INTT, - }
    kind |         ==> { KIND_INTT, - }
    map |          ==> { MAP_INTT, - }
    dash |         ==> { DASH_INTT, - }
    dashlog |      ==> { DASHLOG_INTT, - }
    refinery |     ==> { REFINER_INTT, - }
    pattern        ==> { PATTERN_INTT, - }

• This is Preform grammar, not regular C code.

§3. Each request to run one of the above generates an internal_test_case object:

typedef struct internal_test_case {
    int itc_code;  one of the *_INTT values
    struct wording text_supplying_the_case;
    struct parse_node *itc_defined_at;
    CLASS_DEFINITION
} internal_test_case;

• The structure internal_test_case is private to this section.

§4.

internal_test_case *InternalTests::new(int code, wording W) {
    internal_test_case *itc = CREATE(internal_test_case);
    itc->itc_code = code;
    itc->text_supplying_the_case = W;
    itc->itc_defined_at = current_sentence;
    return itc;
}

filename *internal_test_output_file = NULL;
void InternalTests::set_file(filename *F) {
     internal_test_output_file = F;
}

text_stream *itc_save_DL = NULL, *itc_save_OUT = NULL;

void InternalTests::InternalTestCases_routine(void) {
    text_stream OUTFILE_struct; text_stream *OUTFILE = &OUTFILE_struct;
    if (internal_test_output_file) {
        if (STREAM_OPEN_TO_FILE(OUTFILE, internal_test_output_file, UTF8_ENC) == FALSE)
            Problems::fatal_on_file("Can't open file to write internal test results to",
                internal_test_output_file);
    }

    inter_name *iname = Hierarchy::find(INTERNALTESTCASES_HL);
    packaging_state save = Functions::begin(iname);
    internal_test_case *itc; int n = 0;
    LOOP_OVER(itc, internal_test_case) {
        n++;
        if (itc->itc_code == HEADLINE_INTT) {
            n = 0;
            Produce::inv_primitive(Emit::tree(), STYLEBOLD_BIP);
            TEMPORARY_TEXT(T)
            WRITE_TO(T, "\n%+W\n", itc->text_supplying_the_case);
            Produce::inv_primitive(Emit::tree(), PRINT_BIP);
            Produce::down(Emit::tree());
                Produce::val_text(Emit::tree(), T);
            Produce::up(Emit::tree());
            DISCARD_TEXT(T)
            Produce::inv_primitive(Emit::tree(), STYLEROMAN_BIP);
            continue;
        }
        TEMPORARY_TEXT(C)
        WRITE_TO(C, "%d. %+W\n", n, itc->text_supplying_the_case);
        Produce::inv_primitive(Emit::tree(), PRINT_BIP);
        Produce::down(Emit::tree());
            Produce::val_text(Emit::tree(), C);
        Produce::up(Emit::tree());
        DISCARD_TEXT(C)

        TEMPORARY_TEXT(OUT)
        itc_save_OUT = OUT;
        current_sentence = itc->itc_defined_at;
        switch (itc->itc_code) {
            case SENTENCE_INTT: {
                int SV_not_SN = TRUE;
                Perform an internal test of the sentence converter4.1;
                break;
            }
            case DESCRIPTION_INTT: {
                int SV_not_SN = FALSE;
                Perform an internal test of the sentence converter4.1;
                break;
            }
            case PATTERN_INTT:
                Perform an internal test of the action pattern parser4.5;
                break;
            case EVALUATION_INTT: {
                parse_node *spec = NULL;
                if (<s-value>(itc->text_supplying_the_case)) spec = <<rp>>;
                else spec = Specifications::new_UNKNOWN(itc->text_supplying_the_case);
                Dash::check_value(spec, NULL);
                kind *K = Specifications::to_kind(spec);
                WRITE("Kind of value: ");
                Begin reporting on the internal test case4.3;
                Kinds::Textual::log(K);
                if (Kinds::Behaviour::is_quasinumerical(K))
                    LOG(" scaled at k=%d", Kinds::Behaviour::scale_factor(K));
                End reporting on the internal test case4.4;
                WRITE("\nPrints as: ");
                Produce::inv_primitive(Emit::tree(), PRINT_BIP);
                Produce::down(Emit::tree());
                    Produce::val_text(Emit::tree(), OUT);
                Produce::up(Emit::tree());

                Produce::inv_primitive(Emit::tree(), INDIRECT1V_BIP);
                Produce::down(Emit::tree());
                    Produce::val_iname(Emit::tree(), K_value, Kinds::Behaviour::get_iname(K));
                    CompileValues::to_code_val(spec);
                Produce::up(Emit::tree());

                Str::clear(OUT);
                WRITE("\n");
                break;
            }
            case DIMENSIONS_INTT:
                Begin reporting on the internal test case4.3;
                Kinds::Dimensions::log_unit_analysis();
                End reporting on the internal test case4.4;
                break;
            case EQUATION_INTT:
                Equations::internal_test(itc->text_supplying_the_case);
                break;
            case VERB_INTT:
                Conjugation::test(OUT, itc->text_supplying_the_case, Projects::get_language_of_play(Task::project()));
                break;
            case ADJECTIVE_INTT:
                Adjectives::test_adjective(OUT, itc->text_supplying_the_case);
                break;
            case ING_INTT:
                Conjugation::test_participle(OUT, itc->text_supplying_the_case);
                break;
            case KIND_INTT:
                Begin reporting on the internal test case4.3;
                InternalTests::log_poset(
                    Vocabulary::get_literal_number_value(
                        Lexer::word(
                            Wordings::first_wn(
                                itc->text_supplying_the_case))));
                End reporting on the internal test case4.4;
                break;
            #ifdef IF_MODULE
            case MAP_INTT:
                Begin reporting on the internal test case4.3;
                PL::SpatialMap::log_spatial_layout();
                End reporting on the internal test case4.4;
                break;
            #endif
            case DASH_INTT:
                Begin reporting on the internal test case4.3;
                Dash::experiment(itc->text_supplying_the_case, FALSE);
                End reporting on the internal test case4.4;
                break;
            case DASHLOG_INTT:
                Dash::experiment(itc->text_supplying_the_case, TRUE);
                break;
            case REFINER_INTT:
                Perform an internal test of the refinery4.2;
                break;
        }
        WRITE("\n");
        Produce::inv_primitive(Emit::tree(), PRINT_BIP);
        Produce::down(Emit::tree());
            Produce::val_text(Emit::tree(), OUT);
        Produce::up(Emit::tree());
        if (internal_test_output_file) WRITE_TO(OUTFILE, "%S", OUT);
        DISCARD_TEXT(OUT)
    }
    Functions::end(save);
    Hierarchy::make_available(Emit::tree(), iname);
    if (internal_test_output_file) STREAM_CLOSE(OUTFILE);
}

void InternalTests::begin_internal_reporting(void) {
    Begin reporting on the internal test case4.3;
}

void InternalTests::end_internal_reporting(void) {
    End reporting on the internal test case4.4;
}

§4.1. Perform an internal test of the sentence converter4.1 =

    parse_node *p = NULL;
    pcalc_prop *prop = NULL;
    int tc = FALSE;

    if (SV_not_SN) {
        if (<s-sentence>(itc->text_supplying_the_case)) p = <<rp>>;
    } else {
        if (<s-descriptive-np>(itc->text_supplying_the_case)) p = <<rp>>;
    }
    if (p) {
        prop = Specifications::to_proposition(p);
        tc = Propositions::Checker::type_check(prop, Propositions::Checker::tc_no_problem_reporting());
    }
    Begin reporting on the internal test case4.3; Streams::enable_I6_escapes(DL);
    if (p == NULL) LOG("Failed: not a condition");
    else {
        LOG("$D\n", prop);
        if (tc == FALSE) LOG("Failed: proposition would not type-check\n");
        Propositions::Checker::type_check(prop, Propositions::Checker::tc_problem_logging());
    }
    Streams::disable_I6_escapes(DL); End reporting on the internal test case4.4;

• This code is used in §4 (twice), §6.

§4.2. Perform an internal test of the refinery4.2 =

    Begin reporting on the internal test case4.3; Streams::enable_I6_escapes(DL);
    wording W = itc->text_supplying_the_case;
    parse_node *p = Node::new(SENTENCE_NT); Node::set_text(p, W);
    Classifying::sentence(p);
    LOG("Classification:\n$T", p);
    if ((p->down) && (p->down->next) && (p->down->next->next)) {
        parse_node *px = p->down->next;
        parse_node *py = px->next;
        Refiner::refine_coupling(px, py, TRUE);
        LOG("After creation:\n$T", p);
    }
    Streams::disable_I6_escapes(DL); End reporting on the internal test case4.4;

• This code is used in §4.

§4.3. Begin reporting on the internal test case4.3 =

    itc_save_DL = DL; DL = itc_save_OUT;
    Streams::enable_debugging(DL);  Streams::enable_I6_escapes(DL);

• This code is used in §4 (6 times), §4.1, §4.2, §5, §6, §4.5.

§4.4. End reporting on the internal test case4.4 =

    Streams::disable_debugging(DL);  Streams::disable_I6_escapes(DL);
    DL = itc_save_DL;

• This code is used in §4 (6 times), §4.1, §4.2, §5, §6, §4.5.

§5.

void InternalTests::emit_showme(parse_node *spec) {
    TEMPORARY_TEXT(OUT)
    itc_save_OUT = OUT;
    if (Node::is(spec, PROPERTY_VALUE_NT))
        spec = Lvalues::underlying_property(spec);
    kind *K = Specifications::to_kind(spec);
    if (Node::is(spec, CONSTANT_NT) == FALSE)
        WRITE("\"%+W\" = ", Node::get_text(spec));
    Begin reporting on the internal test case4.3;
    Kinds::Textual::log(K);
    End reporting on the internal test case4.4;
    WRITE(": ");
    Produce::inv_primitive(Emit::tree(), PRINT_BIP);
    Produce::down(Emit::tree());
        Produce::val_text(Emit::tree(), OUT);
    Produce::up(Emit::tree());
    DISCARD_TEXT(OUT)

    if (Kinds::get_construct(K) == CON_list_of) {
        Produce::inv_call_iname(Emit::tree(), Hierarchy::find(LIST_OF_TY_SAY_HL));
        Produce::down(Emit::tree());
            CompileValues::to_code_val(spec);
            Produce::val(Emit::tree(), K_number, LITERAL_IVAL, 1);
        Produce::up(Emit::tree());
    } else {
        Produce::inv_call_iname(Emit::tree(), Kinds::Behaviour::get_iname(K));
        Produce::down(Emit::tree());
            CompileValues::to_code_val(spec);
        Produce::up(Emit::tree());
    }
    Produce::inv_primitive(Emit::tree(), PRINT_BIP);
    Produce::down(Emit::tree());
        Produce::val_text(Emit::tree(), I"\n");
    Produce::up(Emit::tree());
}

§6. Perform an internal test of the sentence converter4.1 =

    parse_node *p = NULL;
    pcalc_prop *prop = NULL;
    int tc = FALSE;

    if (SV_not_SN) {
        if (<s-sentence>(itc->text_supplying_the_case)) p = <<rp>>;
    } else {
        if (<s-descriptive-np>(itc->text_supplying_the_case)) p = <<rp>>;
    }
    if (p) {
        prop = Specifications::to_proposition(p);
        tc = Propositions::Checker::type_check(prop, Propositions::Checker::tc_no_problem_reporting());
    }
    Begin reporting on the internal test case4.3; Streams::enable_I6_escapes(DL);
    if (p == NULL) LOG("Failed: not a condition");
    else {
        LOG("$D\n", prop);
        if (tc == FALSE) LOG("Failed: proposition would not type-check\n");
        Propositions::Checker::type_check(prop, Propositions::Checker::tc_problem_logging());
    }
    Streams::disable_I6_escapes(DL); End reporting on the internal test case4.4;

• This code is .

§7. And here's a test of the kinds system (though in practice test cases for the kinds-test tool probably now does a better job):

void InternalTests::log_poset?Usage of InternalTests::log_poset:
§4(int n) {
    switch (n) {
        case 1: Display the subkind relation of base kinds7.1; break;
        case 2: Display the compatibility relation of base kinds7.2; break;
        case 3: Display the results of the superkind function7.3; break;
        case 4: Check for poset violations7.4; break;
        case 5: Check the maximum function7.5; break;
        case 6: Some miscellaneous tests with a grab bag of kinds7.6; break;
    }
}

§7.1. Display the subkind relation of base kinds7.1 =

    LOG("The subkind relation on (base) kinds:\n");
    kind *A, *B;
    LOOP_OVER_BASE_KINDS(A) {
        int c = 0;
        LOOP_OVER_BASE_KINDS(B) {
            if ((Kinds::conforms_to(A, B)) && (Kinds::eq(A, B) == FALSE)) {
                if (c++ == 0) LOG("%u <= ", A); else LOG(", ");
                LOG("%u", B);
            }
        }
        if (c > 0) LOG("\n");
    }

• This code is used in §7.

§7.2. Display the compatibility relation of base kinds7.2 =

    LOG("The (always) compatibility relation on (base) kinds, where it differs from <=:\n");
    kind *A, *B;
    LOOP_OVER_BASE_KINDS(A) {
        int c = 0;
        LOOP_OVER_BASE_KINDS(B) {
            if ((Kinds::compatible(A, B) == ALWAYS_MATCH) &&
                (Kinds::conforms_to(A, B) == FALSE) &&
                (Kinds::eq(A, K_value) == FALSE)) {
                if (c++ == 0) LOG("%u --> ", A); else LOG(", ");
                LOG("%u", B);
            }
        }
        if (c > 0) LOG("\n");
    }

• This code is used in §7.

§7.3. Display the results of the superkind function7.3 =

    LOG("The superkind function applied to base kinds:\n");
    kind *A, *B;
    LOOP_OVER_BASE_KINDS(A) {
        for (B = A; B; B = Latticework::super(B))
            LOG("%u -> ", B);
        LOG("\n");
    }

• This code is used in §7.

§7.4. Check for poset violations7.4 =

    LOG("Looking for partially ordered set violations.\n");
    kind *A, *B, *C;
    LOOP_OVER_BASE_KINDS(A)
        if (Kinds::conforms_to(A, A) == FALSE)
            LOG("Reflexivity violated: %u\n", A);
    LOOP_OVER_BASE_KINDS(A)
        LOOP_OVER_BASE_KINDS(B)
            if ((Kinds::conforms_to(A, B)) && (Kinds::conforms_to(B, A)) && (Kinds::eq(A, B) == FALSE))
                LOG("Antisymmetry violated: %u, %u\n", A, B);
    LOOP_OVER_BASE_KINDS(A)
        LOOP_OVER_BASE_KINDS(B)
            LOOP_OVER_BASE_KINDS(C)
                if ((Kinds::conforms_to(A, B)) && (Kinds::conforms_to(B, C)) && (Kinds::conforms_to(A, C) == FALSE))
                    LOG("Transitivity violated: %u, %u, %u\n", A, B, C);

• This code is used in §7.

§7.5. Check the maximum function7.5 =

    LOG("Looking for maximum violations.\n");
    kind *A, *B;
    LOOP_OVER_BASE_KINDS(A)
        LOOP_OVER_BASE_KINDS(B)
            if (Kinds::eq(Latticework::join(A, B), Latticework::join(B, A)) == FALSE)
                LOG("Fail symmetry: max(%u, %u) = %u, but max(%u, %u) = %u\n",
                    A, B, Latticework::join(A, B), B, A, Latticework::join(B, A));
    LOOP_OVER_BASE_KINDS(A)
        LOOP_OVER_BASE_KINDS(B)
            if (Kinds::conforms_to(A, Latticework::join(A, B)) == FALSE)
                LOG("Fail maximality(A): max(%u, %u) = %u\n", A, B, Latticework::join(A, B));
    LOOP_OVER_BASE_KINDS(A)
        LOOP_OVER_BASE_KINDS(B)
            if (Kinds::conforms_to(B, Latticework::join(A, B)) == FALSE)
                LOG("Fail maximality(B): max(%u, %u) = %u\n", A, B, Latticework::join(A, B));
    LOOP_OVER_BASE_KINDS(A)
        if (Kinds::eq(Latticework::join(A, A), A) == FALSE)
                LOG("Fail: max(%u, %u) = %u\n",
                    A, A, Latticework::join(A, A));

• This code is used in §7.

§7.6.

define SIZE_OF_GRAB_BAG 11

Some miscellaneous tests with a grab bag of kinds7.6 =

    #ifdef IF_MODULE
    kind *tests[SIZE_OF_GRAB_BAG];
    tests[0] = K_number;
    tests[1] = K_container;
    tests[2] = K_door;
    tests[3] = K_thing;
    tests[4] = Kinds::unary_con(CON_list_of, K_container);
    tests[5] = Kinds::unary_con(CON_list_of, K_door);
    tests[6] = Kinds::unary_con(CON_list_of, K_person);
    tests[7] = Kinds::unary_con(CON_list_of, K_thing);
    tests[8] = Kinds::binary_con(CON_phrase,
        Kinds::binary_con(CON_TUPLE_ENTRY, K_door, K_void), K_object);
    tests[9] = Kinds::binary_con(CON_phrase,
        Kinds::binary_con(CON_TUPLE_ENTRY, K_object, K_void), K_door);
    tests[10] = Kinds::binary_con(CON_phrase,
        Kinds::binary_con(CON_TUPLE_ENTRY, K_object, K_void), K_object);
    int i, j;
    for (i=0; i<SIZE_OF_GRAB_BAG; i++) for (j=i+1; j<SIZE_OF_GRAB_BAG; j++) {
        if (Kinds::conforms_to(tests[i], tests[j])) LOG("%u <= %u\n", tests[i], tests[j]);
        if (Kinds::conforms_to(tests[j], tests[i])) LOG("%u <= %u\n", tests[j], tests[i]);
        kind *M = Latticework::join(tests[i], tests[j]);
        if (Kinds::eq(M, K_value) == FALSE) LOG("max(%u, %u) = %u\n", tests[i], tests[j], M);
    }
    #endif

• This code is used in §7.

§8.

int ap_test_register_initialised = FALSE;
action_pattern *ap_test_register[10];

§9.

action_pattern *InternalTests::ap_of_nap?Usage of InternalTests::ap_of_nap:
§10(action_pattern *ap, wording W) {
    named_action_pattern *nap = NamedActionPatterns::add(ap, W);
    action_pattern *new_ap = ActionPatterns::new(W);
    anl_entry *entry = ActionNameLists::new_entry_at(W);
    entry->item.nap_listed = nap;
    new_ap->action_list = ActionNameLists::new_list(entry, ANL_POSITIVE);
    return new_ap;
}

§10.

<perform-ap-test> ::=
    list {...} |                  ==> { -, - }; ActionNameLists::test_list(WR[1]);
    <test-ap> |                   ==> Write textual AP test result10.1
    <test-ap> ~~ <test-ap> |      ==> Write comparison AP test result10.2
    ...                           ==> Write failure10.3

<test-ap> ::=
    <test-ap> is {...} |          ==> { -, InternalTests::ap_of_nap(RP[1], WR[1]) }
    <test-register> = <test-ap> | ==> { -, (ap_test_register[R[1]] = RP[2]) }
    <action-pattern> |            ==> { pass 1 }
    <test-register> |             ==> { -, ap_test_register[R[1]] }
    experimental {...}            ==> { -, ParseClauses::ap_seven(WR[1]) }

<test-register> ::=
    r1 | r2 | r3 | r4 | r5

• This is Preform grammar, not regular C code.

§10.1. Write textual AP test result10.1 =

    LOG("%W: $A\n", W, RP[1]);

• This code is used in §10.

§10.2. Write comparison AP test result10.2 =

    int rv = ActionPatterns::compare_specificity(RP[1], RP[2]);
    int rv_converse = ActionPatterns::compare_specificity(RP[2], RP[1]);
    LOG("%W: ", W);
    if (rv > 0) LOG("left is more specific\n");
    if (rv < 0) LOG("right is more specific\n");
    if (rv == 0) LOG("equally specific\n");
    if (rv_converse != -1*rv) LOG("*** Not antisymmetric ***\n");

• This code is used in §10.

§10.3. Write failure10.3 =

    LOG("%W: failed to parse\n", W);

• This code is used in §10.

§4.5. Perform an internal test of the action pattern parser4.5 =

    if (ap_test_register_initialised == FALSE) {
        ap_test_register_initialised = TRUE;
        for (int i=0; i<10; i++) ap_test_register[i] = NULL;
    }
    Begin reporting on the internal test case4.3; Streams::enable_I6_escapes(DL);
    int saved = ParseActionPatterns::enter_mode(PERMIT_TRYING_OMISSION);
    <perform-ap-test>(itc->text_supplying_the_case);
    ParseActionPatterns::restore_mode(saved);
    Streams::disable_I6_escapes(DL); End reporting on the internal test case4.4;

• This code is used in §4.