bob hamming leap. testing updates.
This commit is contained in:
3
.gitignore
vendored
3
.gitignore
vendored
@@ -2,4 +2,5 @@
|
|||||||
.DS_Store
|
.DS_Store
|
||||||
bin/configlet
|
bin/configlet
|
||||||
bin/configlet.exe
|
bin/configlet.exe
|
||||||
bin/**
|
bin/**
|
||||||
|
*.bak
|
||||||
@@ -8,4 +8,27 @@
|
|||||||
|
|
||||||
Security isn't an afterthought in 8th. It was designed from the beginning to avoid the most common software security problems. We continually work to make it even more secure.
|
Security isn't an afterthought in 8th. It was designed from the beginning to avoid the most common software security problems. We continually work to make it even more secure.
|
||||||
|
|
||||||
8th has a [forum](https://8th-dev.com/forum/) as well as extensive documentation including a [manual](https://8th-dev.com/manual.html), and a hyperlinked dictionary of builtin and library [words](https://8th-dev.com/words.html). [Compare](https://8th-dev.com/compare.html) 8th with other languages!
|
8th has a [forum](https://8th-dev.com/forum/) as well as extensive documentation including a [manual](https://8th-dev.com/manual.html), and a hyperlinked dictionary of builtin and library [words](https://8th-dev.com/words.html). [Compare](https://8th-dev.com/compare.html) 8th with other languages!
|
||||||
|
|
||||||
|
|
||||||
|
# Quick introduction for users of “mainstream” languages
|
||||||
|
|
||||||
|
If you’re coming from C or Java or most more common languages, you may find 8th a bit puzzling. To help set you on the right path, here are some of the primary differences between 8th and “the mainstream”, as well as some helpful hints:
|
||||||
|
|
||||||
|
* As a consequence of the way the interpreter looks up items, you must declare a var or a word prior to its first use. Failure to do so will result in the exception can’t find ...
|
||||||
|
|
||||||
|
* A var is a named container for other items. It is not the name of the item referred to! So var x may hold an array, but it is wrong to try to access x as if it were itself an array, and doing so will cause an exception to be thrown
|
||||||
|
|
||||||
|
* You cannot declare a var inside (e.g. local to) a word, don’t try it! You can, however, use w:@ and w:! to access word-local variables
|
||||||
|
|
||||||
|
* Try to write your own words so that they can be chained together with other words. For example: the “file words” do some operation on a file and leave the file item on the stack (and perhaps other information) for the next word to work on
|
||||||
|
|
||||||
|
* Keep your words short. Comment them. Be sure, especially, to comment the stack-effect, and…
|
||||||
|
|
||||||
|
* … test each word you write (preferably as you write it or shortly thereafter), ensuring it adheres to its documented SED (Stack-Effect Diagram). This will help you write bug-free code. Re-test if you change the SED or the code
|
||||||
|
|
||||||
|
* Consult the help and apropos words for details on the SED action, and side-effects of any word you aren’t sure of
|
||||||
|
|
||||||
|
* In 8th, an exception is a fatal error, and will cause the application to quit (this is the default behavior). Don’t expect to “catch” one and handle it effectively
|
||||||
|
|
||||||
|
* There is no compile/link cycle. Instead, 8th is an engine which first interprets your code and if necessary compiles it at runtime. When running on a device, your code is native code for the platform, not bytecode running inside a VM
|
||||||
|
|||||||
16
exercises/practice/bob/.docs/instructions.md
Normal file
16
exercises/practice/bob/.docs/instructions.md
Normal file
@@ -0,0 +1,16 @@
|
|||||||
|
# Instructions
|
||||||
|
|
||||||
|
Bob is a lackadaisical teenager. In conversation, his responses are very limited.
|
||||||
|
|
||||||
|
Bob answers 'Sure.' if you ask him a question, such as "How are you?".
|
||||||
|
|
||||||
|
He answers 'Whoa, chill out!' if you YELL AT HIM (in all capitals).
|
||||||
|
|
||||||
|
He answers 'Calm down, I know what I'm doing!' if you yell a question at him.
|
||||||
|
|
||||||
|
He says 'Fine. Be that way!' if you address him without actually saying
|
||||||
|
anything.
|
||||||
|
|
||||||
|
He answers 'Whatever.' to anything else.
|
||||||
|
|
||||||
|
Bob's conversational partner is a purist when it comes to written communication and always follows normal rules regarding sentence punctuation in English.
|
||||||
12
exercises/practice/bob/.meta/config.json
Normal file
12
exercises/practice/bob/.meta/config.json
Normal file
@@ -0,0 +1,12 @@
|
|||||||
|
{
|
||||||
|
"blurb": "Bob is a lackadaisical teenager. In conversation, his responses are very limited.",
|
||||||
|
"authors": ["axtens"],
|
||||||
|
"files": {
|
||||||
|
"solution": ["bob.8th"],
|
||||||
|
"test": ["bob_tests.8th"],
|
||||||
|
"example": [".meta/example.8th"]
|
||||||
|
},
|
||||||
|
"source": "Inspired by the 'Deaf Grandma' exercise in Chris Pine's Learn to Program tutorial.",
|
||||||
|
"source_url": "http://pine.fm/LearnToProgram/?Chapter=06"
|
||||||
|
}
|
||||||
|
|
||||||
40
exercises/practice/bob/.meta/example.8th
Normal file
40
exercises/practice/bob/.meta/example.8th
Normal file
@@ -0,0 +1,40 @@
|
|||||||
|
: is_question \ s -- b
|
||||||
|
s:trim 1 s:rsub "?" s:=
|
||||||
|
;
|
||||||
|
|
||||||
|
: is_silence \ s -- b
|
||||||
|
s:trim s:len 0 n:=
|
||||||
|
;
|
||||||
|
|
||||||
|
: is_shouting \ s -- b
|
||||||
|
dup
|
||||||
|
dup
|
||||||
|
/[A-Z]/ r:/ a:len nip 0 n:> \ s1 s2 -- s1 b
|
||||||
|
swap
|
||||||
|
/[a-z]/ r:/ a:len nip 0 n:= \ s1 b -- b b
|
||||||
|
and
|
||||||
|
;
|
||||||
|
|
||||||
|
: bob \ s -- s
|
||||||
|
is_silence if
|
||||||
|
"Fine. Be that way"
|
||||||
|
else
|
||||||
|
dup
|
||||||
|
is_shouting swap is_question and if
|
||||||
|
"Calm down, I know what I'm doing!"
|
||||||
|
else
|
||||||
|
dup
|
||||||
|
is_shouting swap is_question not and if
|
||||||
|
"Whoa, chill out!"
|
||||||
|
else
|
||||||
|
dup
|
||||||
|
is_shouting not swap is_question and if
|
||||||
|
"Sure."
|
||||||
|
else
|
||||||
|
"Whatever."
|
||||||
|
then
|
||||||
|
then
|
||||||
|
then
|
||||||
|
then
|
||||||
|
nip
|
||||||
|
;
|
||||||
3
exercises/practice/bob/bob.8th
Normal file
3
exercises/practice/bob/bob.8th
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
: bob \ s -- s
|
||||||
|
|
||||||
|
;
|
||||||
23
exercises/practice/bob/bob_tests.8th
Normal file
23
exercises/practice/bob/bob_tests.8th
Normal file
@@ -0,0 +1,23 @@
|
|||||||
|
"test_lib.8th" f:include
|
||||||
|
|
||||||
|
"bob.8th" f:include
|
||||||
|
|
||||||
|
with: test
|
||||||
|
|
||||||
|
{ " " bob .eqs. "Fine. Be that way!" }
|
||||||
|
{ "" bob .eqs. "Fine. Be that way!" }
|
||||||
|
{ "1, 2, 3 GO!" bob .eqs. "Whoa, chill out!" }
|
||||||
|
{ "1, 2, 3" bob .eqs. "Whatever." }
|
||||||
|
{ "4?" bob .eqs. "Sure." }
|
||||||
|
{ "Does this cryogenic chamber make me look fat?" & vbLf & "no" bob .eqs. "Whatever." }
|
||||||
|
{ "Does this cryogenic chamber make me look fat?" bob .eqs. "Sure." }
|
||||||
|
{ "Ending with ? means a question." bob .eqs. "Whatever." }
|
||||||
|
{ "I HATE YOU" bob .eqs. "Whoa, chill out!" }
|
||||||
|
{ "It's OK if you don't want to go to the DMV." bob .eqs. "Whatever." }
|
||||||
|
{ "Let's go make out behind the gym!" bob .eqs. "Whatever." }
|
||||||
|
{ "Tom-ay-to, tom-aaaah-to." bob .eqs. "Whatever." }
|
||||||
|
{ "WATCH OUT!" bob .eqs. "Whoa, chill out!" }
|
||||||
|
{ "WHAT THE HELL WERE YOU THINKING?" bob .eqs. "Calm down, I know what I'm doing!" }
|
||||||
|
{ "Wait! Hang on. Are you going to be OK?" bob .eqs. "Sure." }
|
||||||
|
{ "You are, what, like 15?" bob .eqs. "Sure." }
|
||||||
|
{ "ZOMG THE %^*@#$(*^ ZOMBIES ARE COMING!!11!!1!" bob .eqs. "Whoa, chill out!" }
|
||||||
57
exercises/practice/bob/test_lib.8th
Normal file
57
exercises/practice/bob/test_lib.8th
Normal file
@@ -0,0 +1,57 @@
|
|||||||
|
ns: test
|
||||||
|
|
||||||
|
private
|
||||||
|
( swap s:= ) var, test_op
|
||||||
|
|
||||||
|
: set_op \ w --
|
||||||
|
test_op !
|
||||||
|
;
|
||||||
|
|
||||||
|
: get_op \ -- w
|
||||||
|
test_op @
|
||||||
|
;
|
||||||
|
public
|
||||||
|
|
||||||
|
\ Does nothing but introduce a test
|
||||||
|
: test:{ \ --
|
||||||
|
;
|
||||||
|
|
||||||
|
\ Convert data-stack to array, compare with current content of r-stack
|
||||||
|
: test:} \ * --
|
||||||
|
depth a:close r> #p:get_op a:=
|
||||||
|
if
|
||||||
|
2drop "OK" . cr
|
||||||
|
else
|
||||||
|
swap
|
||||||
|
"FAIL! Expected:" .
|
||||||
|
.
|
||||||
|
" Received:" .
|
||||||
|
.
|
||||||
|
cr
|
||||||
|
then
|
||||||
|
reset \ clear data stack
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.eqs. \ * --
|
||||||
|
( >s swap >s s:= ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.nes. \ * --
|
||||||
|
( >s swap >s s:= not ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.eq. \ * --
|
||||||
|
( >n swap >n n:= ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.ne. \ * --
|
||||||
|
( >n swap >n n:= not ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
21
exercises/practice/hamming/.docs/instructions.md
Normal file
21
exercises/practice/hamming/.docs/instructions.md
Normal file
@@ -0,0 +1,21 @@
|
|||||||
|
# Instructions
|
||||||
|
|
||||||
|
Calculate the Hamming Distance between two DNA strands.
|
||||||
|
|
||||||
|
Your body is made up of cells that contain DNA. Those cells regularly wear out and need replacing, which they achieve by dividing into daughter cells. In fact, the average human body experiences about 10 quadrillion cell divisions in a lifetime!
|
||||||
|
|
||||||
|
When cells divide, their DNA replicates too. Sometimes during this process mistakes happen and single pieces of DNA get encoded with the incorrect information. If we compare two strands of DNA and count the differences between them we can see how many mistakes occurred. This is known as the "Hamming Distance".
|
||||||
|
|
||||||
|
We read DNA using the letters C,A,G and T. Two strands might look like this:
|
||||||
|
|
||||||
|
GAGCCTACTAACGGGAT
|
||||||
|
CATCGTAATGACGGCCT
|
||||||
|
^ ^ ^ ^ ^ ^^
|
||||||
|
|
||||||
|
They have 7 differences, and therefore the Hamming Distance is 7.
|
||||||
|
|
||||||
|
The Hamming Distance is useful for lots of things in science, not just biology, so it's a nice phrase to be familiar with :)
|
||||||
|
|
||||||
|
# Implementation notes
|
||||||
|
|
||||||
|
The Hamming distance is only defined for sequences of equal length, so an attempt to calculate it between sequences of different lengths should not work. The general handling of this situation (e.g., raising an exception vs returning a special value) may differ between languages.
|
||||||
18
exercises/practice/hamming/.meta/config.json
Normal file
18
exercises/practice/hamming/.meta/config.json
Normal file
@@ -0,0 +1,18 @@
|
|||||||
|
{
|
||||||
|
"blurb": "Calculate the Hamming difference between two DNA strands.",
|
||||||
|
"authors": ["axtens"],
|
||||||
|
"files": {
|
||||||
|
"solution": [
|
||||||
|
"hamming.8th"
|
||||||
|
],
|
||||||
|
"test": [
|
||||||
|
"hamming_tests.8th"
|
||||||
|
],
|
||||||
|
"example": [
|
||||||
|
".meta/example.8th"
|
||||||
|
]
|
||||||
|
},
|
||||||
|
"source": "The Calculating Point Mutations problem at Rosalind",
|
||||||
|
"source_url": "http://rosalind.info/problems/hamm/"
|
||||||
|
}
|
||||||
|
|
||||||
14
exercises/practice/hamming/.meta/example.8th
Normal file
14
exercises/practice/hamming/.meta/example.8th
Normal file
@@ -0,0 +1,14 @@
|
|||||||
|
: distance \ s1 s2 | n
|
||||||
|
null s:/ a:len \ s1 a2 n2
|
||||||
|
rot \ a2 n2 s1
|
||||||
|
null s:/ a:len \ a2 n2 a1 n1
|
||||||
|
rot \ a2 a1 n2 n1
|
||||||
|
n:= not \ a2 a1 b
|
||||||
|
if
|
||||||
|
null nip nip
|
||||||
|
else \ a2 a1
|
||||||
|
( s:= ) a:diff a:len nip \ a3 n3
|
||||||
|
then
|
||||||
|
;
|
||||||
|
|
||||||
|
|
||||||
3
exercises/practice/hamming/hamming.8th
Normal file
3
exercises/practice/hamming/hamming.8th
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
: distance \ s1 s2 -- n
|
||||||
|
|
||||||
|
;
|
||||||
17
exercises/practice/hamming/hamming_tests.8th
Normal file
17
exercises/practice/hamming/hamming_tests.8th
Normal file
@@ -0,0 +1,17 @@
|
|||||||
|
"test_lib.8th" f:include
|
||||||
|
|
||||||
|
"hamming.8th" f:include
|
||||||
|
|
||||||
|
with: test
|
||||||
|
|
||||||
|
{ 0 .eq. "" "" distance }
|
||||||
|
{ 0 .eq. "A" "A" distance }
|
||||||
|
{ 0 .eq. "GGACTGAAATCTG" "GGACTGAAATCTG" distance }
|
||||||
|
{ 1 .eq. "G" "T" distance }
|
||||||
|
{ 9 .eq. "GGACGGATTCTG" "AGGACGGATTCT" distance }
|
||||||
|
{ null .eq. "" "G" distance }
|
||||||
|
{ null .eq. "AATG" "AAA" distance }
|
||||||
|
{ null .eq. "ATA" "AGTG" distance }
|
||||||
|
{ null .eq. "G" "" distance }
|
||||||
|
|
||||||
|
bye
|
||||||
57
exercises/practice/hamming/test_lib.8th
Normal file
57
exercises/practice/hamming/test_lib.8th
Normal file
@@ -0,0 +1,57 @@
|
|||||||
|
ns: test
|
||||||
|
|
||||||
|
private
|
||||||
|
( swap s:= ) var, test_op
|
||||||
|
|
||||||
|
: set_op \ w --
|
||||||
|
test_op !
|
||||||
|
;
|
||||||
|
|
||||||
|
: get_op \ -- w
|
||||||
|
test_op @
|
||||||
|
;
|
||||||
|
public
|
||||||
|
|
||||||
|
\ Does nothing but introduce a test
|
||||||
|
: test:{ \ --
|
||||||
|
;
|
||||||
|
|
||||||
|
\ Convert data-stack to array, compare with current content of r-stack
|
||||||
|
: test:} \ * --
|
||||||
|
depth a:close r> #p:get_op a:=
|
||||||
|
if
|
||||||
|
2drop "OK" . cr
|
||||||
|
else
|
||||||
|
swap
|
||||||
|
"FAIL! Expected:" .
|
||||||
|
.
|
||||||
|
" Received:" .
|
||||||
|
.
|
||||||
|
cr
|
||||||
|
then
|
||||||
|
reset \ clear data stack
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.eqs. \ * --
|
||||||
|
( >s swap >s s:= ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.nes. \ * --
|
||||||
|
( >s swap >s s:= not ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.eq. \ * --
|
||||||
|
( >n swap >n n:= ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.ne. \ * --
|
||||||
|
( >n swap >n n:= not ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
@@ -2,10 +2,12 @@
|
|||||||
|
|
||||||
"hello-world.8th" f:include
|
"hello-world.8th" f:include
|
||||||
|
|
||||||
test:{
|
with: test
|
||||||
|
|
||||||
|
{
|
||||||
hello-world
|
hello-world
|
||||||
test:==
|
.eqs.
|
||||||
"Hello, World!"
|
"Hello, World!"
|
||||||
test:}
|
}
|
||||||
|
|
||||||
bye
|
bye
|
||||||
@@ -1,31 +1,57 @@
|
|||||||
ns: test
|
ns: test
|
||||||
|
|
||||||
private
|
private
|
||||||
|
( swap s:= ) var, test_op
|
||||||
|
|
||||||
|
: set_op \ w --
|
||||||
|
test_op !
|
||||||
|
;
|
||||||
|
|
||||||
|
: get_op \ -- w
|
||||||
|
test_op @
|
||||||
|
;
|
||||||
public
|
public
|
||||||
|
|
||||||
\ Does nothing but introduce a test
|
\ Does nothing but introduce a test
|
||||||
: test:{ \ --
|
: test:{ \ --
|
||||||
;
|
;
|
||||||
|
|
||||||
\ Convert data-stack to array, compare with current content of r-stack
|
\ Convert data-stack to array, compare with current content of r-stack
|
||||||
: test:} \ x --
|
: test:} \ * --
|
||||||
depth a:close r>
|
depth a:close r> #p:get_op a:=
|
||||||
( >s swap >s s:= ) a:=
|
|
||||||
if
|
if
|
||||||
2drop "OK" . cr
|
2drop "OK" . cr
|
||||||
else
|
else
|
||||||
swap
|
swap
|
||||||
"FAIL! Expected" .
|
"FAIL! Expected:" .
|
||||||
.
|
.
|
||||||
" Received" .
|
" Received:" .
|
||||||
.
|
.
|
||||||
cr
|
cr
|
||||||
then
|
then
|
||||||
reset \ clear data stack
|
reset \ clear data stack
|
||||||
;
|
;
|
||||||
|
|
||||||
\ Convert data-stack to array and move to r-stack
|
: test:.eqs. \ * --
|
||||||
: test:== \ x --
|
( >s swap >s s:= ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
depth a:close >r
|
depth a:close >r
|
||||||
;
|
;
|
||||||
|
|
||||||
|
: test:.nes. \ * --
|
||||||
|
( >s swap >s s:= not ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.eq. \ * --
|
||||||
|
( >n swap >n n:= ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.ne. \ * --
|
||||||
|
( >n swap >n n:= not ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|||||||
24
exercises/practice/leap/.docs/instructions.md
Normal file
24
exercises/practice/leap/.docs/instructions.md
Normal file
@@ -0,0 +1,24 @@
|
|||||||
|
# Instructions
|
||||||
|
|
||||||
|
Given a year, report if it is a leap year.
|
||||||
|
|
||||||
|
The tricky thing here is that a leap year in the Gregorian calendar occurs:
|
||||||
|
|
||||||
|
```text
|
||||||
|
on every year that is evenly divisible by 4
|
||||||
|
except every year that is evenly divisible by 100
|
||||||
|
unless the year is also evenly divisible by 400
|
||||||
|
```
|
||||||
|
|
||||||
|
For example, 1997 is not a leap year, but 1996 is. 1900 is not a leap
|
||||||
|
year, but 2000 is.
|
||||||
|
|
||||||
|
## Notes
|
||||||
|
|
||||||
|
Though our exercise adopts some very simple rules, there is more to
|
||||||
|
learn!
|
||||||
|
|
||||||
|
For a delightful, four minute explanation of the whole leap year
|
||||||
|
phenomenon, go watch [this youtube video][video].
|
||||||
|
|
||||||
|
[video]: http://www.youtube.com/watch?v=xX96xng7sAE
|
||||||
19
exercises/practice/leap/.meta/config.json
Normal file
19
exercises/practice/leap/.meta/config.json
Normal file
@@ -0,0 +1,19 @@
|
|||||||
|
{
|
||||||
|
"blurb": "Given a year, report if it is a leap year.",
|
||||||
|
"authors": [
|
||||||
|
"axtens"
|
||||||
|
],
|
||||||
|
"files": {
|
||||||
|
"solution": [
|
||||||
|
"leap.8th"
|
||||||
|
],
|
||||||
|
"test": [
|
||||||
|
"leap_tests.8th"
|
||||||
|
],
|
||||||
|
"example": [
|
||||||
|
".meta/example.8th"
|
||||||
|
]
|
||||||
|
},
|
||||||
|
"source": "JavaRanch Cattle Drive, exercise 3",
|
||||||
|
"source_url": "http://www.javaranch.com/leap.jsp"
|
||||||
|
}
|
||||||
6
exercises/practice/leap/.meta/example.8th
Normal file
6
exercises/practice/leap/.meta/example.8th
Normal file
@@ -0,0 +1,6 @@
|
|||||||
|
\ Based on FORTH version at http://rosettacode.org/wiki/Leap_year#Forth
|
||||||
|
: leap-year? \ n -- b
|
||||||
|
dup 400 n:mod not if drop true ;; then
|
||||||
|
dup 100 n:mod not if drop false ;; then
|
||||||
|
4 n:mod not
|
||||||
|
;
|
||||||
6
exercises/practice/leap/leap.8th
Normal file
6
exercises/practice/leap/leap.8th
Normal file
@@ -0,0 +1,6 @@
|
|||||||
|
\ Based on FORTH version at http://rosettacode.org/wiki/Leap_year#Forth
|
||||||
|
: leap-year? SED: n -- b
|
||||||
|
dup 400 n:mod not if drop true ;; then
|
||||||
|
dup 100 n:mod not if drop false ;; then
|
||||||
|
4 n:mod not
|
||||||
|
;
|
||||||
17
exercises/practice/leap/leap_tests.8th
Normal file
17
exercises/practice/leap/leap_tests.8th
Normal file
@@ -0,0 +1,17 @@
|
|||||||
|
"test_lib.8th" f:include
|
||||||
|
|
||||||
|
"leap.8th" f:include
|
||||||
|
|
||||||
|
with: test
|
||||||
|
|
||||||
|
{ false .eq. 1800 leap-year? }
|
||||||
|
{ false .eq. 1900 leap-year? }
|
||||||
|
{ false .eq. 1970 leap-year? }
|
||||||
|
{ false .eq. 2015 leap-year? }
|
||||||
|
{ false .eq. 2100 leap-year? }
|
||||||
|
{ true .eq. 1960 leap-year? }
|
||||||
|
{ true .eq. 1996 leap-year? }
|
||||||
|
{ true .eq. 2000 leap-year? }
|
||||||
|
{ true .eq. 2400 leap-year? }
|
||||||
|
|
||||||
|
bye
|
||||||
57
exercises/practice/leap/test_lib.8th
Normal file
57
exercises/practice/leap/test_lib.8th
Normal file
@@ -0,0 +1,57 @@
|
|||||||
|
ns: test
|
||||||
|
|
||||||
|
private
|
||||||
|
( swap s:= ) var, test_op
|
||||||
|
|
||||||
|
: set_op \ w --
|
||||||
|
test_op !
|
||||||
|
;
|
||||||
|
|
||||||
|
: get_op \ -- w
|
||||||
|
test_op @
|
||||||
|
;
|
||||||
|
public
|
||||||
|
|
||||||
|
\ Does nothing but introduce a test
|
||||||
|
: test:{ \ --
|
||||||
|
;
|
||||||
|
|
||||||
|
\ Convert data-stack to array, compare with current content of r-stack
|
||||||
|
: test:} \ * --
|
||||||
|
depth a:close r> #p:get_op a:=
|
||||||
|
if
|
||||||
|
2drop "OK" . cr
|
||||||
|
else
|
||||||
|
swap
|
||||||
|
"FAIL! Expected:" .
|
||||||
|
.
|
||||||
|
" Received:" .
|
||||||
|
.
|
||||||
|
cr
|
||||||
|
then
|
||||||
|
reset \ clear data stack
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.eqs. \ * --
|
||||||
|
( >s swap >s s:= ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.nes. \ * --
|
||||||
|
( >s swap >s s:= not ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.eq. \ * --
|
||||||
|
( >n swap >n n:= ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.ne. \ * --
|
||||||
|
( >n swap >n n:= not ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
@@ -1,4 +1,4 @@
|
|||||||
: twofer \ ? -- s
|
: twofer \ * -- s
|
||||||
depth 1 n:=
|
depth 1 n:=
|
||||||
if
|
if
|
||||||
"One for " swap s:+ ", one for me." s:+
|
"One for " swap s:+ ", one for me." s:+
|
||||||
|
|||||||
@@ -1,31 +1,57 @@
|
|||||||
ns: test
|
ns: test
|
||||||
|
|
||||||
private
|
private
|
||||||
|
( swap s:= ) var, test_op
|
||||||
|
|
||||||
|
: set_op \ w --
|
||||||
|
test_op !
|
||||||
|
;
|
||||||
|
|
||||||
|
: get_op \ -- w
|
||||||
|
test_op @
|
||||||
|
;
|
||||||
public
|
public
|
||||||
|
|
||||||
\ Does nothing but introduce a test
|
\ Does nothing but introduce a test
|
||||||
: test:{ \ --
|
: test:{ \ --
|
||||||
;
|
;
|
||||||
|
|
||||||
\ Convert data-stack to array, compare with current content of r-stack
|
\ Convert data-stack to array, compare with current content of r-stack
|
||||||
: test:} \ x --
|
: test:} \ * --
|
||||||
depth a:close r>
|
depth a:close r> #p:get_op a:=
|
||||||
( >s swap >s s:= ) a:=
|
|
||||||
if
|
if
|
||||||
2drop "OK" . cr
|
2drop "OK" . cr
|
||||||
else
|
else
|
||||||
swap
|
swap
|
||||||
"FAIL! Expected" .
|
"FAIL! Expected:" .
|
||||||
.
|
.
|
||||||
" Received" .
|
" Received:" .
|
||||||
.
|
.
|
||||||
cr
|
cr
|
||||||
then
|
then
|
||||||
reset \ clear data stack
|
reset \ clear data stack
|
||||||
;
|
;
|
||||||
|
|
||||||
\ Convert data-stack to array and move to r-stack
|
: test:.eqs. \ * --
|
||||||
: test:== \ x --
|
( >s swap >s s:= ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
depth a:close >r
|
depth a:close >r
|
||||||
;
|
;
|
||||||
|
|
||||||
|
: test:.nes. \ * --
|
||||||
|
( >s swap >s s:= not ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.eq. \ * --
|
||||||
|
( >n swap >n n:= ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|
||||||
|
: test:.ne. \ * --
|
||||||
|
( >n swap >n n:= not ) #p:set_op
|
||||||
|
\ Convert data-stack to array and move to r-stack
|
||||||
|
depth a:close >r
|
||||||
|
;
|
||||||
|
|||||||
@@ -2,25 +2,27 @@
|
|||||||
|
|
||||||
"two-fer.8th" f:include
|
"two-fer.8th" f:include
|
||||||
|
|
||||||
test:{
|
with: test
|
||||||
|
|
||||||
|
{
|
||||||
two-fer
|
two-fer
|
||||||
test:==
|
.eqs.
|
||||||
"One for you, one for me."
|
"One for you, one for me."
|
||||||
test:}
|
}
|
||||||
|
|
||||||
|
|
||||||
test:{
|
{
|
||||||
"Jedoon" two-fer
|
"Jedoon" two-fer
|
||||||
test:==
|
.eqs.
|
||||||
"One for Jedoon, one for me."
|
"One for Jedoon, one for me."
|
||||||
test:}
|
}
|
||||||
|
|
||||||
|
|
||||||
test:{
|
{
|
||||||
"Hazelelponi" two-fer
|
"Hazelelponi" two-fer
|
||||||
test:==
|
.eqs.
|
||||||
"One for Hazelelponi, one for me."
|
"One for Hazelelponi, one for me."
|
||||||
test:}
|
}
|
||||||
|
|
||||||
|
|
||||||
bye
|
bye
|
||||||
Reference in New Issue
Block a user