10 REM Atari BASIC program to test emulator's H: device.
20 REM Usage: atari800 -hreadwrite -H1 /path/to/test/dir hdevtest.lst
30 REM Be patient! It takes ca. 40 seconds to load this program.
40 REM You can also boot SpartaDOS and select e.g. "D1:" to be tested.
50 REM
90 DIM DEV$(10),LOGFN$(200),FN$(200),T1$(20),T2$(20),T3$(20),D$(300),C$(5)
100 ? "Device to be tested (Return=H1:) ";:INPUT DEV$
110 IF DEV$="" THEN DEV$="H1:"
120 IF LEN(DEV$)<>3 OR DEV$(3)<>":" THEN ? "Must be of form: Xn:":END
130 ? "Output report to which file"
140 ? "(Return=H6:hdevtest.log) ";:INPUT LOGFN$
150 IF LOGFN$="" THEN LOGFN$="H6:hdevtest.log"
160 TRAP 10100:OPEN #2,8,0,LOGFN$:? #2;"Testing: ";DEV$
200 ? "Test: Write binary: ";:? #2;"Test: Write binary: ";
210 TRAP 10200:FN$=DEV$:FN$(4)="DELETE.ME":OPEN #1,8,0,FN$:RESTORE 10250
220 READ BYTE:IF BYTE<0 THEN 240
230 PUT #1,BYTE:GOTO 220
240 CLOSE #1:? "Passed":? #2;"Passed"
300 ? "Test: Read binary: ";:? #2;"Test: Read binary: ";
310 BYTE=0:TRAP 10300:OPEN #1,4,0,FN$:RESTORE 10250
320 READ BYTE:GET #1,FROMFILE:IF FROMFILE=BYTE THEN 320
330 ? "FAILED: Wrong data":? #2;"FAILED: Wrong data":CLOSE #1:GOTO 400
340 CLOSE #1:? "Passed":? #2;"Passed"
400 ? "Test: Append binary: ";:? #2;"Test: Append binary: ";
410 TRAP 10400:OPEN #1,9,0,FN$:RESTORE 10450
420 READ BYTE:IF BYTE<0 THEN 440
430 PUT #1,BYTE:GOTO 420
440 CLOSE #1:? "Passed":? #2;"Passed"
500 ? "Test: Read binary: ";:? #2;"Test: Read binary: ";
510 BYTE=0:TRAP 10500:OPEN #1,4,0,FN$:RESTORE 10250
520 READ BYTE:IF BYTE=-1 THEN READ BYTE
530 GET #1,FROMFILE:IF FROMFILE=BYTE THEN 520
540 ? "FAILED: Wrong data":? #2;"FAILED: Wrong data":CLOSE #1:GOTO 600
550 CLOSE #1:? "Passed":? #2;"Passed"
600 ? "Test: Update+Note+Point: ";:? #2;"Test: Update binary + Note + Point: ";
610 TRAP 10600:OPEN #1,12,0,FN$:RESTORE 10250
620 READ BYTE:IF BYTE<0 THEN 650
630 GET #1,FROMFILE:IF FROMFILE=BYTE THEN 620
640 ? "FAILED: Wrong data":? #2;"FAILED: Wrong data":CLOSE #1:GOTO 700
650 NOTE #1,OFS1,OFS2:GET #1,FROMFILE:PUT #1,16:PUT #1,17:POINT #1,OFS1,OFS2
660 GET #1,B1:GET #1,B2:GET #1,B3:GET #1,B4:IF B1=5 AND B2=16 AND B3=17 AND B4=8 THEN 690
670 ? "FAILED: Wrong data: ";B1;",";B2;",";B3;",";B4
680 ? #2;"FAILED: Wrong data: ";B1;",";B2;",";B3;",";B4:CLOSE #1:GOTO 700
690 CLOSE #1:? "Passed":? #2;"Passed"
700 IF DEV$(1,1)<>"H" THEN 1000
710 ? "Test: Write text: ";:? #2;"Test: Write text: ";
720 TRAP 10700:FN$(2,2)=CHR$(ASC(FN$(2,2))+5):OPEN #1,8,0,FN$
730 REM Don't write CRLF, because it may get translated to CRCRLF
740 ? #1;"Native EOL":? #1;"CR";CHR$(13);"LF";CHR$(10);
750 CLOSE #1:? "Passed":? #2;"Passed"
800 ? "Test: Read text: ";:? #2;"Test: Read text: ";
810 TRAP 10800:OPEN #1,4,0,FN$:INPUT #1,T1$,T2$,T3$:CLOSE #1
820 IF T1$<>"Native EOL" OR T2$<>"CR" OR T3$<>"LF" THEN ? "FAILED: Wrong data":? #2;"FAILED: Wrong data":GOTO 1000
830 ? "Passed":? #2;"Passed"
1000 ? "Test: Make directory: ";:? #2;"Test: Make directory: ";
1010 TRAP 11000:FN$=DEV$:FN$(4)="TEMP.DIR":XIO 42,#1,0,0,FN$
1020 ? "Passed":? #2;"Passed"
1100 ? "Test: Directory handling: ";:? #2;"Test: Directory handling: ";
1110 TRAP 11100:FN$(4)="TEMP.DIR>REMOVE.ME":OPEN #1,8,0,FN$:PUT #1,5:CLOSE #1
1120 FN$(4)="TEMP.DIR>REMOVE.ME":GOSUB 1200:FN$(4)="TEMP.DIR\REMOVE.ME":GOSUB 1200
1130 IF DEV$(1,1)="H" THEN FN$(4)="TEMP.DIR/REMOVE.ME":GOSUB 1200:FN$(4)="TEMP.DIR:REMOVE.ME":GOSUB 1200
1140 FN$(4)="TEMP.DIR":XIO 44,#1,0,0,FN$:REM Change directory
1150 FN$(4)="REMOVE.ME":GOSUB 1200:FN$(4)="<TEMP.DIR>REMOVE.ME":GOSUB 1200
1160 FN$(4)="..\TEMP.DIR\REMOVE.ME":GOSUB 1200:IF DEV$(1,1)="H" THEN FN$(4)="../TEMP.DIR/REMOVE.ME":GOSUB 1200
1170 FN$(4)="..":XIO 44,#1,0,0,FN$:REM Change directory
1180 ? "Passed":? #2;"Passed":GOTO 1300
1200 OPEN #1,4,0,FN$:GET #1,FROMFILE:CLOSE #1
1210 IF FROMFILE<>5 THEN ? "FAILED: Wrong data":? #2;"FAILED: Wrong data":POP:GOTO 1300
1220 RETURN
1300 ? "Test: Read directory:":? #2;"Test: Read directory:"
1310 AUX2=0:FN$(4)="*.*":GOSUB 1400:FN$(4)="*.M?":GOSUB 1400:FN$(4)=">?EL??E.M*":GOSUB 1400
1320 FN$(4)="NOMATCH.*":GOSUB 1400:FN$(4)="TEMP.DIR>*.*":GOSUB 1400:FN$(4)="TEMP.DIR\NOMATCH.*":GOSUB 1400
1330 AUX2=128:FN$(4)="*.*":GOSUB 1400:FN$(4)="*.M?":GOSUB 1400:FN$(4)=">?EL??E.M*":GOSUB 1400
1340 FN$(4)="TEMP.DIR>*.*":GOSUB 1400:FN$(4)="TEMP.DIR>*.*":GOSUB 1400:FN$(4)="TEMP.DIR\NOMATCH.*":GOSUB 1400
1350 ? "Finished":? #2;"Finished":GOTO 1500
1400 IF AUX2>=128 THEN ? "Extended directory of ";FN$:? #2;"Extended directory of ";FN$:GOTO 1420
1410 ? "Directory of ";FN$:? #2;"Directory of ";FN$
1420 TRAP 11400:OPEN #1,6,AUX2,FN$
1430 INPUT #1,D$:? D$:? #2;D$:GOTO 1430
1500 IF DEV$(1,1)<>"H" THEN 1600
1510 ? "Test: Access outside: ";:? #2;"Test: Access outside: ";
1520 TRAP 1530:FN$(4)="..\*.*":OPEN #1,6,0,FN$:CLOSE #1:? "FAILED: Possible":? #2;"FAILED: Possible":GOTO 1600
1530 TRAP 1550:FN$(4)=">..>*.*":CLOSE #1:OPEN #1,6,0,FN$:CLOSE #1
1540 ? "FAILED: Possible":? #2;"FAILED: Possible":GOTO 1600
1550 CLOSE #1:? "Passed (not allowed)":? #2;"Passed (not allowed)"
1600 ? "Test: File length: ";:? #2;"Test: File length: ";
1610 TRAP 11600:FN$(4)="RENAME.ME":OPEN #1,8,0,FN$:PUT #1,1:PUT #1,2:PUT #1,3:CLOSE #1
1620 OPEN #1,4,0,FN$:XIO 39,#1,0,0,FN$:LEN=PEEK(860)+256*PEEK(861)+65536*PEEK(862):CLOSE #1
1630 IF LEN<>3 THEN ? "FAILED: Returned ";LEN:? #2;"FAILED: Returned ";LEN:GOTO 1700
1640 ? "Passed":? #2;"Passed"
1700 ? "Test: Rename: ";:? #2;"Test: Rename: ";
1710 TRAP 11700:FN$(4)="RENAME.ME,R?????D":XIO 32,#1,0,0,FN$
1720 TRAP 1730:FN$(4)="RENAME.ME":OPEN #1,4,0,FN$:CLOSE #1:? "FAILED":? #2;"FAILED":GOTO 1800
1730 TRAP 11700:FN$(4)="RENAMED":CLOSE #1:OPEN #1,4,0,FN$:CLOSE #1
1740 ? "Passed":? #2;"Passed"
1800 ? "Test: Lock: ";:? #2;"Test: Lock: ";
1810 TRAP 11800:FN$(4)="LOCK.ME":OPEN #1,8,0,FN$:CLOSE #1:XIO 35,#1,0,0,FN$
1820 TRAP 1830:OPEN #1,8,0,FN$:CLOSE #1:? "FAILED: Overwritten":? #2;"FAILED: Overwritten":GOTO 2000
1830 CLOSE #1:TRAP 1840:XIO 33,#1,0,0,FN$:? "FAILED: Deleted":? #2;"FAILED: Deleted":GOTO 2000
1840 TRAP 1850:FN$(4)="LOCK.ME,OHNO":XIO 32,#1,0,0,FN$:? "FAILED: Renamed":? #2;"FAILED: Renamed":GOTO 2000
1850 ? :? #2:FN$(4)="*.*":? "Directory of ";FN$:? #2;"Directory of ";FN$:TRAP 11810:OPEN #1,6,0,FN$
1860 INPUT #1,D$:? D$:? #2;D$:GOTO 1860
1870 CLOSE #1:? "Finished":? #2;"Finished"
2000 ? "Test: Disk info: ";:? #2;"Test: Disk info: ";
2010 TRAP 12000:FN$(4)="ANYTHING":CMD=47:L=16:GOSUB 2090:GOTO 2200
2080 ? CHR$(34);FN$;CHR$(34);"=";:? #2;CHR$(34);FN$;CHR$(34);"=";:L=0
2090 POKE 850,CMD:FN$(LEN(FN$)+1)=CHR$(155):INBUF=ADR(FN$):POKE 852,ASC(CHR$(INBUF)):POKE 853,INT(INBUF/256):I=0
2100 D$="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx":OUTBUF=ADR(D$):POKE 856,ASC(CHR$(OUTBUF)):POKE 857,INT(OUTBUF/256)
2110 POKE 960,104:POKE 961,162:POKE 962,16:POKE 963,76:POKE 964,86:POKE 965,228:I=USR(960)
2120 IF PEEK(851)>=128 THEN POP:POKE 195,PEEK(851):GOTO PEEK(188)+256*PEEK(189):REM Goto TRAP handler
2130 IF L>0 THEN 2150
2140 IF L<30 AND ASC(D$(L+1,L+1))<>0 THEN L=L+1:GOTO 2140
2150 ? CHR$(34);:? #2;CHR$(34);:IF L=0 THEN 2190
2160 FOR I=1 TO L:C$=D$(I,I):C=ASC(C$)
2170 IF C<32 OR C>122 THEN C$="\x":C$(3)=CHR$(48+INT(C/16)+7*(C>159)):C=C-16*INT(C/16):C$(4)=CHR$(48+C+7*(C>9))
2180 ? C$;:? #2;C$;:NEXT I
2190 ? CHR$(34):? #2;CHR$(34):RETURN
2200 ? "Test: To absolute path:":? #2;"Test: To absolute path:"
2210 TRAP 12200:CMD=48:FN$(4)="":GOSUB 2080:FN$(4)=">":GOSUB 2080
2220 FN$(4)="TEMP.DIR":GOSUB 2080:FN$(4)="TEMP.DIR>":GOSUB 2080
2230 FN$(4)="TEMP.DIR":? "Changing directory to ";FN$:? #2;"Changing directory to ";FN$:XIO 44,#1,0,0,FN$
2240 FN$(4)="":GOSUB 2080:FN$(4)="\":GOSUB 2080:FN$(4)="..":GOSUB 2080
2250 FN$(4)="<":GOSUB 2080:FN$(4)="<TEMP.DIR":GOSUB 2080
2260 FN$(4)="..\TEMP.DIR\":GOSUB 2080:IF DEV$(1,1)="H" THEN FN$(4)="../TEMP.DIR":GOSUB 2080
2270 FN$(4)=">":XIO 44,#1,0,0,FN$:REM Change directory
2280 ? "Finished":? #2;"Finished"
2300 ? "Test: Delete file: ";:? #2;"Test: Delete file: ";
2310 TRAP 12300:FN$(4)="DELETE.ME":XIO 33,#1,0,0,FN$:FN$(4)="RENAMED":XIO 33,#1,0,0,FN$
2320 TRAP 2330:OPEN #1,4,0,FN$:CLOSE #1:? "FAILED: File exists":? #2;"FAILED: File exists":GOTO 2400
2330 TRAP 12300:FN$(4)="TEMP.DIR>REMO*.*":XIO 33,#1,0,0,FN$:FN$(4)="TEMP.DIR>REMOVE.ME"
2340 TRAP 2350:OPEN #1,4,0,FN$:CLOSE #1:? "FAILED: File exists":? #2;"FAILED: File exists":GOTO 2400
2350 CLOSE #1:TRAP 2370:FN$(4)="LOCK.ME":XIO 33,#1,0,0,FN$
2360 ? "FAILED: Deleted locked file":? #2;"FAILED: Deleted locked file":GOTO 2400
2370 TRAP 12300:XIO 36,#1,0,0,FN$:XIO 33,#1,0,0,FN$
2380 ? "Passed":? #2;"Passed"
2400 ? "Test: Remove directory: ";:? #2;"Test: Remove directory: ";
2410 TRAP 12400:FN$(4)="TEMP.DIR":XIO 43,#1,0,0,FN$
2420 TRAP 2430:XIO 44,#1,0,0,FN$:? "FAILED: Can CD":? #2;"FAILED: Can CD":FN$(4)=">":XIO 44,#1,0,0,FN$:GOTO 2500
2430 ? "Passed":? #2;"Passed"
2500 ? "Test: Load executable (Sparta): ";:? #2;"Test: Load executable (Sparta): ";
2510 TRAP 12500:FN$(4)="TEMP.XEX":OPEN #1,8,0,FN$:PUT #1,255:PUT #1,255
2520 PUT #1,192:PUT #1,3:PUT #1,192:PUT #1,3:PUT #1,15:CLOSE #1:XIO 40,#1,0,128,FN$
2530 IF PEEK(960)<>15 THEN ? "FAILED: Not loaded":? #2;"FAILED: Not loaded":GOTO 2600
2540 IF DEV$(1,1)<>"H" THEN 2590
2550 FN$(4)=">DOS":XIO 42,#1,0,0,FN$:FN$(4)=">DOS>ONPATH.XEX":OPEN #1,8,0,FN$:PUT #1,255:PUT #1,255
2560 PUT #1,192:PUT #1,3:PUT #1,192:PUT #1,3:PUT #1,25:CLOSE #1:FN$(4)="ONPATH.XEX":XIO 40,#1,0,128,FN$
2570 FN$(4)=">DOS>ONPATH.XEX":XIO 33,#1,0,0,FN$:FN$(4)=">DOS":XIO 43,#1,0,0,FN$:REM Delete file and directory
2580 IF PEEK(960)<>25 THEN ? "FAILED: Not found on PATH":? #2;"FAILED: Not found on PATH":GOTO 2600
2590 ? "Passed":? #2;"Passed"
2600 IF DEV$(1,1)<>"H" THEN FN$(4)="TEMP.XEX":XIO 33,#1,0,0,FN$:GOTO 2700
2610 ? "Test: Load executable (MyDOS): ";:? #2;"Test: Load executable (MyDOS): ";
2620 TRAP 12600:POKE 960,0:FN$(4)="TEMP.XEX":XIO 39,#1,7,0,FN$:XIO 33,#1,0,0,FN$:REM Load and delete
2630 IF PEEK(960)<>15 THEN ? "FAILED: Not loaded":? #2;"FAILED: Not loaded":GOTO 2700
2640 ? "Passed":? #2;"Passed"
2700 REM
9000 ? "End of tests":? #2;"End of tests":CLOSE #2:END
10100 ? "Error ";PEEK(195);" opening ";LOGFN$
10110 IF LOGFN$(1,1)="H" AND PEEK(195)=163 THEN ? "You should enable write to H: devices"
10120 END
10200 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 300
10250 DATA 0,1,2,3,4,13,10,26,65,96,155,255,-1
10300 IF PEEK(195)=136 AND BYTE<0 THEN 340
10310 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 400
10400 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 500
10450 DATA 5,6,7,8,9,13,10,26,66,98,155,255,-2
10500 IF PEEK(195)=136 AND BYTE<0 THEN 550
10510 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 600
10600 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 700
10700 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 800
10800 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 1000
11000 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 1100
11100 ? "FAILED: Error ";PEEK(195);" for ";FN$:? #2;"FAILED: Error ";PEEK(195);" for ";FN$:CLOSE #1:GOTO 1300
11400 IF PEEK(195)=136 THEN CLOSE #1:RETURN
11410 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 1500
11600 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 1700
11700 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 1800
11800 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2000
11810 IF PEEK(195)=136 THEN 1870
11820 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2000
12000 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2200
12200 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2300
12300 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2400
12400 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2500
12500 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2600
12600 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2700