picolisp

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

misc.l (4486B)

      1 # 04nov12abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 ### locale ###
      5 (locale "DE" "de")
      6 (test "Ja" (val ,"Yes"))
      7 (locale)
      8 
      9 
     10 ### ** ###
     11 (test 32768 (** 2 15))
     12 
     13 
     14 ### accu ###
     15 (off Sum)
     16 
     17 (test '(a . 1) (accu 'Sum 'a 1))
     18 (test 6 (accu 'Sum 'a 5))
     19 (test (22 . 100) (accu 'Sum 22 100))
     20 (test '((22 . 100) (a . 6)) Sum)
     21 
     22 (test '((b . 2) (a . 3))
     23    (let L NIL (accu 'L 'a 2) (accu 'L 'b 2) (accu 'L 'a 1) L) )
     24 
     25 
     26 ### align ###
     27 (test "   a" (align 4 'a))
     28 (test "   a" (align 4 "a"))
     29 (test "12  " (align -4 12))
     30 (test "   a  12   b" (align (4 4 4) "a" 12 "b"))
     31 
     32 
     33 ### center ###
     34 (test " 12" (center 4 12))
     35 (test " a" (center 4 "a"))
     36 (test "   a" (center 7 'a))
     37 (test " a  b  c" (center (3 3 3) "a" "b" "c"))
     38 
     39 
     40 ### wrap ###
     41 (test "The quick brown fox^Jjumps over the lazy^Jdog"
     42    (wrap 20 (chop "The quick brown fox jumps over the lazy dog")) )
     43 (test "The^Jquick^Jbrown^Jfox^Jjumps^Jover the^Jlazy dog"
     44    (wrap 8 (chop "The quick brown fox jumps over the lazy dog")) )
     45 
     46 
     47 ### pad ###
     48 (test "00001" (pad 5 1))
     49 (test "123456789" (pad 5 123456789))
     50 
     51 
     52 ### bin ###
     53 (test "1001001" (bin (+ 64 8 1)))
     54 (test (+ 64 8 1) (bin "1001001"))
     55 (test "-110110" (bin -54))
     56 (test -54 (bin "-110110"))
     57 
     58 
     59 ### oct ###
     60 (test "111" (oct (+ 64 8 1)))
     61 (test (+ 64 8 1) (oct "111"))
     62 (test "-66" (oct -54))
     63 (test -54 (oct "-66"))
     64 
     65 
     66 ### hex ###
     67 (test "111" (hex (+ 256 16 1)))
     68 (test (+ 256 16 1) (hex "111"))
     69 (test "-FFFF" (hex -65535))
     70 
     71 
     72 ### money ###
     73 (test "1,234,567.89" (money 123456789))
     74 (test "1,234,567.89 EUR" (money 123456789 "EUR"))
     75 
     76 (locale "DE" "de")
     77 (test "1.234.567,89 EUR" (money 123456789 "EUR"))
     78 (locale)
     79 
     80 
     81 ### round ###
     82 (scl 4)
     83 (test "12.35" (round 123456 2))
     84 (test "12.3456" (round 123456 6))
     85 (test "12.346" (round 123456))
     86 
     87 
     88 ### balance ###
     89 (test (5 (2 (1) 3 NIL 4) 7 (6) 8 NIL 9)
     90    (let I NIL (balance 'I (sort (1 4 2 5 3 6 7 9 8))) I) )
     91 
     92 
     93 ### *Allow allowed allow ###
     94 (allowed ("app/")
     95    "start" "stop" "lib.css" "psh" )
     96 (allow "myFoo")
     97 (allow "myDir/" T)
     98 
     99 (test '(("psh" ("lib.css" NIL "myFoo") "start" NIL "stop") "app/" "myDir/")
    100    *Allow )
    101 
    102 (test '("lib.css" "myFoo" "psh" "start" "stop")
    103    (idx *Allow) )
    104 
    105 (test '("app/" "myDir/")
    106    (cdr *Allow) )
    107 
    108 
    109 ### telStr ###
    110 (test "+49 1234 5678-0" (telStr "49 1234 5678-0"))
    111 
    112 (locale "DE" "de")
    113 (test "01234 5678-0" (telStr "49 1234 5678-0"))
    114 (locale)
    115 
    116 
    117 ### expTel ###
    118 (test "49 1234 5678-0" (expTel "+49 1234 5678-0"))
    119 (test "49 1234 5678-0" (expTel "0049 1234 5678-0"))
    120 (test NIL (expTel "01234 5678-0"))
    121 
    122 (locale "DE" "de")
    123 (test "49 1234 5678-0" (expTel "01234 5678-0"))
    124 (locale)
    125 
    126 
    127 ### dat$ ###
    128 (test "20070601" (dat$ (date 2007 6 1)))
    129 (test "2007-06-01" (dat$ (date 2007 6 1) "-"))
    130 
    131 
    132 ### $dat ###
    133 (test 733134 ($dat "20070601"))
    134 (test 733134 ($dat "2007-06-01" "-"))
    135 
    136 
    137 ### datSym ###
    138 (test "01jun07" (datSym (date 2007 6 1)))
    139 
    140 
    141 ### datStr ###
    142 (test "2007-06-01" (datStr (date 2007 6 1)))
    143 
    144 (locale "DE" "de")
    145 (test "01.06.2007" (datStr (date 2007 6 1)))
    146 (test "01.06.07" (datStr (date 2007 6 1) T))
    147 (locale)
    148 
    149 
    150 ### strDat ###
    151 (test 733134 (strDat "2007-06-01"))
    152 (test NIL (strDat "01.06.2007"))
    153 
    154 (locale "DE" "de")
    155 (test 733134 (strDat "01.06.2007"))
    156 (test 733134 (strDat "1.6.2007"))
    157 (locale)
    158 
    159 
    160 ### expDat ###
    161 (test 733133 (date 2007 5 31))
    162 (test 733133 (expDat "31057"))
    163 (test 733133 (expDat "310507"))
    164 (test 733133 (expDat "2007-05-31"))
    165 (test 733133 (expDat "7-5-31"))
    166 
    167 (locale "DE" "de")
    168 (test 733133 (expDat "31.5.7"))
    169 (locale)
    170 
    171 
    172 ### day ###
    173 (test "Friday" (day (date 2007 6 1)))
    174 
    175 (locale "DE" "de")
    176 (test "Freitag" (day (date 2007 6 1)))
    177 (test "Fr"
    178    (day (date 2007 6 1) '("Mo" "Tu" "We" "Th" "Fr" "Sa" "Su")) )
    179 (locale)
    180 
    181 
    182 ### week ###
    183 (test 22 (week (date 2007 6 1)))
    184 
    185 
    186 ### ultimo ###
    187 (test (2007 1 31) (date (ultimo 2007 1)))
    188 (test (2007 2 28) (date (ultimo 2007 2)))
    189 (test (2004 2 29) (date (ultimo 2004 2)))
    190 (test (2000 2 29) (date (ultimo 2000 2)))
    191 (test (1900 2 28) (date (ultimo 1900 2)))
    192 
    193 
    194 ### tim$ ###
    195 (test "10:57" (tim$ (time 10 57 56)))
    196 (test "10:57:56" (tim$ (time 10 57 56) T))
    197 
    198 
    199 ### $tim ###
    200 (test (10 57 56) (time ($tim "10:57:56")))
    201 (test (10 57 0) (time ($tim "10:57")))
    202 (test (10 0 0) (time ($tim "10")))
    203 
    204 
    205 ### stamp ###
    206 (test "2007-06-01 10:57:56"
    207    (stamp (date 2007 6 1) (time 10 57 56)) )
    208 
    209 
    210 ### chdir ###
    211 (let P (pwd)
    212    (chdir "/"
    213       (test "/" (pwd)) )
    214    (test P *PWD) )
    215 
    216 
    217 ### dirname basename ###
    218 (test "a/b/c/" (dirname "a/b/c/d"))
    219 (test "d" (basename "a/b/c/d"))
    220 
    221 
    222 ### fmt64 ###
    223 (test "9" (fmt64 9))
    224 (test ":" (fmt64 10))
    225 (test ";" (fmt64 11))
    226 (test "A" (fmt64 12))
    227 (test 4096 (fmt64 "100"))
    228 
    229 
    230 # vi:et:ts=3:sw=3