home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / icon / dos / src / tests / recent.icn < prev    next >
Text File  |  1992-02-09  |  7KB  |  264 lines
  1. procedure main ()
  2.    sf([])
  3.  
  4.    write(args(main))
  5.    write(args(write))
  6.  
  7. # show results of bitwise operations on various operand combinations
  8.  
  9.    every i := 1 | '2' | "3" do {
  10.       write (
  11.        "    i        j       ~j      i & j    i | j    i ^ j   i << j   i >> j")
  12.       every j := 0 | 1 | 2 | 3 | 4 | 100 do {
  13.          write(right(i,8), right(j,9))
  14.          word (i)
  15.          word (j)
  16.          word (icom (j))
  17.          word (iand (i, j))
  18.          word (ior (i, j))
  19.          word (ixor (i, j))
  20.          word (ishift (i, j))
  21.          word (ishift (i, -j))
  22.          write ()
  23.          }
  24.       }
  25.  
  26. # test remove() and rename(), and print errors in case of malfunction
  27.  
  28.    name1 := "temp1"
  29.    name2 := "temp2"
  30.    data := "Here's the data"
  31.  
  32.    every remove (name1 | name2)        # just in case
  33.    open (name1) & stop ("can't remove ", name1, " to initialize test")
  34.    open (name2) & stop ("can't remove ", name2, " to initialize test")
  35.    remove (name1) & stop ("successfully removed nonexistent file")
  36.    rename (name1, name2) & stop ("successfully renamed nonexistent file")
  37.  
  38.    f := open (name1, "w") | stop ("can't open ",name1," for write")
  39.    write (f, data)
  40.    close (f)
  41.  
  42.    f := open (name1) | stop ("can't open ",name1," after write")
  43.    s := read (f) | ""
  44.    close(f)
  45.    s == data | stop ("data lost after write")
  46.  
  47.    rename (name1, name2) | stop ("can't rename(",name1,",",name2,")")
  48.    f := open (name2) | stop ("can't open ",name2," after rename")
  49.    s := read (f) | ""
  50.    close(f)
  51.    s == data | stop ("data lost after rename")
  52.  
  53.    remove (name1) & stop ("remove succeeded on file already renamed")
  54.    remove (name2) | stop ("can't remove renamed file")
  55.    open (name1) & stop (name1, " still around at end of test")
  56.    open (name2) & stop (name2, " still around at end of test")
  57.  
  58. #  test seek() and where()
  59.  
  60.    f := open("concord.dat")
  61.    write(image(seek(f,11)))
  62.    write(where(f))
  63.    write(image(reads(f,10)))
  64.    write(where(f))
  65.    write(where(f))
  66.    seek(f,-2)
  67.    write(where(f))
  68.    write(image(reads(f,1)))
  69.    write(where(f))
  70.  
  71. # test ord() and char(), and print messages if wrong results
  72.  
  73.    s := string (&cset)
  74.    every i := 0 to 255 do {
  75.       c := char (i)
  76.       n := ord (c)
  77.       if n ~= i | c ~== s[i+1] then
  78.      write ("oops -- ord/char failure at ",i)
  79.    }
  80.    if char("47") ~== char(47) then
  81.       write ("oops -- type conversion failed in char()")
  82.    if ord(9) ~= ord("9") then
  83.       write ("oops -- type conversion failed in ord()")
  84.  
  85.    every ferr (char, -65536 | -337 | -1 | 256 | 4713 | 65536 | 123456, 205)
  86.    every ferr (char, "abc" | &lcase | &errout | [], 101)
  87.    every ferr (ord, "" | "ab" | "antidisestablishmentarianism" | 47, 205)
  88.    every ferr (ord, &output | table(), 103)
  89.  
  90. #  test getenv()
  91.  
  92.    write(getenv("HOME") | write("getenv failed"))
  93.    write(getenv("foo") | write("getenv failed"))
  94.  
  95. #  test sorting
  96.  
  97.    a := list(1)        # different sizes to make identification easy
  98.    b := list(2)
  99.    c := list(3)
  100.    d := list(4)
  101.    e := &lcase ++ &ucase
  102.    f := &lcase ++ &ucase
  103.    g := '123456789'
  104.    h := &digits
  105.    A := sort([h,g,a,c,b,d,f,e,&lcase,[],&cset,&ascii])
  106.    every write(image(!A))
  107.  
  108. # test varargs
  109.  
  110.    write("p(1):")
  111.    p(1)
  112.    write("p(1, 2):")
  113.    p(1, 2)
  114.    write("p(1, 2, 3):")
  115.    p(1, 2, 3)
  116.    write("p(1, 2, 3, 4, 5):")
  117.    p(1, 2, 3, 4, 5)
  118.    write("q(1, 2):")
  119.    q(1, 2)
  120.  
  121. # test Version 7 table features
  122.  
  123.    write("t := table(\"default\") --> ", image(t := table("default")) |
  124.       "failure")
  125.    show(t)
  126.    write("insert(t, 3, 4) --> ", image(insert(t, 3, 4)) | "failure")
  127.    write("insert(t, \"xyz\", \"abc\") --> ", image(insert(t, "xyz", "abc")) |
  128.       "failure")
  129.    write("insert(t, &digits) --> ", image(insert(t, &digits)) | "failure")
  130.    show(t)
  131.    write("t[\"xyz\"] := \"new value\" --> ", image(t["xyz"] := "new value") |
  132.       "failure")
  133.    show(t)
  134.    write("insert(t, \"xyz\", \"def\") --> ", image(insert(t, "xyz", "def")) |
  135.       "failure")
  136.    show(t)
  137.    write("delete(t, \"xyz\") -- > ", image(delete(t, "xyz")) | "failure")
  138.    show(t)
  139.    write("delete(t, \"xyz\") -- > ", image(delete(t, "xyz")) | "failure")
  140.    show(t)
  141.  
  142. #  test run-time error mechanism
  143.  
  144. end
  145.  
  146. # write word in hexadecimal
  147. procedure word (v)
  148.    xd (v, 8)
  149.    writes (" ")
  150.    return
  151.    end
  152.  
  153. # write n low-order hex digits of v
  154. procedure xd (v, n)
  155.    xd (ishift (v, -4), 0 < n - 1)
  156.    writes ("0123456789ABCDEF" [1 + iand (v, 16r0F)])
  157.    return
  158.    end
  159. # ferr(func,val,err) -- call func(val) and verify that error "err" is produced
  160.  
  161. procedure ferr (func, val, err)
  162.    write(msg := "oops -- " || image(func) || "(" || image (val) || ") ")
  163.    return
  164. end
  165.  
  166. procedure p(a, b, c[])
  167.    write("   image(a):", image(a))
  168.    write("   image(b):", image(b))
  169.    write("   image(c):", image(c))
  170.    write("   every write(\"\\t\", !c):")
  171.    every write("\t", !c)
  172. end
  173.  
  174. procedure q(a[])
  175.    write("   every write(\"\\t\", !a):")
  176.    every write("\t", !a)
  177. end
  178. procedure show(t)
  179.    local x
  180.  
  181.    write("   *t --> ", *t)
  182.    write("   t[\"xyz\"] --> ", image(t["xyz"]) | "failure")
  183.    write("   member(t, \"xyz\") --> ", image(member(t, "xyz")) | "failure")
  184.    x := sort(t, 3)
  185.    write("   contents of t:")
  186.    while writes("\t", image(get(x)), " : ")
  187.       do write(image(get(x)))
  188.    write("")
  189. end
  190.  
  191. #  test the new sortf(x,n) function
  192.  
  193. global data
  194. record r1(a)
  195. record r3(a,b,c)
  196.  
  197. procedure sf (args)
  198.     local n, z
  199.  
  200.     z := []
  201.     every put (z, 1 to 100)
  202.     data := [
  203.        r3(3,1,4),
  204.        [1,5,9],
  205.        r3(2,6,5),
  206.        r3(3,5),
  207.        r1(2),
  208.        3,
  209.        r1(4),
  210.        r1(8),
  211.        [5,&null,5],
  212.        [4,4,4,4],
  213.        [3,3,3],
  214.        [&null,25],
  215.        4,
  216.        [2,2],
  217.        [1],
  218.        [&null,&null],
  219.        [],
  220.        r3(7,8,9),
  221.        z]
  222.     dump ("sort(L)", sort (data))
  223.  
  224.     if *args = 0 then
  225.     every test (&null | 1 | "2" | '3' | 4 | 17 | -4 | -3 | "-2" | -1)
  226.     else
  227.     every test (!args)
  228.     end
  229.  
  230. procedure test (n)
  231.     local r1, r2
  232.     write ()
  233.     write ("-------------------- testing n = ", \n | "&null")
  234.     r1 := sortf (data, n)
  235.     r2 := sortf (set(data), n)
  236.     dump ("sortf(L,n)", r1)
  237.     if same (r1, r2) then
  238.     write ("\nsortf(S,n) [same]")
  239.     else
  240.     dump ("sortf(S,n) [********** OOPS -- results differ: **********]", r2)
  241.     end
  242.  
  243. procedure dump (s, l)
  244.     local e
  245.     write ()
  246.     write (s, ":")
  247.     every e := !l do {
  248.        writes ("  ", left(type(e), 8))
  249.        if (type(e) == ("r1" | "r3" | "list")) then
  250.       every writes (" ", image(e[(1 to 5) | (95 to 100)]) | "\n")
  251.        else
  252.       write (" ", image(e))
  253.        }
  254.     return
  255.     end
  256.  
  257. procedure same (a, b)
  258.     local i
  259.     if *a ~= *b then fail
  260.     every i := 1 to *a do
  261.     if a[i] ~=== b[i] then fail
  262.     return
  263.     end
  264.