test_read_file.f

   1 ( -*- text -*-
   2         Test READ-FILE.
   3         $Id: test_read_file.f,v 1.2 2007-10-22 18:53:13 rich Exp $
   4 )
   5
   6 0 VALUE FD
   7 100 CELLS ALLOT CONSTANT BUFFER
   8
   9 : TEST
  10         S" test_read_file.f.out" R/O OPEN-FILE
  11         ?DUP IF S" test_read_file.f.out" PERROR QUIT THEN
  12
  13         TO FD
  14
  15         BEGIN
  16                 BUFFER 100 CELLS FD READ-FILE
  17                 ?DUP IF S" READ-FILE" PERROR QUIT THEN
  18                 DUP
  19                 BUFFER SWAP TELL
  20         0= UNTIL
  21
  22         FD CLOSE-FILE
  23         ?DUP IF S" CLOSE-FILE" PERROR QUIT THEN
  24 ;