regina/trip/files.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 /* ==== config ==== */
  21
  22    conf.truncate = 1   /* truncates when writing line to middle of file */
  23
  24 trace o
  25 parse source os .
  26 call time 'R'
  27 written = 0
  28 signal on notready
  29
  30    simple = 'simple'
  31    if os = 'UNIX' | os = 'BEOS' | os = 'QNX' | os = 'LINUX' then
  32      do
  33        eol = 'LF'
  34        oscopy = 'cp'
  35        osdel1 = 'rm -f'
  36        oslsl_root = 'ls -l /'
  37        tonul = ' > /dev/null 2>&1'
  38        file = '/tmp/rexx.test'
  39        'echo "First line" > simple'
  40        'echo "Second line" >> simple'
  41        'echo "Third line" >> simple'
  42        num_eol_chars = 1
  43        eol_chars = '0a'x
  44      end
  45    else if os = 'AMIGA' | os = 'AROS' then
  46      do
  47        eol = 'LF'
  48        oscopy = 'copy'
  49        osdel1 = 'delete'
  50        tonul = ' >NIL: '
  51        file = 'T:rexx.test'
  52      end
  53    else
  54      do
  55        eol = 'CRLF'
  56        oscopy = 'copy'
  57        osdel1 = 'del'
  58        oslsl_root = 'dir \'
  59        tonul = '> nul 2>&1'
  60        file = 'c:\temp\rexx.tst'
  61        'echo First line> simple'
  62        'echo Second line>> simple'
  63        'echo Third line>> simple'
  64        num_eol_chars = 2
  65        eol_chars = '0d'x || '0a'x
  66      end
  67    osdel1 file tonul
  68
  69
  70    Parse Version Ver .
  71    If Left( ver, 11 ) = 'REXX-Regina' Then regina = 1
  72    Else regina = 0
  73 /*signal test022*/
  74
  75 test001:
  76 /* === 001 : simple write and read  ============================ */
  77    call notify 'simple'
  78    file001 = file || 001
  79    if (0\==lineout(file,'This is the first line')) then
  80       call complain 'Could not write first line'
  81    if (0\==lineout(file,'of a very little file')) then
  82       call complain 'Could not write second line'
  83    if (0\==lineout(file,'that will be used')) then
  84       call complain 'Could not write third line'
  85    if (0\==lineout(file,'in this trip test')) then
  86       call complain 'Could not write fourth line'
  87
  88    call lineout file
  89
  90    signal test002
  91
  92
  93 test002:
  94 /* === 002 : simple reading ======================================== */
  95    call notify 'read'
  96    call stream file, 'c', 'close'
  97    res = linein( file )
  98    if (res\=='This is the first line') then
  99       call complain 'didnt position at start after reopening after close'
 100
 101    res = linein( file )
 102    res = linein( file )
 103    if (res \== "that will be used") then
 104       call complain 'Didnt position properly after several reads'
 105
 106    call lineout file
 107    signal test003
 108
 109
 110 test003:
 111 /* === 003 : Test behavior at EOF ================================== */
 112    call notify 'eof'
 113
 114    res = linein( file, 3 )
 115    res = linein( file )
 116    if (res\=='in this trip test') then
 117       call complain 'did not manage to read last line'
 118
 119    signal off notready
 120    res = linein( file )
 121    if res\=='' then
 122       call complain 'nullstring not returned at EOF'
 123
 124    call stream file, 'c', 'close'
 125    signal on notready
 126
 127 signal test004
 128
 129 test004:
 130 /* === 004 : are we able to read zero lines ======================== */
 131    call notify 'zero_line'
 132
 133    res = linein( file, 3, 0 )
 134    if (res\=='') then
 135       call complain 'Could not position without reading anything'
 136
 137    res = linein( file )
 138    if (res\=='that will be used') then
 139       call complain 'Did not position correctly in the file'
 140
 141    res = linein( file, 2 )
 142    if (res\=='of a very little file') then
 143       call complain 'Could not position and read simultaneously'
 144
 145    call lineout file
 146    signal test005
 147
 148
 149 test005:
 150 /* === 005 : Will it truncate when writing new lines ===================== */
 151    call notify 'truncate'
 152
 153    oscopy file file'.tmp' tonul
 154    res = lineout( file'.tmp', '<<<foobar>>>', 2 )
 155    if (res\=='0') then
 156       call complain 'non-zero result from when just positioning'
 157
 158    res = linein( file'.tmp', 1 )
 159    if (res\=='This is the first line') then
 160       call complain 'first line was corrupted'
 161
 162    res = linein( file'.tmp' )
 163    if (res\=='<<<foobar>>>') then
 164       call complain 'second line not properly written'
 165
 166    signal off notready
 167    res = linein( file'.tmp' )
 168    if (res\=="") then
 169       call complain 'file was not truncated'
 170    signal on notready
 171
 172    call lineout file'.tmp'
 173    signal test006
 174
 175
 176
 177 test006:
 178 /* === 006 : Can we read characters =================================== */
 179    call notify 'charin'
 180
 181    if eol = "LF" then
 182      do
 183        numcol1 = 15
 184        numcol2 = 17
 185        resstr1 = 'rst line'||'0a'x||'of a v'
 186        resstr2 = 'ery little file'||'0a'x||'t'
 187      end
 188    else
 189      do
 190        resstr1 = 'rst line'||'0d'x||'0a'x||'of a v'
 191        resstr2 = 'ery little file'||'0d'x||'0a'x||'t'
 192        numcol1 = 16
 193        numcol2 = 18
 194      end
 195    res = charin( file, 15, numcol1 )
 196    if (res \== resstr1) then
 197       call complain 'could not read characterbased from file'
 198
 199    res = charin( file,, numcol2 )
 200    if (res \== resstr2) then
 201       call complain 'charin cant position right'
 202
 203    res = linein( file )
 204    if (res\=='hat will be used') then
 205       call complain 'character and line based io does not share read pointer'
 206
 207    call lineout file
 208    signal test007
 209
 210
 211
 212 test007:
 213 /* === 007 : Is I/O faked when a file is in error? ==================== */
 214
 215    if regina = 0 then signal test009 /* following tests only valid for Regina */
 216
 217    call notify 'faking'
 218
 219    exist = 'existent'
 220    nonexist = 'nonexistent'
 221    oslsl_root '>' exist
 222    foo = 0
 223
 224    osdel1 nonexist tonul
 225
 226    call on notready name trap007
 227    res = length(charin(nonexist,,10)) + length('cp'(exist,nonexist)) + foo +,
 228          length(charin(nonexist,,10)) + foo + length(linein(nonexist)) + foo +,
 229          length(charin(nonexist,,10)) + foo + length(linein(nonexist)) + foo
 230    if res\==0 then
 231       call complain "Condition NOTREADY don't fake further I/O properly"
 232
 233    if foo\==1 then
 234       call complain "Help, I don't think condition handler was called"
 235
 236    call lineout nonexist
 237    call lineout exist
 238
 239    signal on notready
 240    signal test008
 241
 242
 243
 244 trap007:
 245    foo = 1
 246    address system
 247    'touch' nonexist
 248    'echo "Here is the contents of nonexistent" >>' nonexist
 249    'echo "Here is the second line of nonexistent" >>' nonexist
 250    'echo "Here is the third line of nonexistent" >>' nonexist
 251    return
 252
 253
 254
 255
 256 test008:
 257 /* === 008 : But I/O to other files is _not_ to be disturbed =========== */
 258    call notify 'nofake'
 259
 260    call on notready name trap008
 261    exist = 'existent'
 262    nonexist = 'nonexistent'
 263    oslsl_root '>' exist
 264    foo = 0
 265
 266    sum = 20 + length(linein(exist)) + length(linein(exist))
 267    call stream exist,    'c', 'close'
 268    call stream nonexist, 'c', 'close'
 269
 270    osdel1 nonexist
 271    res = length(charin(nonexist,,10)) + length('cp'(exist,nonexist))   + foo +,
 272          length(charin(exist,,10))    + foo + length(linein(exist,1))  + foo +,
 273          length(charin(nonexist,,10)) + foo + length(linein(nonexist)) + foo +,
 274          length(charin(exist,,10))    + foo + length(linein(exist,2))  + foo +,
 275          length(charin(nonexist,,10)) + foo + length(linein(nonexist)) + foo
 276
 277    if res\==sum then
 278       call complain "Condition NOTREADY fake other files too"
 279
 280    if foo\==1 then
 281       call complain "Help, I don't think condition handler was called"
 282
 283    call lineout exist
 284    call lineout nonexist
 285
 286    signal on notready
 287    signal test009
 288
 289 trap008:
 290    foo = 1
 291    return
 292
 293
 294
 295 test009:
 296 /* === 009 : If rest of line is a EOL, what does linein return? ====== */
 297    call notify 'halfline'
 298
 299    osdel1 file tonul
 300    if eol = 'CRLF' then do
 301       'echo First line>'file
 302       'echo Second line>>'file
 303       'echo Third line>>'file
 304    end
 305    else do
 306       'echo "First line" >'file
 307       'echo "Second line" >>'file
 308       'echo "Third line" >>'file
 309    end
 310
 311    call stream file, 'c', 'close'
 312
 313    res = charin( file,, 10 )   /* now at EOL */
 314    if res\=='First line' then
 315       call complain "Simple use of charin() failed: got:["res"] expected [First line]"
 316
 317    res = linein( file )   /* must be rest of line, i.e. nullstring */
 318    if res\=='' then
 319       call complain "Linein() didn't return '' when next char was EOL; got["res"]"
 320
 321    res = charin( file, 1, 10 )
 322    if res\=='First line' then
 323       call complain "Simple use of charin() does not work; got["res"] expected [First line]"
 324
 325    res = linein( file, 1 )
 326    if res\=='First line' then
 327       call complain "Linein() didn't read whole line after positioning; got["res"] expected [First line]"
 328
 329    call lineout file
 330    signal test010
 331
 332
 333 test010:
 334 /* === 010 : Are read and write positions independent? ================ */
 335    call notify 'crp/cwp'
 336
 337    file = 'testfile'
 338    oscopy simple file tonul
 339
 340    res = charin(file,,5)
 341    if res\=='First' then
 342       call complain "Simple use of charin() failed"
 343
 344    res = charout(file,"IRST FIL",2)
 345    if res\==0 then
 346       call complain "Simple use of charout() failed"
 347
 348    res = charin(file,,5)
 349    if res\==' FILe' then
 350       call complain "Charout() didn't overwrite data in file"
 351
 352    res = charin(file,1,10)
 353    if res\=='FIRST FILe' then
 354       call complain "Charout() write incorrect data to file"
 355
 356    res = charout(file, 'xyzzy' )
 357    if res\==0 then
 358       call complain "Continuing charout() didn't work"
 359
 360    res = charin(file,, 10)
 361    if eol = 'CRLF' then str = "yzzycond l"
 362    else str = "yzzyond li"
 363    if res\==str then
 364       call complain "Charin() or charout() doesn't work; got["res"] expecting ["str"]"
 365
 366    call lineout file
 367    signal test011
 368
 369
 370
 371
 372 test011:
 373 /* === : 011 I/O should only be faked when NOTREADY is trapped ======== */
 374    call notify 'notready'
 375
 376    if eol = 'CRLF' then none = '\no\such\file'
 377    else none = '/no/such/file'
 378    foo = 0
 379
 380    call stream none, 'c', 'close'
 381    osdel1 none tonul
 382
 383    call on notready name trap011
 384    res = lineout(none,"Foobar") + lineout(none,"HeppHepp")
 385    if res\==0 then
 386       call complain "Don't fake line output after error output"
 387
 388    res = lineout(none,"Foobar") + lineout(none,"HeppHepp")
 389    if res\==0 then
 390       call complain "Doesn't fakes line output in next line after error output"
 391
 392    if foo\==2 then
 393       call complain "Condition trap was not called"
 394
 395    signal off notready
 396    res = lineout(none,"Foobar") + lineout(none,"HeppHepp")
 397    if res\==2 then
 398       call complain "Fakes line output in next line after error output"
 399
 400    if foo\==2 then
 401       call complain "Condition trap called too many times"
 402
 403
 404    call on notready name trap011
 405    call stream none, 'c', 'close'
 406    foo = 0
 407    res = charout(none,"Foobar") + charout(none,"HeppHepp")
 408    if res\==0 then
 409       call complain "Don't fake char output after error output"
 410
 411    res = charout(none,"Foobar") + charout(none,"HeppHepp")
 412    if res\==0 then
 413       call complain "Doesn't fake char output in next line after error output"
 414
 415    if foo\==2 then
 416       call complain "Condition trap was not called"
 417
 418    signal off notready
 419    res = charout(none,"Foobar") + charout(none,"HeppHepp")
 420    if res\==14 then
 421       call complain "Fakes char output in next line after error output"
 422
 423
 424
 425    call stream none, 'c', 'close'
 426    call off notready
 427
 428    res = lineout(none,"Foobar") + lineout(none,"HeppHepp")
 429    if res\==2 then
 430       call complain "Did fake line output when not trapping NOTREADY"
 431
 432    res = charout(none,"Foobar") + charout(none,"HeppHepp")
 433    if res\==14 then
 434       call complain "Did fake char output when not trapping NOTREADY"
 435
 436    if foo\==2 then
 437       call complain "Did call trap, when not enabled"
 438
 439    call lineout none
 440    signal on notready
 441    signal test012
 442
 443
 444 trap011:
 445    foo = foo + 1
 446    return
 447
 448
 449 test012:
 450 /* === 012 : Illegal to position more than one after EOF ============ */
 451 /*           in writeable files, and after EOF in readable files      */
 452
 453    if regina = 0 then signal test013 /* test only valid for Regina */
 454
 455    call notify 'holes'
 456
 457    file = 'testfile'
 458    oscopy simple file tonul
 459
 460    call stream file, 'c', 'close'
 461    lines = lines( file )
 462    chars = 0
 463    if (lines>1) then
 464       do lines
 465          chars = chars + length(linein(file)) + num_eol_chars
 466          end
 467    else
 468       do while lines( file )>0
 469          chars = chars + length(linein(file)) + num_eol_chars
 470          end
 471
 472    call stream file, 'c', 'close'
 473
 474
 475    signal on notready name trap012a
 476    signal on syntax name trap012a
 477    foo = 0
 478    call charin file, chars, 0   /* at last char */
 479    foo = 1
 480 trap012a:
 481    call stream file, 'c', 'reset'
 482    if foo\==1 then
 483       call complain "Trapped when positioning read at last char in file"
 484
 485
 486    signal on notready name trap012b
 487    signal on syntax name trap012b
 488    foo = 0
 489    call charin file, chars+1, 0  /* char 'after' EOF */
 490    foo = 1
 491 trap012b:
 492    call stream file, 'c', 'reset'
 493    if foo\==0 then
 494       call complain "Didn't trap positioning read after EOF"
 495
 496    signal on notready name trap012c
 497    signal on syntax name trap012c
 498    foo = 0
 499    call charout file,, chars+1    /* legal, don't truncate */
 500    foo = 1
 501 trap012c:
 502    call stream file, 'c', 'reset'
 503    if foo\==1 then
 504       call complain "Trapped when positioning write at EOF+1"
 505
 506    'cmp' simple file ">/dev/null"
 507    if rc\==0 then
 508       call complain "File changed when positioning at EOF+1"
 509
 510    signal on notready name trap012d
 511    signal on syntax name trap012d
 512    foo = 0
 513    call charout file,, chars+2   /* not legal */
 514    foo = 1
 515 trap012d:
 516    call stream file, 'c', 'reset'
 517    if foo\==0 then
 518       call complain "Not trapped when positioning write beyond EOF+1"
 519
 520    'cmp' simple file tonul
 521    if rc\==0 then
 522       call complain "File changed when positioning beyond EOF+1"
 523
 524
 525    signal on notready name trap012e
 526    signal on syntax name trap012e
 527    foo = 0
 528    call charout file,, chars   /* legal, may not truncate */
 529    foo = 1
 530 trap012e:
 531    call stream file, 'c', 'reset'
 532    if foo\==1 then
 533       call complain "Trapped when positioning at EOF"
 534
 535    'cmp' simple file tonul
 536    if rc\==0  then
 537       call complain "File was changed when char positioning in file"
 538
 539    call lineout file
 540    signal off syntax
 541    signal on notready
 542    signal test013
 543
 544
 545
 546
 547 test013:
 548 /* === 013 : A line written to the middle of a file gets a ============ */
 549 /*           trailing, but not leading EOF ============================ */
 550    call notify 'linecnt'
 551
 552    file = 'testfile'
 553    oscopy simple file tonul
 554
 555    signal off notready
 556    call charout file,, 14+num_eol_chars
 557    call lineout file, "<<<..--..>>>"
 558    res = charin( file, 1, 30+(2*num_eol_chars) )
 559
 560    if left(res,25+(2*num_eol_chars))\=="First line"eol_chars"Sec<<<..--..>>>"eol_chars then
 561       call complain "Problems when inserting a line into a file"
 562
 563    if conf.truncate then do
 564       last_line_len = 25+(2*num_eol_chars)
 565       if length(res)\==last_line_len then
 566          call complain "File was not truncated. End of file contents length should be" last_line_len"; got" length(res)
 567       end
 568    else
 569       if length(res)\==30 & right(res,3)\=='d l' then
 570          call complain "Rest of line was mangled, after inserting line in file"
 571
 572    call lineout file
 573    signal on notready
 574    signal test014
 575
 576
 577
 578
 579 test014:
 580 /* === 014 : When doing system() after fork() all files are closed, === */
 581 /*           Maybe we can trigger flushing twice? ===================== */
 582    call notify 'flush'
 583
 584    file = 'testfile'
 585    call stream file, 'c', 'close'
 586    call stream file, 'c', 'open write replace'
 587    call stream file, 'c', 'close'
 588
 589    junk = charout(file, "<<<--->>>"'0a'x)
 590
 591    address system 'rc 0'
 592    call stream file, 'c', 'close'
 593
 594    if lines(file)\==1 | chars(file)\==10 then
 595       call complain "Possibly double flushing during file output"
 596
 597    call lineout file
 598    signal test015
 599
 600
 601
 602 test015:
 603 /* === 015 : Illegal to position on transient streams ================= */
 604 /*           Default input and output are transient =================== */
 605    call notify 'repos'
 606
 607    signal on syntax name trap015a
 608    signal on notready name trap015a
 609    res = charin(,42,0)
 610    call complain "Didn't trap character repositioning on default input"
 611
 612 trap015a:
 613    signal on syntax name trap015b
 614    signal on notready name trap015b
 615    res = charout(,,42)
 616    call complain "Didn't trap character repositioning on default output"
 617
 618 trap015b:
 619    signal on syntax name trap015c
 620    signal on notready name trap015c
 621    res = linein(,42,0)
 622    call complain "Didn't trap line repositioning on default input"
 623
 624 trap015c:
 625    signal on syntax name trap015d
 626    signal on notready name trap015d
 627    res = lineout(,,42)
 628    call complain "Didn't trap line repositioning on default output"
 629
 630 trap015d:
 631
 632    signal on notready
 633    signal off syntax
 634    signal test016
 635
 636
 637
 638 test016:
 639 /* === 016 : Reading EOF for persistent file raises NOTREADY ========== */
 640    call notify 'persist/eof'
 641
 642    file = 'testfile'
 643    oscopy simple file tonul
 644
 645    call stream file, 'c', 'close'
 646    call on notready name trap016
 647    foo = 0
 648    res = charin(file,28+(num_eol_chars*2),10)
 649    if (foo\==1) then
 650       call complain "Didn't raise NOTREADY when reading beyond EOF"
 651
 652    call lineout file
 653    signal on notready
 654    signal test017
 655
 656 trap016:
 657    foo = 1
 658    if res\=='line'eol_chars then
 659       call complain "Data not correct when reading beyond EOF"
 660    return
 661
 662
 663
 664
 665
 666
 667 test017:
 668 /* === 017 : Let's try to write to <stdin> and vice versa ... ========== */
 669    call notify 'stdio'
 670
 671    signal on notready name trap017a
 672    call lineout 'stdin', 'foobar'
 673    call complain "Didn't trap writing to default input stream"
 674
 675 trap017a:
 676
 677    signal on notready name trap017b
 678    call linein 'stdout'
 679    call complain "Didn't trap reading from default output stream"
 680
 681 trap017b:
 682
 683    signal on notready
 684    signal test018
 685
 686
 687 test018:
 688 /* === 018 : Let's read some really long lines ======================== */
 689    call notify 'longlines'
 690
 691    maxlen = 1024 * 256
 692    len = 256
 693
 694    do while len<maxlen
 695       call stream file, 'c', 'open write replace'
 696       hipp = copies('x',len)
 697       written = lineout( file, copies('x', len))
 698       if written\=0 then
 699          call complain "Didn't manage to write out all the data"
 700       hopp = copies('x',len)
 701       line = linein( file, 1 )
 702       if line\==copies('x',len) | len\=length(line) then
 703          call complain "Data read don't equal data written"
 704       len = trunc(len * 1.5, 0) - 10
 705       end
 706
 707    call lineout file
 708    osdel1 file tonul
 709    drop hopp hipp line
 710    signal test019
 711
 712
 713 test019:
 714 /* === 019 : Are we able to open 200 files? =========================== */
 715    call notify 'many'
 716
 717    osdel1 'a*.tmp' tonul
 718
 719    mf = 130
 720    do i=1 to mf
 721       res1 = lineout( "a" || i || ".tmp", "line 1 in file" i "of test")
 722       res2 = lineout( "a" || i || ".tmp", "line 2 in file" i "of test")
 723       if (res1 + res2 > 0) then do
 724          call complain "Didn't manage to write to all" mf "files (only "i")"
 725          signal trip019
 726          end
 727       end
 728
 729    do i=1 to 30
 730       fileno = 1 + (i*5) // (mf-1)
 731       lineno = random( 1, 2 )
 732
 733       res = linein( "a" || fileno || ".tmp", lineno ) ;
 734       if (res\=="line" lineno "in file" fileno "of test") then do
 735          call complain "Didn't manage to read back the data written"
 736          leave ;
 737          end
 738       end
 739
 740 trip019:
 741    do i=1 to mf
 742       call stream "a" || i || ".tmp", 'c', 'close' ;
 743       end
 744
 745    osdel1 'a*.tmp' tonul
 746    signal test020
 747
 748
 749
 750 test020:
 751 /* === 020 : Does chars() or lines() make an unopened file stick ======== */
 752 /*           in the rexx file table? ==================================== */
 753 call notify 'stick'
 754
 755    time = '1'
 756
 757    first020:
 758       signal on notready name notr020a
 759       call stream 'hepp', 'c', 'close'
 760       oscopy 'simple hepp' tonul
 761
 762       if time==2 then
 763          call linein 'hepp', 1, 0
 764
 765       signal on syntax name trap020
 766       if lines('hepp','C')\==3 then
 767          call complain "Simple use of lines() didn't work"
 768       signal off syntax
 769
 770       call stream 'hepp', 'c', 'close' /* must close before delete */
 771       osdel1 'hepp' tonul
 772       line = linein('hepp',1)
 773       if time == 1 then do
 774          if line='' then
 775             call complain "NOTREADY not triggered when reading nonex. file"
 776          else if line=='First line' then
 777             call complain "File stuck in memory when counting lines()"
 778          else
 779             call complain "Something is wrong with lines(), I think"
 780          end
 781       else
 782          if line \== "First line" then
 783             call complain "File wasn't found in memory"
 784
 785 notr020a:
 786    if time=1 then do
 787       time = 2
 788       signal first020
 789       end
 790
 791
 792
 793 /* Then, repeat for charin() */
 794
 795    time = '1'
 796    second020:
 797       signal on notready name notr020b
 798       call stream 'hepp', 'c', 'close'
 799       oscopy 'simple hepp' tonul
 800
 801       if time==2 then
 802          call lineout 'hepp', "hepp"   /* opens for read and write */
 803
 804       hepp_size = 31 + (num_eol_chars * 3)
 805       line_size = 4 + num_eol_chars
 806       if chars('hepp')\==hepp_size + (time==2)*line_size then
 807          call complain "Simple use of chars() didn't work"
 808
 809       call stream 'hepp', 'c', 'close' /* must close before delete */
 810       osdel1 'hepp' tonul
 811       line = linein('hepp',1)
 812       if time == 1 then do
 813          if line='' then
 814             call complain "NOTREADY not triggered when reading nonex. file"
 815          else if line=='First line' then
 816             call complain "File stuck in memory when counting chars()"
 817          else
 818             call complain "Something is wrong with chars(), I think"
 819          end
 820       else
 821          if line \== "First line" then
 822             call complain "File wasn't found in memory"
 823
 824 notr020b:
 825    if time=1 then do
 826       time = 2
 827       signal second020
 828       end
 829
 830    call lineout hepp
 831    signal on notready
 832    signal test021
 833
 834 trap020:
 835    call complain "Interpreter does not support ANSI. LINES( fn, 'C' ) is valid ANSI."
 836
 837
 838 test021:
 839 /* === 021 : Test that close *always* close a file, even if ============= */
 840 /*           the file in error is in error state ======================== */
 841 call notify 'close'
 842    call on notready name notr021
 843
 844    file = simple
 845    res = charin(file,,5) charin(file,500),
 846                      stream(file,'c','close') charin(file,,5)
 847    if res\=='foo' then
 848       call complain "NOTREADY condition was not triggered"
 849
 850    call lineout file
 851    signal on notready
 852    signal test022
 853
 854 notr021:
 855    if res="First line" then
 856       call complain "Something very strange happened, failure not noticed"
 857    else if res='First' then
 858       call complain "Statement interrupted during execution"
 859    else if res\="First  UNKNOWN First" then
 860       call complain "Didn't manage to read correct data"
 861    res = 'foo'
 862
 863    return
 864
 865
 866
 867 test022:
 868 /* === 022 : Does empty output without repositioning close the file? ===== */
 869 call notify 'empty_out(default)'
 870    signal off notready
 871
 872    call stream simple, 'c', 'close'
 873    line = linein( simple ) ;
 874
 875    if line\=="First line" then
 876       call complain "STREAM(fn,'C','CLOSE') doesn't seem to have closed file"
 877
 878    call lineout simple
 879    line = linein( simple )
 880
 881    if line\=="First line" then
 882       call complain "LINEOUT(fn) should be the same as 'CLOSE'."
 883
 884    call stream simple, 'c', 'close'
 885    signal on notready
 886    signal test022a
 887
 888 test022a:
 889 /* === 022 : Does empty output without repositioning close the file? STRICT_ANSI ===== */
 890 call notify 'empty_out(STRICT_ANSI)'
 891    signal off notready
 892    OPTIONS STRICT_ANSI
 893
 894    call stream simple, 'c', 'close'
 895    line = linein( simple ) ;
 896
 897    if line\=="First line" then
 898       call complain "STREAM(fn,'C','CLOSE') doesn't seem to have closed file"
 899
 900    call lineout simple
 901    line = linein( simple )
 902
 903    if line\=="Second line" then
 904       call complain "LINEOUT(fn) should be different to 'CLOSE' according to STRICT_ANSI."
 905
 906    call stream simple, 'c', 'close'
 907    OPTIONS NOSTRICT_ANSI
 908    signal on notready
 909    signal test023
 910
 911
 912 test023:
 913 /* === 023 : Line positioning of file using STREAM ===== */
 914 call notify 'line_pos'
 915    signal off notready
 916
 917    call stream simple, 'c', 'close'
 918    call stream simple, 'c', 'open write replace'
 919    do i = 1 to 100
 920       call lineout simple, Left('line 'i, 10, '*')
 921    end
 922    if eol = 'LF' then line_length = 11
 923    else line_length = 12
 924    call stream simple, 'c', 'close'
 925
 926    cmd = 'OPEN BOTH'
 927    ret = stream( simple, 'c', cmd ); correct = 'READY:'
 928    if ret \= correct then
 929       call complain "STREAM(fn,'C','"cmd"') didn't work: got:" ret 'instead of:' correct
 930    call checkseekpos 1, 1, 1+(100*line_length), 101
 931
 932    /*
 933     * Move read pos to line 30, write pos to line 70
 934     */
 935    cmd = 'SEEK =30 READ LINE'
 936    ret = stream( simple, 'c', cmd ); correct = 30
 937    if ret \= correct then
 938       call complain "STREAM(fn,'C','"cmd"') didn't position correctly got:" ret 'instead of:' correct
 939    call checkseekpos 1+(29*line_length) , 30, 1+(100*line_length), 101
 940
 941    cmd = 'SEEK =70 WRITE LINE'
 942    ret = stream( simple, 'c', cmd ); correct = 70
 943    if ret \= correct then
 944       call complain "STREAM(fn,'C','"cmd"') didn't position correctly got:" ret 'instead of:' correct
 945    call checkseekpos 1+(29*line_length) , 30, 1+(69*line_length), 70
 946
 947    /*
 948     * Move read pos to line 60, write pos to line 50
 949     */
 950    cmd = 'SEEK +30 READ LINE'
 951    ret = stream( simple, 'c', cmd ); correct = 60
 952    if ret \= correct then
 953       call complain "STREAM(fn,'C','"cmd"') didn't position correctly got:" ret 'instead of:' correct
 954    call checkseekpos 1+(59*line_length) , 60, 1+(69*line_length), 70
 955
 956    cmd = 'SEEK -20 WRITE LINE'
 957    ret = stream( simple, 'c', cmd ); correct = 50
 958    if ret \= correct then
 959       call complain "STREAM(fn,'C','"cmd"') didn't position correctly got:" ret 'instead of:' correct
 960    call checkseekpos 1+(59*line_length) , 60, 1+(49*line_length), 50
 961
 962    /*
 963     * Move read pos to line 50, write pos to line 40
 964     */
 965    cmd = 'SEEK -10 READ LINE'
 966    ret = stream( simple, 'c', cmd ); correct = 50
 967    if ret \= correct then
 968       call complain "STREAM(fn,'C','"cmd"') didn't position correctly got:" ret 'instead of:' correct
 969    call checkseekpos 1+(49*line_length) , 50, 1+(49*line_length), 50
 970
 971    cmd = 'SEEK -10 WRITE LINE'
 972    ret = stream( simple, 'c', cmd ); correct = 40
 973    if ret \= correct then
 974       call complain "STREAM(fn,'C','"cmd"') didn't position correctly got:" ret 'instead of:' correct
 975    call checkseekpos 1+(49*line_length) , 50, 1+(39*line_length), 40
 976
 977    /*
 978     * Should now be able to read line 50
 979     */
 980    ret = linein( simple ); correct = 'line 50***'
 981    if ret \= correct then
 982       call complain "LINEIN(fn) returns the wrong value got:" '['ret']' 'instead of:' '['correct']'
 983    /* read pos should now be at line 51 */
 984    call checkseekpos 1+(50*line_length) , 51, 1+(39*line_length), 40
 985
 986    /*
 987     * Move read pos to line 91, write pos to line 81
 988     */
 989    cmd = 'SEEK <10 READ LINE'
 990    ret = stream( simple, 'c', cmd ); correct = 91
 991    if ret \= correct then
 992       call complain "STREAM(fn,'C','"cmd"') didn't position correctly got:" ret 'instead of:' correct
 993    call checkseekpos 1+(90*line_length) , 91, 1+(39*line_length), 40
 994
 995    cmd = 'SEEK <20 WRITE LINE'
 996    ret = stream( simple, 'c', cmd ); correct = 81
 997    if ret \= correct then
 998       call complain "STREAM(fn,'C','"cmd"') didn't position correctly got:" ret 'instead of:' correct
 999    call checkseekpos 1+(90*line_length) , 91, 1+(80*line_length), 81
