summaryrefslogtreecommitdiff
path: root/tests/general/recent.icn
diff options
context:
space:
mode:
Diffstat (limited to 'tests/general/recent.icn')
-rw-r--r--tests/general/recent.icn291
1 files changed, 291 insertions, 0 deletions
diff --git a/tests/general/recent.icn b/tests/general/recent.icn
new file mode 100644
index 0000000..946da1c
--- /dev/null
+++ b/tests/general/recent.icn
@@ -0,0 +1,291 @@
+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
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-07 17:53:22 +0000