path: root/tests/general/recent.icn

procedure main ()
   sf([])

   write(args(main))
   write(args(write))

# show results of bitwise operations on various operand combinations

   every i := 1 | '2' | "3" do {
      write (
       "    i        j       ~j      i & j    i | j    i ^ j   i << j   i >> j")
      every j := 0 | 1 | 2 | 3 | 4 | 100 do {
         write(right(i,8), right(j,9))
         word (i)
         word (j)
         word (icom (j))
         word (iand (i, j))
         word (ior (i, j))
         word (ixor (i, j))
         word (ishift (i, j))
         word (ishift (i, -j))
         write ()
         }
      }

# test remove() and rename(), and print errors in case of malfunction

   name1 := "temp1"
   name2 := "temp2"
   data := "Here's the data"

   every remove (name1 | name2)		# just in case
   open (name1) & stop ("can't remove ", name1, " to initialize test")
   open (name2) & stop ("can't remove ", name2, " to initialize test")
   remove (name1) & stop ("successfully removed nonexistent file")
   rename (name1, name2) & stop ("successfully renamed nonexistent file")

   f := open (name1, "w") | stop ("can't open ",name1," for write")
   write (f, data)
   close (f)

   f := open (name1) | stop ("can't open ",name1," after write")
   s := read (f) | ""
   close(f)
   s == data | stop ("data lost after write")

   rename (name1, name2) | stop ("can't rename(",name1,",",name2,")")
   f := open (name2) | stop ("can't open ",name2," after rename")
   s := read (f) | ""
   close(f)
   s == data | stop ("data lost after rename")

   remove (name1) & stop ("remove succeeded on file already renamed")
   remove (name2) | stop ("can't remove renamed file")
   open (name1) & stop (name1, " still around at end of test")
   open (name2) & stop (name2, " still around at end of test")

#  test seek() and where()

   f := open("concord.dat")
   write(image(seek(f,11)))
   write(where(f))
   write(image(reads(f,10)))
   write(where(f))
   write(where(f))
   seek(f,-2)
   write(where(f))
   write(image(reads(f,1)))
   write(where(f))
   close(f)

# test ord() and char(), and print messages if wrong results

   s := string (&cset)
   every i := 0 to 255 do {
      c := char (i)
      n := ord (c)
      if n ~= i | c ~== s[i+1] then
	 write ("oops -- ord/char failure at ",i)
   }
   if char("47") ~== char(47) then
      write ("oops -- type conversion failed in char()")
   if ord(9) ~= ord("9") then
      write ("oops -- type conversion failed in ord()")

   every ferr (char, -65536 | -337 | -1 | 256 | 4713 | 65536 | 123456, 205)
   every ferr (char, "abc" | &lcase | &errout | [], 101)
   every ferr (ord, "" | "ab" | "antidisestablishmentarianism" | 47, 205)
   every ferr (ord, &output | table(), 103)

#  test getenv()

   write("getenv $HOME ", if getenv("HOME") then "succeeded" else "failed")
   write("getenv $FOOBAR ", if getenv("FOOBAR") then "succeeded" else "failed")

#  test open(directory)

   f := open(".") | stop("can't open `.'")
   fset := set()
   # try three kinds of reading in rotation
   while insert(fset, read(f)) do {
      insert(fset, !f)			# note just one per loop pass
      insert(fset, reads(f, 25))	# assumes no name longer than 25
      }
   every s := ![".", "..", "Makefile", "recent.icn", "recogn.dat", "nope"] do
      if member(fset, s) then
         write("found file: ", s)

#  test sorting

   a := list(1)		# different sizes to make identification easy
   b := list(2)
   c := list(3)
   d := list(4)
   e := &lcase ++ &ucase
   f := &lcase ++ &ucase
   g := '123456789'
   h := &digits
   A := sort([h,g,a,c,b,d,f,e,&lcase,[],&cset,&ascii])
   every write(image(!A))

# test varargs

   write("p(1):")
   p(1)
   write("p(1, 2):")
   p(1, 2)
   write("p(1, 2, 3):")
   p(1, 2, 3)
   write("p(1, 2, 3, 4, 5):")
   p(1, 2, 3, 4, 5)
   write("q(1, 2):")
   q(1, 2)

