home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / icon / dos / src / tests / endetab.icn < prev    next >
Text File  |  1992-02-09  |  5KB  |  146 lines
  1. # test type conversion and error handling in entab/detab
  2.  
  3. procedure main ()
  4.    s := "rutabaga"
  5.    if entab('1987') ~== "1789" then write ("oops 1")
  6.    if detab('1492') ~== "1249" then write ("oops 2")
  7.    if entab("    ","3") ~== "\t\t" then write ("oops 3")
  8.    if detab("\t\t","3") ~== "    " then write ("oops 4")
  9.    ferr (103, entab, [])
  10.    ferr (103, detab, [])
  11.    ferr (103, entab, [[]])
  12.    ferr (103, detab, [[]])
  13.    ferr (101, entab, [s,2,3,&lcase])
  14.    ferr (101, detab, [s,4,5,&ucase])
  15.    ferr (210, entab, [s,7,4])
  16.    ferr (210, entab, [s,6,6])
  17.    ferr (210, detab, [s,8,5])
  18.    ferr (210, detab, [s,3,3])
  19.  
  20.    endetab1()
  21.  
  22.    end
  23.  
  24.  
  25. # ferr(err,func,arglst) -- call func(args), verify that error "err" is produced
  26.  
  27. procedure ferr (err, func, args)
  28.    local val
  29.  
  30.    val := ""
  31.    every val ||:= image(!args) || ","
  32.    val := val[1:-1]
  33.    msg := "oops -- " || image(func) || "(" || val || ") "
  34.    &error := 1
  35.    if func!args
  36.       then write (msg, "succeeded")
  37.    else if &error ~= 0
  38.       then write (msg, "failed but no error")
  39.    else if &errornumber ~= err
  40.       then write (msg, "got error ",&errornumber," instead of ",err)
  41.    &error := 0
  42.    return
  43.    end
  44.  
  45. ## Test driver for entab and detab
  46. #
  47. #  Input is read from standard input.  Commentary and error reports go to
  48. #  standard output.
  49. #
  50. #  Input lines are first preprocessed by interpreting escape sequences \a, \b,
  51. #  \n, \r, and \t and trimming a trailing '$' character.
  52. #  
  53. #  Input lines beginning with "=" establish tab stop settings.  Each numeric
  54. #  field specifies a tab stop, according to the entab/detab specs.
  55. #  
  56. #  All other lines are passed through entab and then detab, and the results are
  57. #  checked.  The characters "!" and "." are replaced by spaces before calling
  58. #  entab; "!" positions are expected to be replaced by tabs, with "." positions
  59. #  disappearing.  For example, "abcd!...ijk" tests that entab("abcd    ijk")
  60. #  returns "abcd\tijk".
  61. #  
  62. #  The result of each entab call is then passed to detab, with results expected
  63. #  to match the original entab argument (or its detab, if it had any tabs).
  64.  
  65. procedure endetab1 ()
  66.    params := setup ("=")        # start with default tabs (no args)
  67.    while line := escape (read ()) do {    # read and preprocess line
  68.       if line[1] == "=" then
  69.          params := setup (line)        # '=' line sets tab stops (arg list)
  70.       else {
  71.          s := map (line, "!.", "  ")    # turn "!." characters into spaces
  72.          params[1] := s
  73.          t := invoke (entab, params)    # run entab
  74.          if t ~== interp (line) then {    # check results
  75.             write ("entab failed for: ", map(line,"\t\r\n\b\007","!RNBA"))
  76.             write ("  returned value: ", map(t,   "\t\r\n\b\007","!RNBA"))
  77.          } else {
  78.             if upto ('\t', s) then    # detab input if it had a tab
  79.                s := invoke (detab, params)
  80.             params[1] := t
  81.             t := invoke (detab, params)    # detab the result of the entab
  82.             if t ~== s then {        # compare results
  83.                write ("detab failed for: ", map(line,"\t\r\n\b\007","!RNBA"))
  84.                write ("  returned value: ", map(t,   "\t\r\n\b\007","!RNBA"))
  85.                }
  86.             }
  87.          }
  88.    }
  89.    end
  90.  
  91. procedure escape (line)        # interpret escape sequences and trim one '$'
  92.    if line[-1] == "$" then
  93.       line := line[1:-1]
  94.    s := ""
  95.    line ? 
  96.       while not pos (0) do {
  97.          s ||:= tab (upto ('\\') | 0)
  98.          s ||:= (="\\" & case (c := move(1)) of {
  99.         "a": "\007"
  100.             "b": "\b"
  101.             "n": "\n"
  102.             "r": "\r"
  103.             "t": "\t"
  104.             default: "\\" || c
  105.          })
  106.       }
  107.    return s
  108.    end
  109.  
  110. procedure interp (pattern)    # interpret metacharacters '!.'
  111.    s := ""
  112.    pattern ? 
  113.       while not pos (0) do {
  114.          tab (many ('.'))
  115.          s ||:= tab (upto ('.') | 0)
  116.       }
  117.    return map (s, "!", "\t")
  118.    end
  119.  
  120. procedure setup (line)        # interpret and report a column spec line
  121.    p := [&null]
  122.    line ? while tab (upto (&digits)) do
  123.       put (p, integer (tab (many (&digits))))
  124.    writes ("testing entab/detab(s")
  125.    every writes (",", \!p)
  126.    write (")")
  127.    return p
  128.    end
  129.  
  130. procedure invoke (func, a)    # invoke a function with a list of up to 10 args
  131.    return case *a of {
  132.       0:  func ()
  133.       1:  func (a[1])
  134.       2:  func (a[1], a[2])
  135.       3:  func (a[1], a[2], a[3])
  136.       4:  func (a[1], a[2], a[3], a[4])
  137.       5:  func (a[1], a[2], a[3], a[4], a[5])
  138.       6:  func (a[1], a[2], a[3], a[4], a[5], a[6])
  139.       7:  func (a[1], a[2], a[3], a[4], a[5], a[6], a[7])
  140.       8:  func (a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8])
  141.       9:  func (a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9])
  142.       10: func (a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9], a[10])
  143.       default: stop ("too many args for invoke")
  144.    }
  145.    end
  146.