1000
1001    call stream simple, 'c', 'close'
1002    signal on notready
1003
1004
1005 /* CHARIN():
1006
1007    * If name is omitted, I/O skjer til standard input/output
1008    * Lesing starter normalt paa current read position
1009    * Error naar start er etter EOF
1010    * Dersom lengde er null, skjer bare positionering
1011    * Dersom det er sjanse for at flere tegn blir tilgjengelig
1012      (transiente) er I/O blokket.
1013    * EOF paa persistent filer gir NOTREADY
1014
1015    CHAROUT():
1016
1017    * Returnerer remaining chars
1018    * Hvis string=nullstring, => rc=0
1019    * Default write=\= default read position
1020    * Initial read position and write position
1021    * Start for write kan spesifisere size(file)+1, mens read bare
1022      kan spesifisere size(file)
1023    * Dersom string=tom og start=tom, saa settes cur write pos til
1024      EOF, og evt filen lukkes
1025    * Utskrift er blokket, eller gir feil paa persistent files
1026
1027    CHARS()
1028
1029    * Antallet inkluderer lkinjeskift
1030    * Returnerer 1 dersom ukjent
1031
1032    LINEIN():
1033
1034    * Kan returnere delvise linjer i kombinasjon med charing
1035    * Dersom start er oppgitt, starter read alltid paa starten av en
1036      linje, selv om start er current linje, og current er paa
1037      midten av linja.
1038    * Blokkerer I/O til fullstendig linje er tilgjenglig (transient)
1039    * Retuernerer ufullstendig linje og trigger NOTREADY for EOF
1040      paa persistent files
1041
1042    LINEOUT():
1043
1044    * String='' skriver ut ebn EOL
1045    * Ved skriving til en file, terminerer lionjer *etter* nu linje,
1046      ikke foran
1047
1048    LINES():
1049
1050    * Antall hele linjher som er igjen: a) halv linje paa slutten teller
1051      ikke, mens b) halv linje paa starten telles
1052
1053    * Pull/linein og say/lineout bruker samme interface.
1054
1055    * Status for en stream lagres ikke over subroutine kall
1056
1057    Vanskelige ....
1058
1059    * Skrive til <stdin> og lese fra <stdout>
1060    * Aapne filer en masse, og se om noe skjaerer seg.
1061    * Les lange (svaert lange) linjer
1062    * Proev aa forvirre med filer der siste linjer ikke har EOL
1063    * Posisjoner til en linjer som ikke finnes
1064    * Skrive inn, eller fjern EOL fra fil, og se om det forvirrer
1065      linjetellingen. Gjoer skrivingen baade innefra og utenfra Rexx
1066    * Apne tom filer for lesing
1067    * La lesepos vaere langt ute i fila, trunker paa et tidligere punkt
1068    * Forsoek posisjonering paa standard input og output
1069    * Test at lesing/skriving avc ASCII NUL fungerer baade for
1070      character og linje basert I/O
1071    * Klarer vi aa lang kroell med /dev/null?  Vi skal ikke kunne lese,
1072      og ved skriving skal det bli kroell i linjetellingen
1073    * Har leseaccess; proever aa skrive, mistes leseakksess?
1074    * Omvendt, dersom vi starter med leseaccess.
1075    * Har leseaccess, denne fjernes (Av eksternt program), forsoeker aa
1076      faa skriveaksess, mistes leseacckess
1077    * samme for skriveaccess
1078    * Aapner fil for leseakses, flytter fila, aapner for skriveakksess
1079    * Kan vi lure den til aa flush'e to ganger: ved fork() og close()
1080
1081    * Kan vi bruke cd() til aa faa den til aa operere paa en annen fil?
1082
1083    * Naa trigger syntax dersom vi proever aa positionere oss til et
1084      punkt etter eof.
1085
1086 */
1087
1088
1089
1090    test999:
1091    say ' '
1092 say time('E') "seconds used"
1093 exit 0
1094
1095 notready:
1096    say ' ...'
1097    say 'Got an unwanted NOTREADY ... Ouch!'
1098    say 'cond("d")='condition("d")
1099    length = charout(,'   (')
1100    return
1101
1102
1103 ch: procedure expose sigl
1104    trace off
1105    parse arg first, second
1106    if first \== second then do
1107       say
1108       say 'first  = /'first'/'
1109       say 'second = /'second'/'
1110       say "FuncTrip: error in " sigl":" sourceline(sigl) ; end
1111    return
1112
1113
1114 complain:
1115    trace off
1116    say ' ...'
1117    if arg() = 2 then lineno = arg(2)
1118    else lineno = sigl
1119    say 'Tripped in line' lineno':' arg(1)'.'
1120    length = charout(,'   (')
1121 return
1122
1123
1124 notify:
1125    parse arg word .
1126    written = written + length(word) + 2
1127    if written>75 then do
1128       written = length(word)
1129       say ' '
1130    end
1131    call charout , word || ', '
1132    return
1133
1134
1135 error:
1136    say 'Error discovered in function insert()'
1137    return
1138
1139 checkseekpos: Procedure Expose simple sigl
1140    parse arg readchar, readline, writechar, writeline
1141
1142    lineno = sigl
1143    cmd = 'QUERY SEEK READ CHAR'
1144    ret = stream( simple, 'c', cmd ); correct = readchar
1145    if ret \= correct then
1146       call complain "STREAM( fn,'C','"cmd"') returns the wrong value got:" ret 'instead of:' correct, lineno
1147
1148    cmd = 'QUERY SEEK READ LINE'
1149    ret = stream( simple, 'c', cmd ); correct = readline
1150    if ret \= correct then
1151       call complain "STREAM(fn,'C','"cmd"') returns the wrong value got:" ret 'instead of:' correct, lineno
1152
1153    cmd = 'QUERY SEEK WRITE CHAR'
1154    ret = stream( simple, 'c', cmd ); correct = writechar
1155    if ret \= correct then
1156       call complain "STREAM(fn,'C','"cmd"') returns the wrong value got:" ret 'instead of:' correct, lineno
1157
1158    cmd = 'QUERY SEEK WRITE LINE'
1159    ret = stream( simple, 'c', cmd ); correct = writeline
1160    if ret \= correct then
1161       call complain "STREAM(fn,'C','"cmd"') returns the wrong value got:" ret 'instead of:' correct, lineno
1162
1163    return