Unify vocab test slightly.

This commit is contained in:
Brad Nelson
2022-01-30 12:20:15 -08:00
parent ed0fcc35d0
commit 7e8b15eeae
4 changed files with 39 additions and 60 deletions

View File

@ -173,7 +173,7 @@ WINDOWS_BOOT = common/boot.fs common/conditionals.fs common/vocabulary.fs \
windows/windows.fs windows/windows_highlevel.fs common/highlevel.fs \ windows/windows.fs windows/windows_highlevel.fs common/highlevel.fs \
common/tasks.fs common/utils.fs common/locals.fs common/desktop.fs \ common/tasks.fs common/utils.fs common/locals.fs common/desktop.fs \
common/filetools.fs common/streams.fs \ common/filetools.fs common/streams.fs \
common/blocks.fs common/locals.fs \ common/blocks.fs \
posix/autoboot.fs \ posix/autoboot.fs \
common/fini.fs common/fini.fs
$(GEN)/windows_boot.h: common/source_to_string.js $(WINDOWS_BOOT) | $(GEN) $(GEN)/windows_boot.h: common/source_to_string.js $(WINDOWS_BOOT) | $(GEN)

View File

@ -15,6 +15,38 @@
also internals also internals
: list-from ( xt ) begin dup >name-length while dup see. cr >link repeat drop ; : list-from ( xt ) begin dup >name-length while dup see. cr >link repeat drop ;
e: check-locals
out: +to
out: to
out: ;
out: {
out: (local)
;e
e: check-highlevel-floats
out: f.s
out: f.
out: #fs
out: set-precision
out: precision
out: fsqrt
out: pi
out: fvariable
out: fconstant
out: fliteral
out: afliteral
out: sf,
out: sfloat+
out: sfloats
out: sfloat
out: f>=
out: f<=
out: f<>
out: f>
out: f<
out: f=
;e
DEFINED? windows [IF] DEFINED? windows [IF]
e: test-forth-namespace e: test-forth-namespace
@ -31,11 +63,6 @@ e: test-forth-namespace
e: test-forth-namespace e: test-forth-namespace
' forth list-from ' forth list-from
out: FORTH out: FORTH
out: +to
out: to
out: ;
out: {
out: (local)
out: editor out: editor
out: list out: list
out: copy out: copy
@ -63,11 +90,7 @@ e: test-forth-namespace
out: dump-file out: dump-file
out: argv out: argv
out: argc out: argc
out: +to check-locals
out: to
out: ;
out: {
out: (local)
out: words out: words
out: vlist out: vlist
out: order out: order
@ -114,27 +137,7 @@ e: test-forth-namespace
out: default-key out: default-key
out: default-type out: default-type
out: windows out: windows
out: f.s check-highlevel-floats
out: f.
out: #fs
out: set-precision
out: precision
out: fsqrt
out: pi
out: fvariable
out: fconstant
out: fliteral
out: afliteral
out: sf,
out: sfloat+
out: sfloats
out: sfloat
out: f>=
out: f<=
out: f<>
out: f>
out: f<
out: f=
out: page out: page
out: at-xy out: at-xy
out: normal out: normal
@ -420,11 +423,7 @@ e: test-forth-namespace
out: xlib out: xlib
out: argv out: argv
out: argc out: argc
out: +to check-locals
out: to
out: ;
out: {
out: (local)
out: reset out: reset
out: revive out: revive
out: startup: out: startup:
@ -478,27 +477,7 @@ e: test-forth-namespace
out: default-key out: default-key
out: default-type out: default-type
out: posix out: posix
out: f.s check-highlevel-floats
out: f.
out: #fs
out: set-precision
out: precision
out: fsqrt
out: pi
out: fvariable
out: fconstant
out: fliteral
out: afliteral
out: sf,
out: sfloat+
out: sfloats
out: sfloat
out: f>=
out: f<=
out: f<>
out: f>
out: f<
out: f=
out: page out: page
out: at-xy out: at-xy
out: normal out: normal

View File

@ -42,8 +42,8 @@ variable expect-used variable result-used
: expected ( -- a n ) expect-buffer expect-used @ ; : expected ( -- a n ) expect-buffer expect-used @ ;
: resulted ( -- a n ) result-buffer result-used @ ; : resulted ( -- a n ) result-buffer result-used @ ;
: out:cr nl expect-emit ; : out:cr nl expect-emit ;
: out: ( "line" -- ) nl parse expect-type nl expect-emit ;
: out:\ ( "line" -- ) nl parse expect-type ; : out:\ ( "line" -- ) nl parse expect-type ;
: out: ( "line" -- ) out:\ out:cr ;
variable confirm-old-type variable confirm-old-type
: confirm{ ['] type >body @ confirm-old-type ! ['] result-type is type ; : confirm{ ['] type >body @ confirm-old-type ! ['] result-type is type ;
: }confirm confirm-old-type @ is type ; : }confirm confirm-old-type @ is type ;

View File

@ -134,7 +134,7 @@ variable see-tally
['] tally-type is type ['] tally-type is type
see-all see-all
['] default-type is type ['] default-type is type
see-tally @ 36000 >assert see-tally @ 35000 >assert
; ;
( (