test.lcf

\documentclass{article}
\usepackage{verbatim}
\newenvironment{code}{\footnotesize\verbatim}{\endverbatim\normalsize}

\begin{document}
\section{Test Suite}
Some simple unit tests for cf. Mostly based on the examples given for
Functional False at:

http://nsl.com/k/f/f.htm

Many of these will fail due to cf using different primitives,
etc. These will be fixed over time, either by correcting the test for
the different primitive, or implementing new primitives.

Run with:

\$ ./cf prelude.cf test.lcf

\section{Code}

First we need some words for doing simple unit tests. The 'test' word
only prints the failed tests.

\begin{code}
[ 
  [[c]stack.[[]unstack.c.stack.[[]unstack.]`]`swap.unit.,unstack.] (
] infra set
[ 
  dup.[infra.=]`swap. [drop.] 
  [ a- ** write " passed\n" write ** ] 
  [ write " failed\n" write ] 
  cond. 
] test set
\end{code}

Now the tests themselves:

\begin{code}
[123]      [123]               test.
[123.45]   [123.45]            test.
[name]     [name]              test.
[]         [["abcd"] abcd set] test.
[["abcd"]] [abcd;]             test.
["abcd"]   [abcd.]            test.

[1 2] [2 1 ab-ba] test.
[3] [1 2 +] test.
[1] [3 2 -] test.
[12] [3 4 *] test.
[2] [4 2 %] test.
[8] [2 3 ^] test.
[3] [3.2 _] test.

[1] [2 2 =] test.
[0] [4 6 >] test.
[3] [4 3 &] test.

[1] [[1 2] [1 2] ~] test.

[[3]] [[1 2 3] #] test.

[[3 2 1]] [[1 2 3]|] test.

[[1 2]] [[2 [1 2 3]] /] test.
[[[1 2][3 1][2 3]]] [[3 2][1 2 3] /] test.

[[3]] [2[1 2 3] \] test.
[[[1 2][3]]] [[0 2][1 2 3] \] test.
[[3 4 1 2]] [[1 2 3 4] 2 \] test.

[1] [[10 20 30] 20 ?] test.

[[[0 2 3][1][4]]] [[10 20 10 10 30] :] test.

[5] [2 [3 +] .] test.
[5 4] [2 3 4 [+]`] test.
[[+]] ['+] test.

[[1 2 3]] [[1][2 3] ,] test.

\end{code}

Test the new unquote semantics introduced by commit id 82b61f

\begin{code}
[3] [[1 2 +].] test.
[foo] [foo.] test.
[3] [[1 2 +] foo set foo. ] test.
\end{code}

Test enum primitive

\begin{code}
[[0 1 2 3 4]] [5 enum] test.
\end{code}

Math Double Dispatch

\begin{code}
[4] [3 1 +] test.
[2] [3 1 -] test.
[6] [3 2 *] test.
[1] [4 3 % _] test.
[64] [4 3 ^] test.

[4.5] [3.5 1 +] test.
[2.5] [3.5 1 -] test.
[7] [3.5 2 *] test.
[2] [7.5 3 % _] test.
[15.625] [2.5 3 ^] test.

[[2 3.5 4]] [[1 2.5 3] 1 +] test.
[[0 1.5 2]] [[1 2.5 3] 1 -] test.
[[2 5 6]]   [[1 2.5 3] 2 *] test.
[[0.5 2 3]] [[1 4 6] 2 %] test.

[[2 4.5 6]] [[1 2.5 3] [1 2 3] +] test.
[[0 0.5 0]] [[1 2.5 3] [1 2 3] -] test.
[[1 5 9]] [[1 2.5 3] [1 2 3] *] test.
[[1 2 2]] [[1 4 6] [1 2 3] %] test.

[[-1]] [[2] 3 - ] test.
[[2]] [[8] 4 % ] test.
[[16]] [[4] 2 ^] test.
\end{code}

Indexing into lists

\begin{code}
[3] [2 [1 2 3] @] test.
[1] [0 [1 2 3] @] test.
[2] [1 [1 2 3] @] test.
\end{code}

Deep Index

\begin{code}
[[1 [9 10 11]]] [[[0 [2 [0 1 2]]]] [1 2 [9 10 11] 4] @] test.
[1] [[0] [1 2 3 4 [5 6 7]] @] test.
[[1 2]] [[[0 1]] [1 2 3 4 [5 6 7]] @] test.
[[1 [5 6 7]]] [[[0 4]] [1 2 3 4 [5 6 7]] @] test.
[[1 5]] [[[0 [4 0]]] [1 2 3 4 [5 6 7]] @] test.
[[1 [5 7]]] [[[0 [4 [0 2]]]] [1 2 3 4 [5 6 7]] @] test.
\end{code}

Eliding indexes to get matrix slices

\begin{code}
[[ 4 400 4000 ] ] [
  [[] 3]
  [ [1 2 3 4]
    [100 200 300 400]
    [1000 2000 3000 4000]
  ] @
] test.
\end{code}

Handling of circular lists

\begin{code}
[ "[ 1 (circular) 3 ]" ] [ [1 2 3] dup. 1  abc-abca ! to-string ] test.
\end{code}

Testing prototype object lookup

\begin{code}
[ 5 ] [ object;copy 5 foo add-slot foo lookup .] test.
[ 5 ] [ 
        object;copy 5  foo add-slot 
        object;copy 10 bar add-slot
                    12 foo add-slot 
        parent* add-slot
        foo lookup .
      ] test.
[ 10 ] [ 
        object;copy 5  foo add-slot 
        object;copy 10 bar add-slot
                    12 foo add-slot 
        parent* add-slot
        bar lookup .
      ] test.
[ 12 ] [ 
        object;copy 5  baz add-slot 
        object;copy 10 bar add-slot
                    12 foo add-slot 
        parent* add-slot
        foo lookup .
      ] test.
[ "foo!" ] [ 
        object;copy 
          [] [ frame self lookup . message lookup . ] foo add-method 
        object;copy "foo!" message add-slot 
        swap;. parent* add-slot
        message lookup .
      ] test.
[ "foo!" ] [ 
        object;copy 
          [] [ frame self lookup . message lookup . ] foo add-method 
        object;copy "foo!" message add-slot 
        swap;. parent* add-slot
        foo lookup .
      ] test.
[ "foo!" ] [ 
        object;copy 
          [] [ frame message lookup . ] foo add-method 
        object;copy "foo!" message add-slot 
        swap;. parent* add-slot
        foo lookup .
      ] test.
\end{code}

Testing calling methods with args
\begin{code}
[ "xabcd" "xdefg" ] [
  object copy [ "x" frame a lookup ., ] code add-slot
  [ a ] args add-slot
  object a add-slot
  object copy
  swap.
  [] swap. foo add-method
  "abcd" over.
  foo lookup.
  swap. "defg" swap.
  foo lookup.
] test.
\end{code}

Test that implicit calls propogate 'self' correcty.

\begin{code}
[ 1 1 1 1 ] [
object copy
[][ abar. ] afoo add-method
[][ self. ] abar add-method
object copy 
  [][self.] abaz add-method 
  [][afoo.] aboz add-method 
  parent* add-slot
dup. dup. abar;. = swap.
dup. dup. afoo;. = swap.
dup. dup. abaz;. = swap.
dup. aboz;. = swap.
] test.

"Test run completed\n" write
\end{code}
\end{document}