# test Version 7 table features

   write("t := table(\"default\") --> ", image(t := table("default")) |
      "failure")
   show(t)
   write("insert(t, 3, 4) --> ", image(insert(t, 3, 4)) | "failure")
   write("insert(t, \"xyz\", \"abc\") --> ", image(insert(t, "xyz", "abc")) |
      "failure")
   write("insert(t, &digits) --> ", image(insert(t, &digits)) | "failure")
   show(t)
   write("t[\"xyz\"] := \"new value\" --> ", image(t["xyz"] := "new value") |
      "failure")
   show(t)
   write("insert(t, \"xyz\", \"def\") --> ", image(insert(t, "xyz", "def")) |
      "failure")
   show(t)
   write("delete(t, \"xyz\") -- > ", image(delete(t, "xyz")) | "failure")
   show(t)
   write("delete(t, \"xyz\") -- > ", image(delete(t, "xyz")) | "failure")
   show(t)

#  test multiple subscripts
   
   write("t := table(\"default\") --> ", image(t := table("default")) |
      "failure")
   write("t[\"one\"] := 1 --> ", image(t["one"] := 1) | "failure")
   write("t[] --> ", image(t[]) | "failure")
   write("x := r1([t, [1, [2, 3]]]) --> ", image(x := r1([t, [1, [2, 3]]])) |
      "failure")
   write("x[1, 1, \"one\"] --> ", image(x[1, 1, "one"]) | "failure")
   write("x[1, 2, 2, 2] --> ", image(x[1, 2, 2, 2]) | "failure")
   write("x[1, 2] := [\"abcd\", \"defg\"] --> ",
      image(x[1, 2] := ["abcd", "defg"]) | "failure")
   write("x[1, 2, 2, 2] --> ", image(x[1, 2, 2, 2]) | "failure")

#  test run-time error mechanism

end

# write word in hexadecimal
procedure word (v)
   xd (v, 8)
   writes (" ")
   return
   end

# write n low-order hex digits of v
procedure xd (v, n)
   xd (ishift (v, -4), 0 < n - 1)
   writes ("0123456789ABCDEF" [1 + iand (v, 16r0F)])
   return
   end
# ferr(func,val,err) -- call func(val) and verify that error "err" is produced

procedure ferr (func, val, err)
   write(msg := "oops -- " || image(func) || "(" || image (val) || ") ")
   return
end

procedure p(a, b, c[])
   write("   image(a):", image(a))
   write("   image(b):", image(b))
   write("   image(c):", image(c))
   write("   every write(\"\\t\", !c):")
   every write("\t", !c)
end

procedure q(a[])
   write("   every write(\"\\t\", !a):")
   every write("\t", !a)
end
procedure show(t)
   local x

   write("   *t --> ", *t)
   write("   t[\"xyz\"] --> ", image(t["xyz"]) | "failure")
   write("   member(t, \"xyz\") --> ", image(member(t, "xyz")) | "failure")
   x := sort(t, 3)
   write("   contents of t:")
   while writes("\t", image(get(x)), " : ")
      do write(image(get(x)))
   write("")
end

#  test the new sortf(x,n) function

global data
record r1(a)
record r3(a,b,c)

procedure sf (args)
    local n, z

    z := []
    every put (z, 1 to 100)
    data := [
       r3(3,1,4),
       [1,5,9],
       r3(2,6,5),
       r3(3,5),
       r1(2),
       3,
       r1(4),
       r1(8),
       [5,&null,5],
       [4,4,4,4],
       [3,3,3],
       [&null,25],
       4,
       [2,2],
       [1],
       [&null,&null],
       [],
       r3(7,8,9),
       z]
    dump ("sort(L)", sort (data))

    if *args = 0 then
	every test (&null | 1 | "2" | '3' | 4 | 17 | -4 | -3 | "-2" | -1)
    else
	every test (!args)
    end

procedure test (n)
    local r1, r2
    write ()
    write ("-------------------- testing n = ", \n | "&null")
    r1 := sortf (data, n)
    r2 := sortf (set(data), n)
    dump ("sortf(L,n)", r1)
    if same (r1, r2) then
	write ("\nsortf(S,n) [same]")
    else
	dump ("sortf(S,n) [********** OOPS -- results differ: **********]", r2)
    end

procedure dump (s, l)
    local e
    write ()
    write (s, ":")
    every e := !l do {
       writes ("  ", left(type(e), 8))
       if (type(e) == ("r1" | "r3" | "list")) then
	  every writes (" ", image(e[(1 to 5) | (95 to 100)]) | "\n")
       else
	  write (" ", image(e))
       }
    return
    end

procedure same (a, b)
    local i
    if *a ~= *b then fail
    every i := 1 to *a do
	if a[i] ~=== b[i] then fail
    return
    end