regina/trip/stack.rexx

   1 /*
   2  *  The Regina Rexx Interpreter
   3  *  Copyright (C) 1992  Anders Christensen <anders@solan.unit.no>
   4  *
   5  *  This program is free software; you can redistribute it and/or modify
   6  *  it under the terms of the GNU General Public License as published by
   7  *  the Free Software Foundation; either version 2 of the License, or
   8  *  (at your option) any later version.
   9  *
  10  *  This program is distributed in the hope that it will be useful,
  11  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  *  GNU General Public License for more details.
  14  *
  15  *  You should have received a copy of the GNU General Public License
  16  *  along with this program; if not, write to the Free Software
  17  *  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18  */
  19
  20 /* testing the implementation of the stack */
  21 trace o
  22 written = 0
  23 options MAKEBUF_BIF DROPBUF_BIF DESBUF_BIF
  24
  25 /* first check PUSH */
  26 call notify 'push'
  27    push 'first'
  28    push 'second'
  29    pull one
  30    pull two
  31
  32    if (one^=="SECOND") | (two^=="FIRST") then
  33       call complain 'The PUSH statement does not work'
  34
  35 call notify 'queue'
  36    queue 'first'
  37    queue 'second'
  38    pull one
  39    pull two
  40
  41    if (one^=="FIRST") | (two^=="SECOND") then
  42       call complain 'The QUEUE statement does not work'
  43
  44    queue
  45    push
  46    pull one
  47    pull two
  48
  49    if (one^=='') | (two^=="") then
  50       call complain 'Either QUEUE or PUSH do not stack empty lines'
  51
  52 /* the queued() function */
  53 call notify 'queued'
  54    call ch queued(), 0
  55    push 'one'
  56    call ch queued(), 1
  57    push 'two'
  58    queue 'three'
  59    call ch queued(), 3
  60
  61    parse pull first
  62    call ch first, 'two'
  63    parse pull second
  64    call ch second, 'one'
  65    parse pull third
  66    call ch third, 'three'
  67    call ch queued(), 0
  68
  69    push 'one'
  70    push 'two'
  71    call makebuf
  72    push 'three'
  73    call ch queued(), 3
  74    push 'four'
  75    call makebuf
  76    call ch queued(), 4
  77    push 'five'
  78
  79    call dropbuf
  80    call ch queued(), 4
  81    call dropbuf
  82    call ch queued(), 2
  83    call dropbuf
  84    call ch queued(), 0
  85    call dropbuf
  86    call ch queued(), 0
  87
  88
  89
  90 call notify 'commands'
  91
  92    address system
  93
  94 /*----- Let's see if it can pipe the stack ----------------------------*/
  95
  96    queue 'To be or not to be'
  97    'LIFO> tr abcdefghijkl ABCDEFGHIJKL >LIFO'
  98
  99    parse pull line
 100    if line^=='To BE or not to BE' then
 101       call complain 'Can not pipe the stack-contents through a command'
 102
 103    queue 'To be or not to be'
 104    Address System 'tr abcdefghijkl ABCDEFGHIJKL' With Input LIFO '' Output LIFO ''
 105
 106    parse pull line
 107    if line^=='To BE or not to BE' then
 108       call complain 'Can not pipe the stack-contents through a command using ANSI extensions'
 109
 110 /*----- does it clear the stack when command just read a few lines ----*/
 111    queue 'asdf asdf'
 112    queue 'zxcv zxcv'
 113    queue 'tyui tyui'
 114    queue 'ghjk ghjk'
 115
 116    'LIFO> head -2 | wc >LIFO'
 117    if queued()^=='1' then
 118       call complain 'Commands does not clear stack'
 119
 120    parse pull lines words chars .
 121    if lines words chars^=='2 4 20' then
 122       call complain 'Something is incorrect in the stack'
 123
 124    queue 'asdf asdf'
 125    queue 'zxcv zxcv'
 126    queue 'tyui tyui'
 127    queue 'ghjk ghjk'
 128
 129    Address System 'head -2 | wc' With Input LIFO '' Output LIFO ''
 130    if queued()^=='1' then
 131       call complain 'Commands does not clear stack using ANSI extensions'
 132
 133    parse pull lines words chars .
 134    if lines words chars^=='2 4 20' then
 135       call complain 'Something is incorrect in the stack using ANSI extensions'
 136
 137 /*----- let's see if it really send it through system(3) ---------------*/
 138 /* sorry, too many machines don't set the USER environment variable. */
 139 /*
 140    address system
 141
 142    'whoami >LIFO'
 143    'echo $USER >LIFO'
 144    parse pull myself .
 145    parse pull alsome .
 146    if myself^==alsome then
 147       call complain 'Command did not resolve environment variable'
 148 */
 149
 150 /*----- let's take it for some heavy piping ----------------------------*/
 151 signal next_test
 152    dict_words = '/usr/dict/words'
 153    if ^stream(dict_words, 'c', 'readable') then do
 154       'man sh > /tmp/dict 2>/dev/null'
 155       'man csh >> /tmp/dict 2>/dev/null'
 156       'man vi >> /tmp/dict 2>/dev/null'
 157       'cat /tmp/dict | tr -cs ''a-zA-z0-9'' '' '' | sort -u > /tmp/dict_words'
 158       dict_words = '/tmp/dict_words'
 159    end
 160
 161    words = 'wc'('-l dict_words')
 162    'cat' dict_words '>LIFO'
 163    if words != queued() then
 164       call complain 'Could not get all short lines to the stack'
 165
 166    'LIFO> cat >LIFO'
 167    if words != queued() then
 168       call complain 'Could not correctly run short lines on the stack'
 169
 170    'LIFO> sort -0.3 >LIFO'
 171    if words != queued() then
 172       call complain 'Could not correctly "rotate" short lines on the stack'
 173
 174    'LIFO> wc -l >LIFO'
 175    if queued() != 1 then
 176       call complain 'Could not flush short lines into the stack'
 177
 178    parse pull lines .
 179    if words != lines then
 180       call complain 'Not all short lines flushed got through'
 181
 182 /*----- then, let's try the same thing with some longer lines ----------*/
 183    oldtrace = trace()
 184    trace off
 185    'awk "BEGIN{while(1){print \"yes\"};}"' copies('X',10) '| head -10000 >LIFO'
 186    trace oldtrace
 187    if queued()!=10000 then
 188       call complain 'Could not put 10000 lines to the stack'
 189
 190    'LIFO> cat >LIFO'
 191    if  queued() != 10000 then
 192       call complain 'Could not run long lines through cat'
 193
 194    'LIFO> sort >FIFO'
 195    if queued() != 10000 then
 196       call complain 'Could not rotate long lines on the stack'
 197
 198    'LIFO> wc -l >LIFO'
 199    if queued() != 1 then
 200       call complain 'Could not flush long stack to program'
 201
 202 next_test:
 203 /*----- The nullstring is a valid command ------------------------------*/
 204 /*
 205  * This is kind of hard to check, but at least we can try to send a
 206  * nullstring as a command, and try to catch any errors that might
 207  * occur from it.
 208  */
 209 call notify 'empty command'
 210
 211    ""
 212
 213 /* The setting of RC variable checked in signal.rexx */
 214
 215
 216
 217 call notify 'buffers'
 218 /*
 219  * try to check the performance of buffers. However, this is
 220  * specific to some implementations
 221  */
 222    do queued() ; pull ; end   /* just in case ... */
 223
 224    res = makebuf() makebuf() makebuf()
 225    if res \== '1 2 3' then
 226       call complain 'MAKEBUF does not return correct return value'
 227
 228
 229    res = dropbuf() dropbuf() dropbuf() dropbuf() dropbuf()
 230    if res \= '2 1 0 0 0' then
 231       call complain 'DROPBUF does not return correct return value'
 232
 233
 234    push 'second'
 235    push 'third'
 236    call makebuf
 237    push 'fourth'
 238    call dropbuf
 239    parse pull line1
 240    parse pull line2
 241    if line1\='third' | line2\='second' then
 242       call complain 'DROPBUF kills line below the buffer'
 243
 244    call makebuf
 245    push 'first'
 246    call makebuf
 247    push 'second'
 248    parse pull line1
 249    parse pull line2
 250    brc = makebuf()
 251    if line1\='second' | line2\='first' | brc\='2' then
 252       call complain 'Reading lines doesn''t remove buffers'
 253
 254    call desbuf
 255    push 'first'
 256    push 'second'
 257    res= dropbuf()
 258    if queued()>0 | res\=0 then
 259       call complain 'DROPBUF does not remove ''zeroth'' buffer'
 260
 261
 262    call desbuf
 263    call makebuf
 264    call makebuf
 265    push 'first'
 266    call makebuf
 267    push 'second'
 268    call makebuf
 269    push 'third'
 270    call makebuf
 271    call makebuf
 272    res = dropbuf(-3)
 273    parse pull line
 274    if res\=3 | line\='second' then
 275       call complain 'DROPBUF with negative argument did not work'
 276
 277    call desbuf
 278    push 'first'
 279    call makebuf
 280    push 'second'
 281    res = dropbuf(0)
 282    if queued()\=0 | res\=0 then
 283       call complain 'DROPBUF with zero argument didn''t clear stack'
 284
 285
 286
 287 say ''
 288 exit 0
 289
 290
 291 ch: procedure expose sigl
 292    parse arg first, second
 293    if first ^== second then do
 294       say
 295       say "first= /"first"/"
 296       say "second=/"second"/"
 297       say "FuncTrip: error in " sigl":" sourceline(sigl) ; end
 298    return
 299
 300
 301 notify:
 302    parse arg word
 303    written = written + length(word) + 2
 304    if written>75 then do
 305       written = length(word)
 306       say ' '
 307    end
 308    call charout , word || ', '
 309    return
 310
 311
 312 error:
 313    say 'Error discovered in function insert()'
 314    return
 315
 316
 317 complain:
 318    say ' ...'
 319    say 'Tripped in line' sigl':' arg(1)'.'
 320    length = charout(,'   (')
 321 return
 322
 323