
<<[Indigo]<Rosemary>2.4>Rosemary.DF=>RoseTesting.Mesa>>
<<Last Edited by: Spreitzer, May 10, 1984 3:50:45 pm PDT PDT PDT PDT>>
<<Last Edited by: Barth, January 25, 1984 3:44 pm>>

    DIRECTORY AMBridge, AMTypes, Ascii, Cucumber, IO, OrderedSymbolTableRef, Rope, RoseClocks, RoseCreate, RoseIOHacks, RoseRun, 
    RoseStateIO, RoseTypes;

    RoseTesting: CEDAR PROGRAM
        IMPORTS AMBridge, AMTypes, Ascii, Cucumber, OrderedSymbolTableRef, Rope, RoseClocks, RoseCreate, RoseRun, RoseStateIO, RoseTypes
        EXPORTS RoseCreate, RoseIOHacks, RoseRun, RoseTypes =

    BEGIN OPEN RoseTypes, RoseIOHacks, RoseRun, RoseCreate;

    TV: TYPE = AMTypes.TV;
    Type: TYPE = AMTypes.Type;

    WrapTop: PUBLIC PROC [rootName, className: ROPE, decider: ExpandDeciderClosure, initData: REF ANY _ NIL, clocks: ROPE _ NIL, 
    steady: BOOL _ TRUE] RETURNS [root: Cell, osim: Simulation] =
        BEGIN
        rootClass: CellClass;
        rootClass _ GetWrappingClass[className, clocks];
        [root, osim] _ CreateTopCell[instanceName: rootName, className: rootClass.name, decider: decider, steady: steady];
        END;

    GetWrappingClass: PROC [subName, clocks: ROPE] RETURNS [wrappingClass: CellClass] =
        BEGIN
        wrappingName: ROPE = subName.Cat["-wrap-", clocks];
        subClass: CellClass;
        IF (wrappingClass _ GetCellClass[wrappingName]) # NIL THEN RETURN;
        IF (subClass _ GetCellClass[subName]) = NIL THEN ERROR Error[msg: "No such class", data: subName];
        wrappingClass _ RegisterCellClass[
            className: wrappingName,
            expandProc: ExpandWrapper,
            evals: [],
            ports: NEW [PortsRep[0]],
            classData: NEW [WrapClassRep _ [subClass, clocks]]];
        END;

    WrapClass: TYPE = REF WrapClassRep; WrapClassRep: TYPE = RECORD [
        subClass: CellClass,
        clocks: ROPE];

    ExpandWrapper: ExpandProc --PROC [thisCell: Cell, initData: REF ANY]-- =
        BEGIN
        wc: WrapClass _ NARROW[thisCell.class.classData];
        EnsureEnvironment[in: thisCell, forClass: wc.subClass];
        [] _ CreateCell[within: thisCell, instanceName: LowerFirst[wc.subClass.name], className: wc.subClass.name, interfaceNodes: "", 
        initData: initData];
        IF wc.clocks # NIL THEN [] _ CreateCell[within: thisCell, instanceName: "clockGen", className: "ClockGen", interfaceNodes: 
        wc.clocks, initData: RoseClocks.Init[]];
        END;

    LowerFirst: PROC [u: ROPE] RETURNS [l: ROPE] = {
        IF u.Length[] = 0 THEN RETURN [u];
        l _ Rope.FromChar[Ascii.Lower[u.Fetch[0]]].Concat[u.Substr[start: 1]]};

    EnsureEnvironment: PUBLIC PROC [in: Cell, forClass: CellClass] =
        BEGIN
        FOR portIndex: CARDINAL IN [0 .. forClass.ports.length) DO
            port: Port = forClass.ports[portIndex];
            node: Node _ NARROW[in.internalNodes.Lookup[port.name]];
            IF node # NIL THEN LOOP;
            [] _ CreateNode[within: in, name: port.name, type: port.type];
            ENDLOOP;
        END;

    CreateTest: PUBLIC PROC [rootName, testerName, testeeName, className: ROPE, stateToo: BOOL _ TRUE, decider: ExpandDeciderClosure, 
    initData: REF ANY _ NIL, steady: BOOL _ TRUE] RETURNS [root: Cell, osim: Simulation, cth: CellTestHandle] =
        BEGIN
        rootClass, testerClass, testeeClass: CellClass;
        rd: RootData;
        IF (testeeClass _ GetCellClass[className]) = NIL THEN ERROR Error[msg: "No such class", data: className];
        [rootClass, testerClass] _ GetTesterClasses[testeeClass];
        cth _ NEW [CellTestHandleRep _ [testeeInitData: initData, stateToo: stateToo]];
        rd _ NEW [RootDataRep _ [
            testerClass: testerClass, testeeClass: testeeClass,
            testerName: testerName, testeeName: testeeName,
            testerData: cth]];
        [root, osim] _ CreateTopCell[instanceName: rootName, className: rootClass.name, decider: decider, initData: rd, steady: steady];
        cth.sim _ osim;
        END;

    GetTesterClasses: PROC [testeeClass: CellClass] RETURNS [rootClass, testerClass: CellClass] =
        BEGIN
        rootName: ROPE _ testeeClass.name.Concat["-TesterRoot"];
        testerName: ROPE _ testeeClass.name.Concat["-Tester"];
        IF (testerClass _ GetCellClass[testerName]) = NIL
            THEN testerClass _ RegisterCellClass[
                className: testerName,
                ioCreator: CreateTesterIO,
                initializer: InitTester,
                evals: testerEvals,
                ports: RoseCreate.MirrorPorts[fwd: testeeClass.ports, alwaysOutput: TRUE],
                drivePrototype: testeeClass.drivePrototype];
        IF (rootClass _ GetCellClass[rootName]) = NIL
            THEN rootClass _ RegisterCellClass[
                className: rootName,
                expandProc: ExpandTestRoot,
                evals: [],
                ports: NEW [PortsRep[0]]];
        END;

    RootData: TYPE = REF RootDataRep;
    RootDataRep: TYPE = RECORD [
        testerClass, testeeClass: CellClass,
        testerName, testeeName: ROPE,
        testerData: CellTestHandle];

    ExpandTestRoot: ExpandProc--PROC [thisCell: Cell, initData: REF ANY]-- =
        BEGIN
        rd: RootData _ NARROW[initData];
        FOR i: INT IN [0 .. rd.testeeClass.ports.length) DO
            p: Port _ rd.testeeClass.ports[i];
            [] _ RoseCreate.CreateNode[within: thisCell, name: p.name, type: p.type];
            ENDLOOP;
        rd.testerData.testee _ RoseCreate.CreateCell[within: thisCell, instanceName: rd.testeeName, className: rd.testeeClass.name, 
        interfaceNodes: "", initData: rd.testerData.testeeInitData];
        rd.testerData.tester _ RoseCreate.CreateCell[within: thisCell, instanceName: rd.testerName, className: rd.testerClass.name, 
        interfaceNodes: "", initData: rd.testerData];
        END;

    testerEvals: EvalProcs _ [
        PropQ: PropTesterQUD,
        PropUD: PropTesterQUD,
        ValsChanged: TesterValsChanged,
        EvalSimple: TesterSimple];

    CellTestHandle: TYPE = REF CellTestHandleRep;
    CellTestHandleRep: PUBLIC TYPE = RECORD [
        sim: Simulation,
        tester, testee: Cell _ NIL,
        testeeInitData: REF ANY _ NIL,
        parms: RoseRun.TestParms _ NIL,
        instructionsAsAny: REF ANY _ NIL,
        instructionsAsWP: LONG POINTER TO CARDINAL _ NIL,
        driveAsAny: REF ANY _ NIL,
        driveAsPtr: Drive _ NIL,
        first: BOOLEAN _ FALSE,
        stateToo: BOOLEAN _ TRUE
        ];

    Waiting: TYPE = {Tester, Testee};

    NarrowToCellTestHandle: PUBLIC PROC [any: REF ANY] RETURNS [cth: CellTestHandle] = {cth _ NARROW[any]};

    GetSimulationFromCellTestHandle: PUBLIC PROC [cth: CellTestHandle] RETURNS [sim: Simulation] = {sim _ cth.sim};

    TransferCellTestHandle: PROC [whole: REF ANY, part: Cucumber.Path, where: IO.STREAM, direction: Cucumber.Direction, data: REF ANY] 
    --Cucumber.PartTransferProc-- = TRUSTED
        BEGIN
        cth: CellTestHandle _ NARROW[whole];
        SELECT part.first FROM
            $sim, $tester, $testee, $testeeInitData, $instructionsAsAny, $driveAsPtr => NULL;
            $parms => Cucumber.Transfer[what: cth.parms, where: where, direction: direction];
            $instructionsAsWP => RoseStateIO.TransferWords[cth.instructionsAsWP, cth.tester.class.ioWordCount, where, direction];
            $driveAsAny => Cucumber.Transfer[what: cth.driveAsAny, where: where, direction: direction];
            ENDCASE => ERROR;
        END;

    CreateTesterIO: IOCreator--PROC [cell: Cell, initData: REF ANY]-- =
        BEGIN
        td: CellTestHandle _ NARROW[initData];
        <<[cell.realCellStuff.newIO, cell.realCellStuff.oldIO] _ MakeMirrorIO[td.testee];>>
        td.testee.class.ioCreator[cell, td.testeeInitData];
        END;

    InitTester: Initializer--PROC [cell: Cell, initData: REF ANY, leafily: BOOLEAN]-- =
        BEGIN
        IF leafily THEN
            BEGIN
            td: CellTestHandle _ NARROW[initData];
            [td.instructionsAsAny, ] _ MakeMirrorIO[td.testee];
            td.instructionsAsWP _ LOOPHOLE[td.instructionsAsAny];
            IF cell.class.drivePrototype # NIL THEN {
                driveAsTV, driveProtoAsTV: TV;
                TRUSTED {driveProtoAsTV _ AMBridge.TVForReferent[cell.class.drivePrototype]};
                driveAsTV _ AMTypes.Copy[driveProtoAsTV];
                TRUSTED {
                    td.driveAsAny _ AMBridge.RefFromTV[driveAsTV];
                    td.driveAsPtr _ LOOPHOLE[td.driveAsAny];
                    <<td.driveAsPtr _ LOOPHOLE[AMBridge.PointerFromTV[driveAsTV]];>>
                    };
                }
            ELSE {
                td.driveAsAny _ NIL;
                td.driveAsPtr _ NIL};
            cell.realCellStuff.state _ td;
            END;
        END;

    PropTesterQUD: CellProc--PROC [cell: Cell]-- =
        BEGIN
        td: CellTestHandle _ NARROW[cell.realCellStuff.state];
        CopyIO[from: td.instructionsAsWP, to: cell.realCellStuff.switchIOAsWP, by: cell.class.ports, what: [inputs: none, outputs: forward, 
        bidirs: forward], specials: TRUE, generals: TRUE, simples: FALSE, drive: td.driveAsPtr];
        END;

    CopyIO: PUBLIC PROC [from, to: WordPtr, by: Ports, what: DirectionInstructions, specials, generals, simples: BOOLEAN, drive: Drive] 
    =
        BEGIN
        FOR portIndex: CARDINAL IN [0 .. by.length) DO
            port: Port _ by[portIndex];
            afterLast: CARDINAL;
            di: DirectionInstruction;
            IF NOT (IF port.type.simple THEN simples ELSE IF port.special THEN specials ELSE generals) THEN LOOP;
            di _ IF port.input
                THEN (IF port.output THEN what.bidirs ELSE what.inputs)
                ELSE (IF port.output THEN what.outputs ELSE ERROR);
            IF di = moveByDrive THEN
                {driven: BOOLEAN;
                TRUSTED {driven _ drive[portIndex].bool};
                di _ IF driven THEN forward ELSE backward};
            IF di = checkByDrive THEN
                {driven: BOOLEAN;
                TRUSTED {driven _ drive[portIndex].bool};
                di _ IF driven THEN check ELSE backward};
            afterLast _ port.firstWord + port.wordCount;
            SELECT di FROM
                forward => FOR c: CARDINAL IN [port.firstWord .. afterLast) DO
                    TRUSTED {(to + c)^ _ (from + c)^};
                    ENDLOOP;
                backward => FOR c: CARDINAL IN [port.firstWord .. afterLast) DO
                    TRUSTED {(from + c)^ _ (to + c)^};
                    ENDLOOP;
                check => FOR c: CARDINAL IN [port.firstWord .. afterLast) DO
                    TRUSTED {IF (from + c)^ # (to + c)^ THEN SIGNAL Warning["drive contradicted"]};
                    ENDLOOP;
                none => NULL;
                ENDCASE => ERROR;
            ENDLOOP;
        END;

    TesterValsChanged: --PROC [cell: Cell]-- CellProc =
        BEGIN
        td: CellTestHandle _ NARROW[cell.realCellStuff.state];
        CopyIO[from: cell.realCellStuff.switchIOAsWP, to: td.instructionsAsWP, by: cell.class.ports, what: [inputs: forward, outputs: none, 
        bidirs: forward], specials: TRUE, generals: TRUE, simples: FALSE, drive: td.driveAsPtr];
        END;

    TesterSimple: --PROC [cell: Cell]-- CellProc =
        BEGIN
        td: CellTestHandle _ NARROW[cell.realCellStuff.state];
        bw: DirectionInstruction _ checkByDrive;
        IF td.first THEN {bw _ moveByDrive; td.first _ FALSE};
        CopyIO[from: td.instructionsAsWP, to: cell.realCellStuff.newIOAsWP, by: cell.class.ports, what: [inputs: backward, outputs: 
        forward, bidirs: bw], specials: FALSE, generals: FALSE, simples: TRUE, drive: td.driveAsPtr];
        END;

    Eval: PUBLIC PROC [handle: CellTestHandle, returnAfter: ReturnAfter _ returnWhenSettled] RETURNS [happened: StepType] =
        BEGIN
        ScheduleCell[handle.tester];
        PerturbDifferences[handle];
        handle.first _ TRUE;
        IF handle.parms.stopBefore THEN SIGNAL Stop["About to eval", handle.testee];
        DO
            happened _ StepSim[handle.sim];
            IF (IF happened IN MaskableStepType THEN returnAfter[happened] ELSE TRUE) THEN EXIT;
            ENDLOOP;
        IF handle.parms.stopAfter THEN SIGNAL Stop["Just eval'd", handle.testee];
        END;

    PerturbDifferences: PROC [td: CellTestHandle] =
        BEGIN
        FOR portIndex: CARDINAL IN [0 .. td.tester.class.ports.length) DO
            port: Port _ td.tester.class.ports[portIndex];
            different: BOOLEAN _ FALSE;
            IF NOT port.output THEN LOOP;
            IF port.type.simple THEN LOOP;
            FOR o: CARDINAL IN [0 .. port.wordCount) DO
                TRUSTED {
                    IF (td.instructionsAsWP + port.firstWord + o)^ # (td.tester.realCellStuff.newIOAsWP + port.firstWord + o)^
                        THEN {different _ TRUE; EXIT}};
                ENDLOOP;
            IF different THEN PerturbPort[cell: td.tester, index: portIndex];
            ENDLOOP;
        END;

    Test: PUBLIC PROC [sim: Simulation, cth: CellTestHandle, parms: TestParms, testData: REF ANY _ NIL] =
        BEGIN
        test: CellTestProc _ IF cth.stateToo THEN cth.testee.class.stateToo ELSE cth.testee.class.blackBox;
        IF test = NIL THEN ERROR Error["Class has no such test proc", cth];
        cth.parms _ parms;
        test[handle: cth, initData: cth.testeeInitData, testData: testData, io: cth.instructionsAsAny, driveAsAny: cth.driveAsAny, 
        stateAsAny: IF cth.stateToo THEN cth.testee.realCellStuff.state ELSE NIL];
        WHILE StepSim[sim] # noStep DO NULL ENDLOOP;
        END;

    cthHandler: Cucumber.Handler _ NEW [Cucumber.HandlerRep _ [TransferCellTestHandle]];

    cthHandler.Register[CODE[CellTestHandleRep]];

    END.