main.l (3750B)
1 # 06may13abu 2 # (c) Software Lab. Alexander Burger 3 4 ### Evaluation ### 5 (test 2 6 (when 1 7 ('((N) N) (and 2)) 8 @ ) ) 9 10 ### alarm ### 11 (let N 6 12 (alarm 1 (inc 'N)) 13 (test 6 N) 14 (wait 2000) 15 (test 7 N) 16 (alarm 0) ) 17 18 19 ### sigio ### 20 (unless (member *OS '("SunOS" "OpenBSD")) 21 (sigio (setq "SigSock" (port T 0 "SigPort")) 22 (setq "SigVal" (udp "SigSock")) ) 23 (udp "localhost" "SigPort" '(a b c)) 24 (wait 200) 25 (test '(a b c) "SigVal") 26 (close "SigSock") ) 27 28 29 ### protect ### 30 (test NIL (pipe (prog (kill *Pid) (pr 7)) (rd))) 31 (test 7 (pipe (protect (kill *Pid) (pr 7)) (rd))) 32 33 34 ### quit ### 35 (test "Quit" (catch '("Quit") (quit "Quit"))) 36 37 38 ### adr ### 39 (let (X (box 7) L (123)) 40 (test 7 (val (adr (adr X)))) 41 (test 123 (car (adr (adr L)))) ) 42 43 ### env ### 44 (test NIL (env)) 45 (test '((A . 1) (B . 2)) 46 (let (A 1 B 2) 47 (env) ) ) 48 (test '((B . 2) (A . 1)) 49 (let (A 1 B 2) 50 (env '(A B)) ) ) 51 (test '((Y . 8) (C . 3) (B . 2) (A . 1) (X . 7)) 52 (let (A 1 B 2) 53 (env 'X 7 '(A B (C . 3)) 'Y 8) ) ) 54 55 56 ### trail ### 57 (when trail 58 (let 59 (F '((A B) (G (inc A) (dec B))) 60 G '((X Y) (trail T)) ) 61 (test '(@X (F 3 4) A 3 B 4 (G (inc A) (dec B)) X 4 Y 3) 62 (F 3 4) ) ) ) 63 64 ### up ### 65 (test 1 66 (let N 1 67 ((quote (N) (up N)) 2) ) ) 68 (test 7 69 (let N 1 70 ((quote (N) (up N 7)) 2) 71 N ) ) 72 73 74 ### sys ### 75 (test "PicoLisp" (sys "TEST" "PicoLisp")) 76 (test "PicoLisp" (sys "TEST")) 77 78 79 ### args next arg rest #### 80 (test '(T 1 1 3 (2 3 4)) 81 (let foo '(@ (list (args) (next) (arg) (arg 2) (rest))) 82 (foo 1 2 3 4) ) ) 83 84 (test (7 7 NIL NIL) 85 ((quote @ (list (next) (arg) (next) (arg))) 7) ) 86 87 88 ### usec ### 89 (let U (usec) 90 (wait 400) 91 (test 4 (*/ (- (usec) U) 100000)) ) 92 93 94 ### pwd ### 95 (test *PWD (pwd)) 96 97 98 ### cd ### 99 (chdir "/" 100 (test "/" (pwd)) ) 101 102 103 ### info ### 104 (test '(T . @) (info "@test")) 105 (test (5 . @) 106 (out (tmp "info") (prinl "info")) 107 (info (tmp "info")) ) 108 109 110 ### file ### 111 (test (cons (tmp) "file" 1) 112 (out (tmp "file") (println '(file))) 113 (load (tmp "file")) ) 114 115 116 ### dir ### 117 (call 'mkdir "-p" (tmp "dir")) 118 (out (tmp "dir/.abc")) 119 (out (tmp "dir/a")) 120 (out (tmp "dir/b")) 121 (out (tmp "dir/c")) 122 123 (test '("a" "b" "c") (sort (dir (tmp "dir")))) 124 (test '("." ".." ".abc" "a" "b" "c") (sort (dir (tmp "dir") T))) 125 126 127 ### cmd ### 128 (cmd "test") 129 (test "test" (cmd)) 130 131 132 ### argv ### 133 (test '("abc" "123") 134 (pipe 135 (call *CMD "-prog (println (argv)) (bye)" "abc" 123) 136 (read) ) ) 137 (test '("abc" "123") 138 (pipe 139 (call *CMD "-prog (argv A B) (println (list A B)) (bye)" "abc" 123) 140 (read) ) ) 141 142 143 ### opt ### 144 (test '("abc" "123") 145 (pipe 146 (call *CMD "-prog (println (list (opt) (opt))) (bye)" "abc" 123) 147 (read) ) ) 148 (test "abc" 149 (pipe 150 (call *CMD "-de f () (println (opt))" "-f" "abc" "-bye") 151 (read) ) ) 152 153 154 ### date time ### 155 (use (Dat1 Tim1 Dat2 Tim2 D1 T1 D2 T2) 156 (until 157 (= 158 (setq Dat1 (date) Tim1 (time T)) 159 (prog 160 (setq 161 Dat2 (date T) 162 Tim2 (time T) 163 D1 (in '(date "+%Y %m %d") (list (read) (read) (read))) 164 T1 (in '(date "+%H %M %S") (list (read) (read) (read))) 165 D2 (in '(date "-u" "+%Y %m %d") (list (read) (read) (read))) 166 T2 (in '(date "-u" "+%H %M %S") (list (read) (read) (read))) ) 167 (time) ) ) ) 168 (test Tim1 (time T1)) 169 (test Tim1 (apply time T1)) 170 (test Tim2 (time T2)) 171 (test Dat1 (date D1)) 172 (test Dat1 (apply date D1)) 173 (test Dat2 (date D2)) ) 174 175 (test (2000 7 15) (date 730622)) 176 (test 730622 (date 2000 7 15)) 177 (test 730622 (date (2000 7 15))) 178 (test NIL (date NIL)) 179 180 (test (11 17 23) (time 40643)) 181 (test 40643 (time 11 17 23)) 182 (test 40643 (time (11 17 23))) 183 (test NIL (time NIL)) 184 185 # vi:et:ts=3:sw=3