Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50242/tester.bli
There are no other files named tester.bli in the archive.
00100
00200 BEGIN
00300
00400 ! TEST PROGRAM FOR ALL POOMAS ROUTINES.
00500
00600 MACRO
00700 MEM = .MEMOB-3$;
01000
01100 LOCAL OBJECT P1:P2:P3:P4;
01200 LOCAL P[10];
01300 EXTERNAL GETSPACE,RELEASESPACE;
01400 EXTERNAL OBJECT MEMOB;
01500 EXTERNAL INITBLIPP,MEMSIZE;
01600 EXTERNAL JOBREL;
01700 MACHOP TTCALL = #51;
01800 OWN YORN;
01900
02000 GLOBAL ROUTINE INITIO = ();
02100
02200
02300 ERRCOUNT _ 100;
02400 RARA(MAINPROG) _ (P1<0,0> - .BREG<0,18>)^9;
02500 MAXMEM _ 1123;
02600 MEMSIZE _ 100;
02700 INITMEM();
02800
02900
03000
03100 INCR I FROM 1 TO 4 DO TYPE(0,1);
03200 TYPE('TEST ',0); TYPE('BLIPP',0); TYPE(' Y O',0);
03300 TYPE('R N.',1);
03400 TTCALL(4,YORN); TTCALL(#11,0);
03500 IF .YORN EQL "Y" THEN
03600 BEGIN
03700 ! TEST BLIPP.
03800
03900 ! FIRST TEST GETSPACE AND RELEASESPACE:
04000
04100 TYPE('GETSP',0); TYPE('ACE; ',0); TYPE('RELEA',0);
04200 TYPE('SESPA',0); TYPE('CE',1);
04300 IF .MEMSIZE NEQ 100 THEN
04400 (TYPE('MEMSI',0); TYPE('ZE NO',0);
04500 TYPE('T 100',1); EXITBLOCK);
04600
04700 ! TEST FOR NO OBJECTS OF SIZE 1:
04800
04900 P1 _ GETSPACE(1); TYPE('OK',1);
05000 IF .P1 NEQ 0 THEN TYPE('BUG1',1);
05100
05200 ! TEST MAXIMAL OBJECT AND GET FROM OR RELEASE TO EMPTY LIST.
05300
05400 P1 _ GETSPACE(98);
05500 P2 _ GETSPACE(2); TYPE('OK',1);
05600 IF .P2 NEQ 0 THEN TYPE('BUG2',1);
05700 RELEASESPACE(.P1);
05800 IF .SIZE(MEMOB) NEQ .MEMSIZE-2 THEN TYPE('BUG3',1);
05900
06000 ! TEST STANDARD GETSPACE.
06100
06200 INCR I FROM 1 TO 9 DO P[.I] _ GETSPACE(10);
06300 P3 _ FIRST(.MEMOB);
06400 IF .P3 NEQ .MEMOB+2 THEN TYPE('BUG3A',1);
06500 IF .P3 NEQ LAST(.MEMOB) THEN TYPE('BUG4',1);
06600 IF .SIZE(P3) NEQ 8 THEN TYPE('BUG5',1);
06700
06800 ! STANDARD RELEASE, MERGING AT HIGH END.
06900
07000 DECR I FROM 9 TO 1 BY 2 DO RELEASESPACE(.P[.I]);
07100 IF .SIZE(MEMOB) NEQ 58 THEN TYPE('BUG6',1);
07200 IF .SIZE(P3) NEQ 18 THEN TYPE('BUG7',1);
07300
07400 ! TEST NO FREELIST MEMBERS OF SIZE 1.
07500
07600 P3 _ GETSPACE(17);
07700 IF .SIZE(P3) NEQ 18 THEN TYPE('BUG8',1);
07800
07900 ! TEST PROPER MERGING AT BOTH ENDS.
08000
08100 RELEASESPACE(.P[4]);
08200 P1 _ .P[5];
08300 IF .SIZE(P1) NEQ 30 THEN TYPE('BUG9',1);
08400
08500 ! TEST FREELIST SEARCH AND MERGE AT LOW END.
08600
08700 P2 _ GETSPACE(25);
08800 IF .P2 NEQ .MEMOB+55 THEN TYPE('BUG10',1);
08900 RELEASESPACE(.P[8]); P4 _ .P[8];
09000 IF .SIZE(P4) NEQ 20 THEN TYPE('BUG11',1);
09100 RELEASESPACE(.P3);
09200 IF .SIZE(P3) NEQ 38 THEN TYPE('BG11A',1);
09300
09400 ! TEST PROPER INITIALIZATION OF OBJECT:
09500
09600 IF @(.P2-3) NEQ NONE THEN TYPE('BUG12',1);
09700 IF .(.P2-2)<18,18> NEQ 100 THEN TYPE('BUG13',1);
09800 IF .(.P2-2)<0,18> NEQ 25 THEN TYPE('BG13A',1);
09900 INCR I FROM MEM+57 TO MEM+79 BY 1 DO
10000 IF @.I NEQ 0 THEN ( TYPE('BG14 ',0); TYPOCT(@.I,1) );
10100
10200 ! TEST FOR REMOVAL FROM LISTS BEFORE RELEASE.
10300
10400 P1 _ MAKELIST(); INCLUDE(.P2,.P1);
10500 IF .SIZE(P3) NEQ 36 THEN TYPE('BG14A',1);
10600 IF CARDINAL(.P1) NEQ 1 THEN TYPE('BUG15',1);
10700 P3 _ RELEASESPACE(.P2);
10800 IF CARDINAL(.P1) NEQ 0 THEN TYPE('BUG16',1);
10900
11000 ! RELEASESPACE: RETURNED AND FIELD VALUES TESTED:
11100
11200 IF .(.P2-2)<18,18> NEQ 0 THEN TYPE('BUG17',1);
11300 IF .P3 NEQ 1 THEN TYPE('BUG18',1);
11400 RELEASESPACE(.P1);
11500
11600 ! TEST ERROR MESSAGES FROM RELEASESPACE.
11700
11800 P1 _ .MEMOB+2;
11900 P2 _ RELEASESPACE(.P1); TYPE('OK',1);
12000 IF .P2 NEQ 0 THEN TYPE('BUG19',1);
12100 RELEASESPACE(NONE); TYPE('OK',1);
12200
12300 ! CLEAN-UP
12400
12500 RELEASESPACE(.P[2]); RELEASESPACE(.P[6]);
12600 IF .SIZE(MEMOB) NEQ 98 THEN TYPE('BUG20',1);
12700
12800
12900 ! TESTING OF THE MAKE- ROUTINES:
13000
13100 TYPE(0,1);
13200 TYPE('MAKE-',0); TYPE(' ROUT',0); TYPE('INES.',1);
13300 P1 _ MAKELIST(); P2 _ MAKELIST();
13400 INCR I FROM 1 TO 1 BY 2 DO P[.I] _ MAKEOBJ(89,8);
13500
13600 ! ERROR MESSAGES.
13700
13800 P3 _ MAKEREP(.P1); TYPE('OK-2',1);
13900 IF .P3 NEQ 0 THEN TYPE('BUG1',1);
14000 P3 _ MAKEOBJ(1,7); TYPE('OK-2',1);
14100 IF .P3 NEQ 0 THEN TYPE('BUG2',1);
14200 P3 _ MAKELIST();
14300 P4 _ MAKELIST(); TYPE('OK-2',1);
14400 IF .P4 NEQ 0 THEN TYPE('BUG3',1);
14500 RELEASESPACE(.P[1]);
14600
14700 ! TEST OBJECT FIELDS.
14800
14900 INCR I FROM 1 TO 9 BY 1 DO P[.I] _ MAKEOBJ(.I,10-.I);
15000 INCR I FROM 1 TO 9 DO
15100 ( IF @(.P[.I]-3) NEQ NONE THEN TYPE('BUG4',1);
15200 IF .(.P[.I]-2)<18,18> NEQ 10-.I THEN TYPE('BUG5',1);
15300 IF .(.P[.I]-2)<0,18> NEQ .I+3 THEN TYPE('BUG6',1);
15400 IF .I GTR 1 THEN
15500 ( IF .P[.I-1]-.P[.I] NEQ .I+3 THEN TYPE('BUG7',1) );
15600 );
15700
15800 ! TEST FIELDS IN HEAD.
15900
16000 IF .(.P1-3)<18,18> NEQ .P1
16100 OR .(.P1-3)<0,18> NEQ .P1 THEN TYPE('BUG8',1);
16200 IF .(.P2-2)<18,18> NEQ #777777 THEN TYPE('BUG9',1);
16300 IF .(.P3-2)<0,18> NEQ 2 THEN TYPE('BUG10',1);
16400 RELEASESPACE(.P3);
16500
16600 ! TEST FIELDS AND ERRORS - MAKEREP.
16700
16800 P3 _ MAKEREP(.P[1]);
16900 P4 _ MAKEREP(NONE); TYPE('OK',1);
17000 P4 _ MAKEREP(.P[2]);
17100 IF .(.P4-1)<0,36> NEQ .P[2] THEN TYPE('BUG11',1);
17200 IF @(.P4-3) NEQ NONE THEN TYPE('BUG12',1);
17300 IF .(.P4-2)<0,18> NEQ 3 THEN TYPE('BUG13',1);
17400 IF .(.P4-2)<18,18> NEQ #777776 THEN TYPE('BUG14',1);
17500
17600 ! TEST INSERTIONS AND REMOVALS.
17700
17800 TYPE(0,1);
17900 TYPE('INSER',0); TYPE('TIONS',0); TYPE(' AND ',0);
18000 TYPE('REMOV',0); TYPE('ALS',1);
18100 RELEASESPACE(.P4);
18200
18300 ! AT THIS POINT P[1] THRU P[9] CONTAIN OBJECTS, P1 AND P2
18400 ! SETS, P3 A REP OF P[1].
18500
18600 ! ERROR MESSAGES.
18700
18800 P4 _ INSERTAFTER(NONE,.P[1]); TYPE('OK',1);
18900 P4 _ .P4 OR INSERTAFTER(.P[2],NONE); TYPE('OK',1);
19000 P4 _ .P4 OR INSERTAFTER(.P[2],.P[3]); TYPE('OK',1);
19100 P4 _ .P4 OR INSERTAFTER(.P1,.P3); TYPE('OK',1);
19200 IF .P4 NEQ 0 THEN TYPE('BUG1',1);
19300
19400 P4 _ INSERTBEFORE(NONE,.P[1]); TYPE('OK',1);
19500 P4 _ .P4 OR INSERTBEFORE(.P[2],NONE); TYPE('OK',1);
19600 P4 _ .P4 OR INSERTBEFORE(.P[2],.P[3]); TYPE('OK',1);
19700 P4 _ .P4 OR INSERTBEFORE(.P1,.P3); TYPE('OK',1);
19800 IF .P4 NEQ 0 THEN TYPE('BUG2',1);
19900
20000 P4 _ INCLUDE(NONE,.P1); TYPE('OK',1);
20100 P4 _ .P4 OR INCLUDE(.P[1],.P3); TYPE('OK',1);
20200 IF .P4 NEQ 0 THEN TYPE('BUG3',1);
20300
20400 P4 _ REPLACE(NONE,.P3); TYPE('OK',1);
20500 P4 _ .P4 OR REPLACE(.P3,NONE); TYPE('OK',1);
20600 P4 _ .P4 OR REPLACE(.P3,.P[1]); TYPE('OK',1);
20700 P4 _ .P4 OR REPLACE(.P1,.P3); TYPE('OK',1);
20800 P4 _ .P4 OR REPLACE(.P3,.P1); TYPE('OK',1);
20900 IF .P4 NEQ 0 THEN TYPE('BUG4',1);
21000
21100 P4 _ REMOVE(NONE); TYPE('OK',1);
21200 P4 _ .P4 OR REMOVE(.P1); TYPE('OK',1);
21300 IF .P4 NEQ 0 THEN TYPE('BUG5',1);
21400
21500 P4 _ CLEARLIST(.P3); TYPE('OK',1);
21600 P4 _ .P4 OR RELEASEMEMBERS(.P[1]); TYPE('OK',1);
21700 P4 _ .P4 OR RELEASELIST(.P[9]); TYPE('OK',1);
21800 IF .P4 NEQ 0 THEN TYPE('BUG6',1);
21900
22000 ! INSERTIONS, - VALUES AND STRUCTURES.
22100
22200 P4 _ INSERTBEFORE(.P[3],.P1);
22300 IF .P4 NEQ .P[3] THEN TYPE('BUG7',1);
22400 P4 _ INSERTAFTER(.P[1],.P4);
22500 IF .P4 NEQ .P[1] THEN TYPE('BUG8',1);
22600 IF CARDINAL(.P1) NEQ 2 THEN TYPE('BUG9',1);
22700 INSERTAFTER(.P[3],.P[1]);
22800 P4 _ .P[1];
22900 IF .SUC(P4) NEQ .P[3] THEN TYPE('BUG10',1);
23000 ! P1: P[1],P[3]
23100 ! P2: <EMPTY>
23200 INCR I FROM 1 TO 9 DO
23300 P4 _ INCLUDE(.P[.I],.P2);
23400 IF .P4 NEQ .P[9] THEN TYPE('BUG11',1);
23500 IF CARDINAL(.P1) NEQ 2 OR CARDINAL(.P2) NEQ 9
23600 THEN TYPE('BUG12',1);
23700 P4 _ FIRST(.P2);
23800 IF .CLASS(P4) NEQ REPCLASS
23900 OR ((P4 _ .SUC(P4); P4 _ .SUC(P4); .CLASS(P4)) NEQ REPCLASS)
24000 THEN TYPE('BG12A',1);
24100 P4 _ .P2;
24200 INCR I FROM 1 TO 9 DO
24300 ( P4 _ .SUC(P4);
24400 IF .SIZE(P4) NEQ .I+3 THEN
24500 ( IF .CLASS(P4) NEQ REPCLASS THEN TYPE('BUG13',1));
24600 IF .PRED((.SUC(P4))) NEQ .P4 OR .SUC((.PRED(P4))) NEQ .P4
24700 THEN TYPE('BUG14',1);
24800 );
24900 IF REPLACE(.P[5],.P3) NEQ .P[5] THEN TYPE('BUG15',1);
25000 P4 _ .P[4];
25100 IF .SUC(P4) NEQ .P3 THEN TYPE('BUG16',1);
25200 P4 _ .P[6];
25300 IF .PRED(P4) NEQ .P3 THEN TYPE('BUG17',1);
25400 P4 _ .P[5];
25500 IF .POINTERS(P4) NEQ NONE THEN TYPE('BUG18',1);
25600
25700 ! REMOVAL ROUTINES.
25800
25900 IF REMOVE(.P[2]) NEQ .P[2] THEN TYPE('BUG19',1);
26000 IF CARDINAL(.P2) NEQ 8 THEN TYPE('BUG20',1);
26100 WHILE .P4 NEQ NONE DO
26200 ( P4 _ FIND(.P2,REPCLASS,-2,REPCLASS^18+3);
26300 RELEASESPACE(.P4);
26400 );
26500 TYPE('0K',1);
26600 IF CLEARLIST(.P2) NEQ .P2 THEN TYPE('BUG21',1);
26700 IF .PRED(P2) NEQ .P2 OR .SUC(P2) NEQ .P2 THEN TYPE('BUG22',1);
26800 P4 _ .P[6];
26900 IF .POINTERS(P4) NEQ NONE THEN TYPE('BUG23',1);
27000 INCR I FROM 1 TO 9 DO INCLUDE(.P[.I],.P1);
27100 INCLUDE(.P3,.P2);
27200 IF RELEASEMEMBERS(.P1) NEQ .P1 THEN TYPE('BUG24',1);
27300 IF .SIZE(MEMOB) NEQ 91 THEN TYPE('BUG25',1);
27400 IF CARDINAL(.P1) NEQ 0 THEN TYPE('BUG26',1);
27500 IF RELEASELIST(.P2) NEQ 1 THEN TYPE('BUG27',1);
27600 IF .SIZE(MEMOB) NEQ 96 THEN TYPE('BUG28',1);
27700 RELEASELIST(.P1);
27800 IF .SIZE(MEMOB) NEQ 98 THEN TYPE('BG28A',1);
27900
28000 ! LIST MEMBER ACCESSING.
28100
28200 TYPE(0,1); TYPE('ACCES',0); TYPE('ING L',0);
28300 TYPE('IST-M',0); TYPE('EMBER',0); TYPE('S.',1);
28400
28500 P1 _ MAKELIST(); P2 _ MAKELIST();
28600 INCR I FROM 1 TO 9 BY 1 DO
28700 INCLUDE(P[.I] _ MAKEOBJ(.I,6),.P1);
28800 P3 _ MAKEREP(.P[9]);
28900
29000 ! ERROR MESSAGES.
29100
29200 P4 _ FIRST(.P3); TYPE('0K',1);
29300 P4 _ .P4 OR LAST(.P[6]); TYPE('OK',1);
29400 P4 _ .P4 OR FIND(.P3,6,2,7090); TYPE('OK',1);
29500 P4 _ .P4 OR MAPLIST(.P3,RELEASESPACE); TYPE('OK',1);
29600 P4 _ .P4 OR MAPLIST(.P1,P4); TYPE('OK',1);
29700 IF .P4 NEQ 0 THEN TYPE('BUG0',1);
29800
29900 ! VALUES OF FIRST, LAST, FIND.
30000
30100 IF FIRST(.P1) NEQ .P[1] THEN TYPE('BUG1',1);
30200 IF FIRST(.P2) NEQ NONE THEN TYPE('BUG2',1);
30300 IF LAST(.P1) NEQ .P[9] THEN TYPE('BUG3',1);
30400 IF LAST(.P2) NEQ NONE THEN TYPE('BUG4',1);
30500 INCR I FROM 1 TO 9 DO
30600 ( P4 _ .P[.I];
30700 P4[.I-1] _ .I;
30800 );
30900 INCR I FROM 1 TO 9 DO
31000 IF FIND(.P1,6,.I-1,.I) NEQ .P[.I] THEN TYPE('BUG5',1);
31100 IF FIND(.P1,6,-2,0) NEQ NONE THEN TYPE('BUG6',1);
31200 IF FIND(.P2,6,0,0) NEQ NONE THEN TYPE('BUG7',1);
31300 IF FIND(.P1,-2,0,0) NEQ NONE THEN TYPE('BUG8',1);
31400
31500 ! MAPLIST TEST.
31600
31700 BEGIN
31800
31900 OWN P5;
32000
32100 ROUTINE REMLE5(X) =
32200 BEGIN
32300 MAP OBJECT X;
32400 IF .X[5] EQL 6 THEN 0
32500 ELSE REMOVE(.X)
32600 END; ! END REMLE5.
32700
32800 ROUTINE INCP2(X) = ( REMOVE(.X); INCLUDE(.X,.P5));
32900
33000 P5 _ .P2;
33100 IF MAPLIST(.P1,REMLE5) NEQ 0 THEN TYPE('BUG9',1);
33200 IF CARDINAL(.P1) NEQ 4 THEN TYPE('BUG10',1);
33300 IF MAPLIST(.P1,REMOVE) NEQ 1 THEN TYPE('BUG11',1);
33400 IF MAPLIST(.P1,BLIPPERROR) NEQ 1 THEN TYPE('BUG12',1);
33500 INCR I FROM 1 TO 9 DO INCLUDE(.P[.I],.P1);
33600 MAPLIST(.P1,INCP2);
33700 IF CARDINAL(.P1) NEQ 0 OR CARDINAL(.P2) NEQ 9
33800 THEN TYPE('BUG13',1);
33900 END; ! END MAPLIST TEST.
34000
34100 ! TEST MISCELLANEOUS ROUTINES.
34200
34300 TYPE(0,1); TYPE('MISCE',0); TYPE('LLANE',0);
34400 TYPE('OUS R',0); TYPE('OUTIN',0); TYPE('ES.',1);
34500
34600 ! ERROR MESSAGES.
34700
34800 P4 _ EMPTY(.P3); TYPE('OK',1);
34900 IF .P4 NEQ -2 THEN TYPE('BUG0',1);
35000 P4 _ CARDINAL(.P3); TYPE('OK',1);
35100 IF .P4 NEQ -1 THEN TYPE('BUG1',1);
35200
35300 ! VALUES.
35400
35500 IF EMPTY(.P1) NEQ 1 THEN TYPE('BUG2',1);
35600 IF EMPTY(.P2) NEQ 0 THEN TYPE('BUG3',1);
35700
35800 ! CARDINAL TESTED FOR EMPTY AND NONEMPTY LISTS ABOVE.
35900
36000 END; ! END OF BLIPP-TEST.
36100
36200
36300
36400 ! TEST OF QPEP AND CAP STARTS HERE.
36500
36600
36700 TTCALL(#11,0);
36800 INCR I FROM 1 TO 4 DO TYPE(0,1);
36900 TYPE('TEST ',0); TYPE('QPEP',0); TYPE(' Y OR',0);
37000 TYPE(' N.',1);
37100 TTCALL(4,YORN); TTCALL(#11,0);
37200 IF .YORN EQL "Y" THEN
37300 BEGIN
37400 ! TEST QPEP.
37500
37600 BEGIN
37700 ! TEST PRELIMINARIES.
37800
37900 REGISTER R1,R2;
38000 LOCAL RN1,AA,BB,CC,DD,EE,FF;
38100 OWN EXCHVAL,RN2,HH,PP3;
38200
38300 FUNCTION PROC4(A,B,C,D) =
38400 BEGIN
38500 LOCAL E,F,G;
38600 G _ EXCHJ(.MAINPROG,.VREG);
38700 EE _ .E; FF _ .F;
38800 WHILE 1 DO
38900 ( IF .G NEQ .EXCHVAL THEN TYPE('BUG0',1);
39000 IF .A NEQ .AA THEN TYPE('BUG1',1);
39100 IF .B NEQ .BB THEN TYPE('BUG2',1);
39200 IF .C NEQ .CC THEN TYPE('BUG3',1);
39300 IF .D NEQ .DD THEN TYPE('BUG4',1);
39400 IF .E NEQ .EE THEN TYPE('BUG5',1);
39500 IF .F NEQ .FF THEN TYPE('BUG6',1);
39600 REMOTELCL(.P1,0)<0,36> _ (HH _ .HH+1);
39700 IF @.RN1 NEQ @(.P2+.RN1-8) THEN TYPE('BUG22',1);
39800 G _ EXCHJ(.P1,EXCHVAL _ .EXCHVAL+1);
39900 );
40000 END; ! END PROC4.
40100
40200 FUNCTION PROC0 =
40300 BEGIN
40400 LOCAL H,I;
40500 I _ EXCHJ(.MAINPROG,.VREG);
40600 WHILE 1 DO
40700 ( IF .I NEQ .EXCHVAL THEN TYPE('BUG7',1);
40800 IF .H NEQ .HH THEN TYPE('BUG8',1);
40900 REMOTELCL(.MAINPROG,2)<0,18> _ (PP3 _ .PP3+1);
41000 REMOTELCL(.MAINPROG,2)<18,18> _ PP3 _ .PP3+1;
41100 IF @.RN2 NEQ @(.BREG+.RN2-8) THEN TYPE('BUG23',1);
41200 I _ EXCHJ(.MAINPROG,EXCHVAL _ .EXCHVAL+1);
41300 );
41400 END; ! END PROC0.
41500
41600 MEMSIZE _ .JOBREL-.MEMOB+4;
41700 MAXMEM _ 1523;
41800 INITMEM();
41900 INITQPEP();
42000 MAINPROG<27,9> _ P1-.MAINPROG<RIGHTHALF>;
42100 MAINPROG<18,9> _ 0;
42200
42300 ! TEST NEW, CREATE, EXCHJ, REMOTELCL, REMOTEFML.
42400
42500 TYPE(0,1);
42600 TYPE('NEW; ',0); TYPE('CREAT',0); TYPE('E; EX',0);
42700 TYPE('CHJ; ',0); TYPE('REMOT',0); TYPE('ES.',1);
42800
42900 ! CREATE
43000
43100 R1 _ 'REG1'; R2 _ 'REG2';
43200 RN1 _ R1<0,0>; RN2 _ R2<0,0>;
43300 HH _ 14;
43400 PP3 _ 15;
43500 EXCHVAL _ 1024;
43600
43700 P1 _ NEW(PROC0(),30);
43800 IF .(.P1)<0,18> NEQ PROC0<0,0> THEN TYPE('BUG9',1);
43900 P1 _ EXCHJ(.P1,.P1);
44000 IF @(.P1+.RN1-8) NEQ 'REG1' THEN TYPE('BUG10',1);
44100 IF @(.P1+.RN2-8) NEQ 'REG2' THEN TYPE('BUG11',1);
44200
44300 P2 _ NEW(PROC4(AA_10,BB_11,CC_12,DD_13),35);
44400 IF .(.P2)<0,18> NEQ PROC4<0,0> THEN TYPE('BUG12',1);
44500 P2 _ EXCHJ(.P2,.P2);
44600 IF @(.P2+.RN1-8) NEQ 'REG1' THEN TYPE('BUG13',1);
44700 IF @(.P2+.RN2-8) NEQ 'REG2' THEN TYPE('BUG14',1);
44800
44900 ! EXCHJ AND REMOTES.
45000
45100 WHILE 1 DO
45200 ( P4 _ EXCHJ(.P2,EXCHVAL _ .EXCHVAL+1);
45300 IF .P3 NEQ .PP3^18+(.PP3-1) THEN TYPE('BUG15',1);
45400 IF .AA NEQ .REMOTEFML(.P2,-3)<0,36> THEN TYPE('BUG16',1);
45500 IF .DD NEQ .REMOTEFML(.P2,0)<0,36> THEN TYPE('BUG17',1);
45600 IF .EE NEQ .REMOTELCL(.P2,0)<0,36> THEN TYPE('BUG17',1);
45700 IF .EXCHVAL-1 NEQ .REMOTELCL(.P1,1)<0,36>
45800 THEN TYPE('BUG19',1);
45900 IF .EXCHVAL NEQ .P4 THEN TYPE('BUG20',1);
46000 IF .REMOTEFML(.P1,-1)<0,36> NEQ @.BREG
46100 THEN TYPE('BUG21',1);
46200 TYPE('OK',1);
46300 IF .PP3 GEQ 22 THEN EXITLOOP;
46400 );
46500
46600 ! MAKEEVNOT.
46700
46800 TYPE(0,1); TYPE('MAKEE',0); TYPE('VNOT.',1);
46900
47000 ! ERROR MESSAGES.
47100
47200 P4 _ MAKEOBJ(10,200);
47300 P3 _ MAKEEVNOT(.SQS,0.0); TYPE('OK',1);
47400 P3 _ .P3 OR MAKEEVNOT(.P4,0.5); TYPE('OK',1);
47500 IF .P3 NEQ 0 THEN TYPE('BUG0',1);
47600 RELEASESPACE(.P4);
47700
47800 ! VALUE AND FIELDS.
47900 P3 _ MAKEEVNOT(.P2,0.0);
48000 P4 _ MAKEEVNOT(.P1,0.5);
48100 IF .POINTERS(P4) NEQ NONE THEN TYPE('BUG1',1);
48200 IF .CLASS(P4) NEQ #777775 THEN TYPE('BUG2',1);
48300 IF .SIZE(P4) NEQ 4 THEN TYPE('BUG3',1);
48400 IF .PROCPTR(P4) NEQ .P1 THEN TYPE('BUG4',1);
48500 IF .TIMEFLD(P4) NEQ 0.5 THEN TYPE('BUG5',1);
48600
48700 END; ! END OF PRELIMINARIES.
48800
48900 BEGIN
49000 ! TEST SQS MANIPULATIONS.
49100
49200 LOCAL Q,K;
49300 OWN OBJECT U:T;
49400
49500 ROUTINE CLASH(N) =
49600 BEGIN
49700 LOCAL L;
49800 L _ EXCHJ(.MAINPROG,.VREG);
49900 WHILE 1 DO
50000 ( IF .BREG<0,18> NEQ .CURRENT<0,18>
50100 THEN TYPE('BUG-0',1);
50200 CANCEL(.CURRENT);
50300 IF FIRST(.SQS) NEQ .EVNOT(CURRENT)
50400 THEN TYPE('BUG-1',1);
50500 IF (T _ .T+1) NEQ .N THEN TYPE('BUG-2',1);
50600 TERMINATE(.CURRENT);
50700 );
50800 END; ! END CLASH.
50900
51000 INITQPEP();
51100 TYPE(0,1); TYPE('SIMPL',0); TYPE('E SCH',0);
51200 TYPE('EDULI',0); TYPE('NG AN',0);
51300 TYPE('D SQS',0); TYPE(' SEAR',0); TYPE('CH.',1);
51400
51500 Q _ MAKELIST();
51600 INCR I FROM P1 TO P4 DO
51700 ( (@I)<0,36> _ NEW(CLASH(.I-P1+1),40);
51800 (@I)<0,36> _ EXCHJ(@.I,@.I);
51900 );
52000 ACTIVATE(.P1,FIRSTAT,1.0);
52100 ACTIVATE(.P2,FIRSTAT,1.0);
52200 ACTIVATE(.P3,LASTAT,1.0);
52300
52400 IF (T _ FIRST(.SQS)) NEQ .EVNOT(CURRENT)
52500 THEN TYPE('BUG1',1);
52600 IF .SUC(T) NEQ .EVNOT(P2) THEN TYPE('BUG2',1);
52700 IF LAST(.SQS) NEQ .EVNOT(P3) THEN TYPE('BUG3',1);
52800 ACTIVATE(.P4,FIRSTAT,1.001);
52900 ! SQS: - CURRENT - P2 - P1 - P3 - P4 _
53000 IF LAST(.SQS) NEQ .EVNOT(P4) THEN TYPE('BUG4',1);
53100 IF CARDINAL(.SQS) NEQ 5 THEN TYPE('BUG5',1);
53200
53300 ! FIRSTATTIME, FIRSTAFTERTIME.
53400
53500 IF FIRSTATTIME(1.0) NEQ .EVNOT(P2) THEN TYPE('BUG6',1);
53600 IF FIRSTAFTERTIME(1.0) NEQ .EVNOT(P4) THEN TYPE('BUG7',1);
53700 IF FIRSTAFTERTIME(1.001) NEQ .SQS THEN TYPE('BUG8',1);
53800 IF FIRSTATTIME(2.0) NEQ .SQS THEN TYPE('BUG9',1);
53900 IF FIRSTATTIME(0.5) NEQ .EVNOT(P2) THEN TYPE('BUG10',1);
54000
54100 ! CANCEL, TERMINATE.
54200
54300 TYPE(0,1); TYPE('CANCE',0); TYPE('L; TE',0);
54400 TYPE('RMINA',0); TYPE('TE.',1);
54500
54600 CANCEL(.P1);
54700 CANCEL(.Q); TYPE('OK',1);
54800 IF .(.P1-1)<0,18> NEQ HWNONE THEN TYPE('BUG1',1);
54900 CANCEL(.P1);
55000 IF CARDINAL(.SQS) NEQ 4 THEN TYPE('BUG2',1);
55100 ACTIVATE(.P1,FIRSTAT,.TIME);
55200 REACTIVATE(.CURRENT,AFTER,.P4);
55300 ! SQS: - CURRENT _
55400 IF CARDINAL(.SQS) NEQ 1 THEN TYPE('BUG3',1);
55500
55600 ! TERMINATE
55700
55800 ACTIVATE(.P1,AFTER,.CURRENT);
55900 REACTIVATE(.P4,AFTER,.P1);
56000 REACTIVATE(.P3,BEFORE,.P4);
56100 ACTIVATE(.P2,BEFORE,.P3);
56200 T _ .EVNOT(MAINPROG); K _ 0;
56300 WHILE (T _ .SUC(T)) NEQ .SQS DO
56400 ( U _ .PROCPTR(T);
56500 IF (K _ .K+1) NEQ .REMOTEFML(.U,0)<0,36>
56600 THEN TYPE('BUG3A',1);
56700 );
56800 IF .K NEQ 4 THEN TYPE('BUG3B',1);
56900 ! SQS: - CURRENT - P1 - P2 - P3 - P4 _
57000 T _ 0;
57100 TERMINATE(.P4);
57200 HOLD(1.0);
57300 INCR I FROM P1 TO P4 DO
57400 ( IF @@.I NEQ 0 THEN TYPE('BUG4',1);
57500 TERMINATE(@.I);
57600 RELEASESPACE(@.I);
57700 );
57800 TERMINATE(.Q); TYPE('OK',1);
57900 IF CARDINAL(.SQS) NEQ 1 THEN TYPE('BUG5',1);
58000
58100 END; ! END SQS MANIPULATION 1.
58200
58300 END; ! END OF QPEP TEST.
58400
58500 END; ! INNER BLOCK.
58600
58700 TYPE(0,1); TYPE('THRU',1); TYPE(0,1);
58800
58900 END ! END TESTER.
59000 ELUDOM