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];
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];
};
}
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.

:[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
[cell.realCellStuff.newIO, cell.realCellStuff.oldIO] _ MakeMirrorIO[td.testee];
td.driveAsPtr _ LOOPHOLE[AMBridge.PointerFromTV[driveAsTV]];
Κ–

"cedar" style˜J™3J™BJ™/Icode˜KšΟk	œ‹
˜”
K˜šΠbxœœ
˜Kšœy˜€
Kšœ.˜5—K˜Kšœ
œ-˜7K˜Kšœœœ
˜Kšœœ˜K˜šΟnœœ
œœ+œ
œœ
œœ
œœœ!˜Ί
Kš
˜K˜Kš
œ0˜0Kš
œr˜rKšœ
˜—K˜šŸœœœœ˜SKš
˜Kšœœ!˜3K˜Kšœ0œ
œ
œ
˜BKšœ&œ
œ
œ,˜bš
œ"˜"Kš
œ˜K˜K˜
Kšœœ˜Kšœœ&˜4—Kšœ
˜—K˜š	œœœœœ˜AK˜Kšœœ˜—K˜šŸ
œ
Οc,œ˜HKš
˜Kšœœ˜1Kš
œ7˜7K˜“
Kšœ
œ
œŒ
˜£
Kšœ
˜—K˜š
Ÿ
œœœœœ˜0Kšœœ
œ˜"K˜G—K˜šŸœœ
œ"˜@Kš
˜šœœ
œ˜:K˜'Kšœ
œ%˜8Kšœœ
œ
œ
˜K˜>Kšœ
˜—Kšœ
˜—K˜šŸ
œœ
œ/œœœ+œ
œœ
œœœ6˜ν
Kš
˜K˜/Kš
œ
˜
Kšœ+œ
œ
œ.˜iK˜9KšœœF˜Ošœœ˜Kš
œ3˜3Kš
œ/˜/Kš
œ˜—Kš
œ€
˜€
K˜Kšœ
˜—K˜šŸœœœ&˜]Kš
˜Kšœ
œ*˜8Kšœœ&˜6šœ,˜1šœ!˜%Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜KšœDœ˜JKš
œ,˜,——šœ(˜-šœ˜#Kš
œ˜Kš
œ˜Kš
œ
˜
Kšœœ˜——Kšœ
˜—K˜Kšœ
œœ
˜!šœ
œœ˜K˜$Kšœœ
˜Kš
œ˜—K˜šŸœ ,œ˜HKš
˜Kšœœ˜ šœœ
œ$˜3K˜"Kš
œI˜IKšœ
˜—Kš
œΈ
˜Έ
Kš
ϩ
˜©
Kšœ
˜—K˜š
œ˜Kš
œ˜Kš
œ˜K˜K˜—K˜Kšœœœ˜-šœœ
œœ˜)K˜Kšœœ
˜Kšœœ
œœ
˜Kšœœ
˜Kšœœ
œœ
˜!Kšœœ
œ
œ
œœ
˜1Kšœœ
œœ
˜Kšœœ
˜Kšœœœ
˜Kšœ
œ˜Kš
œ˜—K˜Kšœ	œ˜!K˜KšŸœœ
œœ
œœ œ˜gK˜KšŸœœ
œœ%˜oK˜šŸœœ	œ
œœ
œ'œ
œ œ˜ͺ
Kš
˜Kšœœ˜$šœ˜KšœLœ
˜QKš
œQ˜QKš
œu˜uKš
œ[˜[Kšœœ
˜—Kšœ
˜—K˜šŸœ (œ˜CKš
˜Kšœœ˜&K™OKš
œ3˜3Kšœ
˜—K˜šŸ
œ
 :œ˜SKš
˜šœ	˜Kš
˜Kšœœ˜&Kš
œ3˜3Kšœœ˜5šœœ
œ˜)Kšœœ
˜KšœF˜MKš
œ)˜)šœ˜	Kš
œ.˜.Kšœœ˜(Kšœœ$™<Kš
œ˜—K˜
—šœ˜Kšœœ
˜Kšœœ˜—Kš
œ˜Kšœ
˜—Kšœ
˜—K˜šŸ
œ
 œ˜.Kš
˜Kšœœ˜6Kšœ 
œœœ˜ά
Kšœ
˜—K˜šŸœœ
œZœ˜…
Kš
˜šœœ
œ˜.Kš
œ˜Kšœœ
˜Kš
œ˜Kšœ
œœœ	œ
œœ
œœ
œ
˜ešœœ˜Kšœœ
œ
œ
˜7Kš
œœ
œœ
œ˜3—šœ˜Kšœ	œ
˜Kšœ"˜)Kšœœœ	œ˜+—šœ˜Kšœ	œ
˜Kšœ"˜)Kšœœœœ˜)—Kš
œ,˜,šœ˜šœœœ
œ˜>Kšœ˜"Kšœ
˜—šœœœ
œ˜?Kšœ˜"Kšœ
˜—šœ	œœ
œ˜<Kšœœœ
œ ˜OKšœ
˜—Kšœœ
˜
Kšœœ
˜—Kšœ
˜—Kšœ
˜—K˜šŸœ 
œ
˜3Kš
˜Kšœœ˜6Kšœ 
œœœ˜ά
Kšœ
˜—K˜šŸœ œ˜.Kš
˜Kšœœ˜6K˜(Kšœ
œœ˜6Kšœœ
œœœ˜Ω
Kšœ
˜—K˜šŸœœ
œHœ˜wKš
˜Kš
œ˜Kš
œ˜Kšœœ
˜Kšœœ
œ&˜Lš
˜K˜Kšœœ
œœœ
œœ
œ
˜TKšœ
˜—Kšœœ
œ$˜IKšœ
˜—K˜šŸœœ˜/Kš
˜šœœ
œ%˜AK˜.Kšœœœ
˜Kšœ
œ
œ
œ
˜Kšœœ
œ
˜šœœ
œ˜+šœ˜	šœh˜jKšœœœ˜——Kšœ
˜—Kšœœ0˜AKšœ
˜—Kšœ
˜—K˜šŸœœ
œDœ
œœ˜eKš
˜Kšœœœœ˜cKšœœ
œ
œ+˜CK˜Kš	œ‡
œœ œ
œ˜Ε
Kšœœ
œ
œ
˜,Kšœ
˜—K˜Kšœœ2˜TK˜Kšœœ˜-K˜Kšœ
˜—…—+08}