nxu/testing.tal

173 lines
6.5 KiB
Tal
Raw Permalink Normal View History

2023-02-06 10:28:44 -05:00
( testing.tal )
( )
( testing uxntal words based on input/output bytes. )
( )
( this harness works best testing words that are "pure" )
( in the sense that they read from the data stack and )
( write results back onto the data stack. words which )
( manipulate the return stack or read/write from devices )
( may require something else. )
( )
( the model is as follows: )
( )
( - each test case is a line of text ending in a newline )
( - lines starts with a character that selects a test )
( - after that, 0 or more hexadecimal bytes are provided )
( - the test runs )
( - result is 0 or more hexadecimal bytes (or an error) )
( - an empty line ends the test )
( )
( for example, the input "+12345678\n" would run a test )
( selected by "+" with 4 input bytes on the stack: )
( )
( wst: 12 34 56 78 )
( )
( each case should be added to @interact, along with the )
( number of bytes it expects to read and write. )
( program )
|0100 ;interact #10 DEO2 BRK
( include the code being tested )
~math32.tal
( testing )
@buf $33 ( line buffer, not including trailing newline )
@pos $2 ( next position in buffer to write to )
( save character input and execute tests )
( )
( tests always start with a single character then )
( additional arguments are passed as bytes before )
( a terminating newline. )
( )
( the last byte read will be on the top of the stack )
( and the earliest on the bottom. )
@interact
#12 DEI ( read c )
DUP #0a EQU ,&exec JCN ( exec if c is a newline )
;pos LDA2 ;buf ADD2 STA ( else write c to buf+pos )
;pos LDA2k INC2 SWP2 STA2 BRK ( increment pos )
&exec POP ( )
;pos LDA2 #0000 EQU2 ;exit JCN2 ( exit on an empty line )
;buf LDA LIT "+ EQU ;test-add32 JCN2
;buf LDA LIT "* EQU ;test-mul32 JCN2
;buf LDA LIT "- EQU ;test-sub32 JCN2
;buf LDA LIT "/ EQU ;test-div32 JCN2
;buf LDA LIT "% EQU ;test-mod32 JCN2
;buf LDA LIT "G EQU ;test-gcd32 JCN2
;buf LDA LIT "L EQU ;test-lshift32 JCN2
;buf LDA LIT "R EQU ;test-rshift32 JCN2
;buf LDA LIT "B EQU ;test-bitcount32 JCN2
;buf LDA LIT "& EQU ;test-and32 JCN2
;buf LDA LIT "| EQU ;test-or32 JCN2
;buf LDA LIT "^ EQU ;test-xor32 JCN2
;buf LDA LIT "~ EQU ;test-complement32 JCN2
;buf LDA LIT "N EQU ;test-negate32 JCN2
;buf LDA LIT "= EQU ;test-eq32 JCN2
;buf LDA LIT "! EQU ;test-ne32 JCN2
;buf LDA LIT "0 EQU ;test-is-zero32 JCN2
;buf LDA LIT "Z EQU ;test-non-zero32 JCN2
;buf LDA LIT "< EQU ;test-lt32 JCN2
;buf LDA LIT "> EQU ;test-gt32 JCN2
;buf LDA LIT "{ EQU ;test-lteq32 JCN2
;buf LDA LIT "} EQU ;test-gteq32 JCN2
LIT "? #18 DEO #0a #18 DEO ;reset JSR2 BRK
( set the interpreter to exit now )
@exit
#01 #0f DEO BRK
( reads j bytes, emits k bytes )
@test ( j^ k^ word* -> )
STH2 STH STH ( {j k word} )
;buf INC2 STHr ( buf+1 j {k word} )
;read-bytes JSR2 ( <j-bytes> {k word} )
ROTr ROTr STH2r ( <j-bytes> word {k} )
JSR2 STHr ( <k-bytes> k )
;emit-bytes JSR2 ( )
#0a #18 DEO ( )
;reset JSR2 BRK ( )
( reset the interpreter to read another line )
@reset ( -> )
#0000 ;pos STA2
#00 ;buf STA
JMP2r
( different test executors )
( )
( TEST-NAME #IN #OUT WORD-TO-TEST HARNESS )
@test-add32 #08 #04 ;add32 ;test JMP2
@test-mul32 #08 #04 ;mul32 ;test JMP2
@test-sub32 #08 #04 ;sub32 ;test JMP2
@test-div32 #08 #04 ;div32 ;test JMP2
@test-mod32 #08 #04 ;mod32 ;test JMP2
@test-gcd32 #08 #04 ;gcd32 ;test JMP2
@test-lshift32 #05 #04 ;lshift32 ;test JMP2
@test-rshift32 #05 #04 ;rshift32 ;test JMP2
@test-bitcount32 #04 #01 ;bitcount32 ;test JMP2
@test-and32 #08 #04 ;and32 ;test JMP2
@test-or32 #08 #04 ;or32 ;test JMP2
@test-xor32 #08 #04 ;xor32 ;test JMP2
@test-complement32 #04 #04 ;complement32 ;test JMP2
@test-negate32 #04 #04 ;negate32 ;test JMP2
@test-eq32 #08 #01 ;eq32 ;test JMP2
@test-ne32 #08 #01 ;ne32 ;test JMP2
@test-is-zero32 #04 #01 ;is-zero32 ;test JMP2
@test-non-zero32 #04 #01 ;non-zero32 ;test JMP2
@test-lt32 #08 #01 ;lt32 ;test JMP2
@test-lteq32 #08 #01 ;lteq32 ;test JMP2
@test-gt32 #08 #01 ;gt32 ;test JMP2
@test-gteq32 #08 #01 ;gteq32 ;test JMP2
( reads one byte from ASCII: "13" -> 0x13 )
@read-byte ( c0^ c1^ -> n^ )
( lower char )
DUP #3a LTH ,&lo-digit JCN
#57 ,&lo JMP &lo-digit #30
&lo SUB SWP
( higher char )
DUP #3a LTH ,&hi-digit JCN
#57 ,&hi JMP &hi-digit #30
&hi SUB #40 SFT ORA
JMP2r
( read k bytes from the buffer )
@read-bytes ( addr* k^ -> <k bytes> )
DUP ,&non-zero JCN ( addr k )
POP POP2 JMP2r ( )
&non-zero
STH STH2k ( addr {addr k} )
LDA2 ;read-byte JSR2 ( byte {addr k} )
STH2r #0002 ADD2 ( byte addr+2 {k} )
STHr #01 SUB ( byte addr+2 k-1 )
,read-bytes JMP ( byte addr+2 k-1 )
( emit n bytes from the stack, earliest first )
( )
( examples: )
( - #aa #bb #cc #03 will emit "aabbcc" )
( - #aa #bb #01 will emit "bb" leaving aa on wst )
( - #00 will emit nothing )
@emit-bytes ( <n bytes> n -> )
DUP
&loop ( <b0..bk> n k {<bk+1..bn>} )
DUP #00 EQU ,&next JCN
ROT STH #01 SUB ( <b0..bk-1> n k-1 <bk..bn> )
,&loop JMP
&next ( n 0 {<b0..bn>} )
POP
&while ( n-i {<bi..bn>} )
DUP #00 EQU ,&done JCN
STHr ;emit JSR2 #01 SUB
,&while JMP
&done
POP JMP2r
( emit a single byte in hexadecimal notation )
@emit
DUP #04 SFT ,&char JSR
&char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
JMP2r