From f72ef5a72f07e9f899e7032fe04be83eb55f69cb Mon Sep 17 00:00:00 2001 From: mgcaret Date: Wed, 1 Jan 2020 23:20:53 -0800 Subject: [PATCH] Add 7.3.3 and 7.3.4 unit tests --- test/7.3.3.fs | 168 ++++++++++++++++++++++++++++++++++++++++ test/7.3.4.fs | 77 ++++++++++++++++++ test/test-manifest.yaml | 9 +++ 3 files changed, 254 insertions(+) create mode 100644 test/7.3.3.fs create mode 100644 test/7.3.4.fs diff --git a/test/7.3.3.fs b/test/7.3.3.fs new file mode 100644 index 0000000..ca84b9e --- /dev/null +++ b/test/7.3.3.fs @@ -0,0 +1,168 @@ +false CONSTANT +true CONSTANT + +testing 7.3.3.1 Memory access + +\ the unaligned- words are not tested here because they are +\ aliases to the standard version of the words since OF816 +\ has no alignment restrictions + +\ the words are tested somewhat out of order from how they +\ appear in IEEE 1275-1994 7.3.3.1 + +\ not tested yet: COMP, DUMP, WBFLIPS, LBFLIPS, LWFLIPS + +HERE 1 , +HERE 2 , +CONSTANT 2ND +CONSTANT 1ST +T{ 1ST 2ND U< -> }T \ HERE MUST GROW WITH ALLOT +T{ 1ST CELL+ -> 2ND }T \ ... BY ONE CELL +T{ 1ST 1 CELLS + -> 2ND }T +T{ 1ST @ 2ND @ -> 1 2 }T +T{ 5 1ST ! -> }T +T{ 1ST @ 2ND @ -> 5 2 }T +T{ 6 2ND ! -> }T +T{ 1ST @ 2ND @ -> 5 6 }T +T{ 1ST 2@ -> 6 5 }T +T{ 2 1 1ST 2! -> }T +T{ 1ST 2@ -> 2 1 }T +T{ 1S 1ST ! 1ST @ -> 1S }T \ CAN STORE CELL-WIDE VALUE +t{ 1st off -> }t +t{ 1st @ -> }t +t{ 1st on -> }t +t{ 1st @ -> }t + +HERE 1 C, +HERE 2 C, +CONSTANT 2NDC +CONSTANT 1STC +T{ 1STC 2NDC U< -> }T \ HERE MUST GROW WITH ALLOT +T{ 1STC CHAR+ -> 2NDC }T \ ... BY ONE CHAR +T{ 1STC 1 CHARS + -> 2NDC }T +T{ 1STC C@ 2NDC C@ -> 1 2 }T +T{ 3 1STC C! -> }T +T{ 1STC C@ 2NDC C@ -> 3 2 }T +T{ 4 2NDC C! -> }T +T{ 1STC C@ 2NDC C@ -> 3 4 }T + +HERE 1 w, +HERE 2 w, +CONSTANT 2NDw +CONSTANT 1STw +T{ 1STw 2NDw U< -> }T \ HERE MUST GROW WITH ALLOT +T{ 1STw wa1+ -> 2NDw }T \ ... BY ONE CHAR +T{ 1STw 1 /w* + -> 2NDw }T +T{ 1STw w@ 2NDw w@ -> 1 2 }T +T{ 3 1STw w! -> }T +T{ 1STw w@ 2NDw w@ -> 3 2 }T +T{ 4 2NDw w! -> }T +T{ 1STw w@ 2NDw w@ -> 3 4 }T + +\ test sign extension of }t +t{ 1stw -1 }t + +HERE 1 l, +HERE 2 l, +CONSTANT 2NDl +CONSTANT 1STl +T{ 1STl 2NDl U< -> }T \ HERE MUST GROW WITH ALLOT +T{ 1STl la1+ -> 2NDl }T \ ... BY ONE CHAR +T{ 1STl 1 /l* + -> 2NDl }T +T{ 1STl l@ 2NDl l@ -> 1 2 }T +T{ 3 1STl l! -> }T +T{ 1STl w@ 2NDl l@ -> 3 2 }T +T{ 4 2NDl l! -> }T +T{ 1STl w@ 2NDl l@ -> 3 4 }T + +ALIGN 1 ALLOT HERE ALIGN HERE 3 CELLS ALLOT +CONSTANT A-ADDR CONSTANT UA-ADDR +T{ UA-ADDR ALIGNED -> A-ADDR }T +T{ 1 A-ADDR C! A-ADDR C@ -> 1 }T +T{ 1234 A-ADDR ! A-ADDR @ -> 1234 }T +T{ 123 456 A-ADDR 2! A-ADDR 2@ -> 123 456 }T +T{ 2 A-ADDR CHAR+ C! A-ADDR CHAR+ C@ -> 2 }T +T{ 3 A-ADDR CELL+ C! A-ADDR CELL+ C@ -> 3 }T +T{ 1234 A-ADDR CELL+ ! A-ADDR CELL+ @ -> 1234 }T +T{ 123 456 A-ADDR CELL+ 2! A-ADDR CELL+ 2@ -> 123 456 }T + +T{ 0 1ST ! -> }T +T{ 1 1ST +! -> }T +T{ 1ST @ -> 1 }T +T{ -1 1ST +! 1ST @ -> 0 }T + +CREATE FBUF 00 C, 00 C, 00 C, +CREATE SBUF 12 C, 34 C, 56 C, +: SEEBUF FBUF C@ FBUF CHAR+ C@ FBUF CHAR+ CHAR+ C@ ; + +T{ FBUF 0 20 FILL -> }T +T{ SEEBUF -> 00 00 00 }T + +T{ FBUF 1 20 FILL -> }T +T{ SEEBUF -> 20 00 00 }T + +T{ FBUF 3 20 FILL -> }T +T{ SEEBUF -> 20 20 20 }T + +T{ FBUF FBUF 3 CHARS MOVE -> }T \ BIZARRE SPECIAL CASE +T{ SEEBUF -> 20 20 20 }T + +T{ SBUF FBUF 0 CHARS MOVE -> }T +T{ SEEBUF -> 20 20 20 }T + +T{ SBUF FBUF 1 CHARS MOVE -> }T +T{ SEEBUF -> 12 20 20 }T + +T{ SBUF FBUF 3 CHARS MOVE -> }T +T{ SEEBUF -> 12 34 56 }T + +T{ FBUF FBUF CHAR+ 2 CHARS MOVE -> }T +T{ SEEBUF -> 12 12 34 }T + +T{ FBUF CHAR+ FBUF 2 CHARS MOVE -> }T +T{ SEEBUF -> 12 34 34 }T + +84 CONSTANT CHARS/PAD \ Minimum size of PAD in chars +CHARS/PAD CHARS CONSTANT AUS/PAD +: CHECKPAD ( caddr u ch -- f ) \ f = TRUE if u chars = ch + SWAP 0 + ?DO + OVER I CHARS + C@ OVER <> + IF 2DROP UNLOOP FALSE EXIT THEN + LOOP + 2DROP TRUE +; + +T{ PAD DROP -> }T +T{ 0 INVERT PAD C! -> }T +T{ PAD C@ CONSTANT MAXCHAR -> }T +T{ PAD CHARS/PAD 2DUP MAXCHAR FILL MAXCHAR CHECKPAD -> TRUE }T +T{ PAD CHARS/PAD 2DUP CHARS ERASE 0 CHECKPAD -> TRUE }T +T{ PAD CHARS/PAD 2DUP MAXCHAR FILL PAD 0 ERASE MAXCHAR CHECKPAD -> TRUE }T +T{ PAD 43 CHARS + 9 CHARS ERASE -> }T +T{ PAD 43 MAXCHAR CHECKPAD -> TRUE }T +T{ PAD 43 CHARS + 9 0 CHECKPAD -> TRUE }T +T{ PAD 52 CHARS + CHARS/PAD 52 - MAXCHAR CHECKPAD -> TRUE }T + +t{ pad chars/pad 2dup blank bl checkpad -> true }t + +\ Check that use of WORD and pictured numeric output do not corrupt PAD +\ Minimum size of buffers for these are 33 chars and (2*n)+2 chars respectively +\ where n is number of bits per cell + +PAD CHARS/PAD ERASE +2 BASE ! +MAX-UINT MAX-UINT <# #S CHAR 1 DUP HOLD HOLD #> 2DROP +DECIMAL +BL WORD 12345678123456781234567812345678 DROP +T{ PAD CHARS/PAD 0 CHECKPAD -> TRUE }T + + +testing 7.3.3.2 Memory allocation + +\ todo: adapt alloc/free tests + +t{ 100 alloc-mem debug-mem 100 free-mem -> }t + + diff --git a/test/7.3.4.fs b/test/7.3.4.fs new file mode 100644 index 0000000..59220b5 --- /dev/null +++ b/test/7.3.4.fs @@ -0,0 +1,77 @@ +testing 7.3.4.1 Text input + +t{ 1 -> 1 }t ( t{ 1 -> 2 }t ) t{ 2 -> 2 }t +t{ 1 -> 1 }t \ t{ 1 -> 2 }t + +t{ >in @ 0> -> true }t +t{ ascii / parse test/ swap 0> -> 4 true }t +t{ parse-word test swap 0> -> 4 true }t +t{ source 0> swap 0> -> true true }t +t{ word test count swap 0> -> 4 true }t + +testing 7.3.4.2 Console input +\ not functionally tested + +t{ ' key? 0> -> true }t +t{ ' key 0> -> true }t +t{ ' expect 0> -> true }t +t{ ' span 0> -> true }t +t{ ' accept 0> -> true }t + +testing 7.3.4.3 ASCII constants + +hex + +t{ bell -> 07 }t +t{ bl -> 20 }t +t{ bs -> 08 }t +t{ carret -> 0D }t +t{ linefeed -> 0A }t +t{ ascii A -> 41 }t +t{ char A -> 41 }t + +t{ : an-a [char] A ; -> }t +t{ an-a -> 41 }t + +t{ control A -> 01 }t + +testing 7.3.4.4 Console output + +t{ ." test" -> }t +t{ .( test ) -> }t +t{ 41 emit -> }t +t{ parse-word test type -> }t + +testing 7.3.4.5 Output formatting + +t{ cr -> }t +t{ space -> }t +t{ 10 spaces -> }t +t{ #line @ 0>= -> true }t +t{ #out @ 0>= -> true }t + +testing 7.3.4.6 Display pause +\ not functionally tested + +t{ ' exit? 0> -> true }t + +testing 7.3.4.7 String literals + +t{ " test" swap 0> -> 4 true }t +t{ s" test" swap 0> -> 4 true }t +t{ " test"(41)" swap 0> -> 5 true }t +t{ s" testA" drop " test"(41)" comp -> 0 }t + +testing 7.3.4.8 String manipulation +\ these aren't very good but hey + +\ count tested above, sort of, and sort of again, here +\ along with pack +t{ s" AAAAA" drop >r s" BBBB" r> pack count swap 0> -> 4 true }t + +t{ ascii a ascii A lcc = -> true }t +t{ ascii b ascii b lcc = -> true }t +t{ ascii A ascii a upc = -> true }t +t{ ascii B ascii B upc = -> true }t +t{ s" abc " -trailing nip 3 = -> true }t + diff --git a/test/test-manifest.yaml b/test/test-manifest.yaml index 1799663..62b4121 100644 --- a/test/test-manifest.yaml +++ b/test/test-manifest.yaml @@ -25,6 +25,15 @@ load: - tester.fs - 7.3.2.5.fs +- name: 7.3.3 Memory control + load: + - tester.fs + - test-utils.fs + - 7.3.3.fs +- name: 7.3.4 Text input + load: + - tester.fs + - 7.3.4.fs - name: 7.3.6 Comparison operators load: - tester.fs