picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

io.l (4567B)

      1 # 10jul13abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 ### path ###
      5 (test 'task (cadr (in (path "@lib.l") (read))))
      6 (test (char "+") (char (path "+@")))
      7 
      8 
      9 ### read ###
     10 (test (1 2 3) (~(1 2) 3))
     11 (test (1 3) (~(1 . 2) 3))
     12 (test (1 2 3 4) (1 ~(2 3) 4))
     13 (test (1 2 4) (1 ~(2 . 3) 4))
     14 (test (1 2 3) [1 2 3])
     15 (test (1 2 3) (1 2 3]
     16 (test (1 2 3) (1 2 3)]
     17 (test (1 (2 3)) (1 (2 3]
     18 (test (quote 1 (2 (3))) '(1 (2 (3]
     19 (test (quote 1 (2 (3))) '[1 (2 (3])
     20 (test (1 abc (d e f))
     21    (pipe (prinl "(1 abc (d e f))")
     22       (read) ) )
     23 (test '(abc "=" def_ghi "(" ("x" "y" "z") "+" "-" 123 ")")
     24    (pipe (prinl "abc = def_ghi(\"xyz\"+-123) # Comment")
     25       (make
     26          (while (read "_" "#")
     27             (link @) ) ) ) )
     28 
     29 
     30 ### wait ###
     31 (let (*Run NIL  *Cnt 0)
     32    (test (1 2 3 4 5 6 7)
     33       (make
     34          (task -10 0  (link (inc '*Cnt)))
     35          (wait NIL (>= *Cnt 7)) ) ) )
     36 
     37 
     38 ### peek char ###
     39 (pipe (prin "ab")
     40    (test "a" (peek))
     41    (test "a" (char))
     42    (test "b" (peek))
     43    (test "b" (char))
     44    (test NIL (peek))
     45    (test NIL (char)) )
     46 (test "A" (char 65))
     47 (test 65 (char "A"))
     48 
     49 
     50 ### skip ###
     51 (test "a"
     52    (pipe (prinl "# Comment^Ja")
     53       (skip "#") ) )
     54 (test "#"
     55    (pipe (prinl "# Comment^Ja")
     56       (skip) ) )
     57 
     58 
     59 ### eof ###
     60 (test T (pipe NIL (eof)))
     61 (test NIL (pipe (prin "a") (eof)))
     62 (test T (pipe (prin "a") (eof T) (eof)))
     63 
     64 
     65 ### from till ###
     66 (test "cd"
     67    (pipe (prin "ab.cd:ef")
     68       (from ".")
     69       (till ":" T) ) )
     70 
     71 
     72 ### line ###
     73 (test '("a" "b" "c")
     74    (pipe (prin "abc^J") (line)) )
     75 (test "abc"
     76    (pipe (prin "abc") (line T)) )
     77 (test '("abc" "def")
     78    (pipe (prin "abc^Jdef")
     79       (list (line T) (line T)) ) )
     80 (test '("abc" "def")
     81    (pipe (prin "abc^Mdef")
     82       (list (line T) (line T)) ) )
     83 (test '("abc" "def")
     84    (pipe (prin "abc^M^Jdef")
     85       (list (line T) (line T)) ) )
     86 (test '("a" "bc" "def")
     87    (pipe (prin "abcdef")
     88       (line T 1 2 3) ) )
     89 
     90 
     91 ### lines ###
     92 (out (tmp "lines")
     93    (do 3 (prinl "abc")) )
     94 
     95 (test 3 (lines (tmp "lines")))
     96 
     97 
     98 ### any ###
     99 (test '(a b c d) (any "(a b # Comment^Jc d)"))
    100 (test "A String" (any "\"A String\""))
    101 
    102 
    103 ### sym ###
    104 (test "(abc \"Hello\" 123)"
    105    (sym '(abc "Hello" 123)) )
    106 
    107 
    108 ### str ###
    109 (test '(a (1 2) b)
    110    (str "a (1 2) b") )
    111 (test '(a (1 2))
    112    (str "a (1 2) # b") )
    113 (test "a \"Hello\" DEF"
    114    (str '(a "Hello" DEF)) )
    115 
    116 
    117 ### load ###
    118 (test 6 (load "-* 1 2 3"))
    119 
    120 
    121 ### in out err ###
    122 (out (tmp "file")
    123    (println 123)
    124    (println 'abc)
    125    (println '(d e f)) )
    126 (in (tmp "file")
    127    (test 123 (read))
    128    (in (tmp "file")
    129       (test 123 (read))
    130       (test 'abc (in -1 (read))) )
    131    (test '(d e f) (read)) )
    132 
    133 (let Err (tmp "err")
    134    (test 1 (err Err (msg 1)))
    135    (test 2 (err (pack "+" Err) (msg 2)))
    136    (test "1^J2^J" (in Err (till NIL T))) )
    137 
    138 
    139 ### pipe ###
    140 (test 123 (pipe (println 123) (read)))
    141 
    142 
    143 ### open close ###
    144 (let F (open (tmp "file"))
    145    (test 123 (in F (read)))
    146    (test 'abc (in F (read)))
    147    (test '(d e f) (in F (read)))
    148    (test F (close F)) )
    149 
    150 
    151 ### echo ###
    152 (out (tmp "echo")
    153    (in (tmp "file")
    154       (echo) ) )
    155 (in (tmp "echo")
    156    (test 123 (read))
    157    (test 'abc (read))
    158    (test '(d e f) (read)) )
    159 (let F (tmp "file")
    160    (test "12"
    161       (pipe (in F (echo 2))
    162          (line T) ) )
    163    (test "23"
    164       (pipe (in F (echo 1 2))
    165          (line T) ) ) )
    166 
    167 
    168 ### prin prinl space print printsp println ###
    169 (out (tmp "prin")
    170    (prin 1)
    171    (prinl 2)
    172    (space)
    173    (print 3)
    174    (printsp 4)
    175    (println 5) )
    176 (test (12 "^J" " " 34 5)
    177    (in (tmp "prin")
    178       (list (read) (char) (char) (read) (read)) ) )
    179 
    180 
    181 ### flush rewind ###
    182 (out (tmp "prin")
    183    (prinl "abc")
    184    (flush)
    185    (test "abc" (in (tmp "prin") (line T)))
    186    (rewind) )
    187 (out (tmp "prin") (prinl "def"))
    188 (test "def" (in (tmp "prin") (line T)))
    189 
    190 
    191 ### ext rd pr ###
    192 (let L (list (id 1 2) (cons (id 3 9) 'a) (cons (id 2 7) 'b))
    193    (let L5 (list (id 6 2) (cons (id 8 9) 'a) (cons (id 7 7) 'b))
    194       (out (tmp "ext")
    195          (ext 5 (pr L5)) )
    196       (test L
    197          (in (tmp "ext") (rd)) )
    198       (test L5
    199          (in (tmp "ext") (ext 5 (rd))) ) ) )
    200 
    201 (pipe
    202    (for N 4096
    203       (pr N) )
    204    (for N 4096
    205       (test N (rd)) ) )
    206 (pipe
    207    (for C 4096
    208       (pr (char C)) )
    209    (for C 4096
    210       (test C (char (rd))) ) )
    211 (pipe
    212    (pr (7 "abc" (1 2 3) 'a))
    213    (test (7 "abc" (1 2 3) 'a) (rd)) )
    214 (test "def"
    215    (out (tmp "pr")
    216       (pr 'abc "EOF" 123 "def") ) )
    217 (test '(abc "EOF" 123 "def")
    218    (in (tmp "pr")
    219       (make
    220          (use X
    221             (until (== "EOF" (setq X (rd "EOF")))
    222                (link X) ) ) ) ) )
    223 
    224 
    225 ### wr ###
    226 (test 3
    227    (out (tmp "wr")
    228       (wr 1 2 3) ) )
    229 (test (hex "010203")
    230    (in (tmp "wr")
    231       (rd 3) ) )
    232 
    233 # vi:et:ts=3:sw=3