1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2% Tests for I/O predicates
    3
    4%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    5
    6
    7%
    8% List of test suites
    9%
   10
   11test_suites([test_open_close, test_read_1, test_read_2, test_write_1,
   12             test_write_2, test_nl_1, test_nl_2, test_get_char_1,
   13             test_get_char_2, test_put_char_1, test_put_char_2]).
   14
   15
   16%
   17% open/3 and close/1 tests
   18% - ISO -
   19%
   20
   21% These tests have been created manually because the 2nd draft of the
   22% ISO Prolog Standard have very few examples for these predicates
   23
   24test_open_close_1 :- tmp_file('test', File),
   25                     tell(File), told,
   26                     open(File, read, Stream),
   27                     close(Stream),
   28                     delete_file(File).
   29test_open_close_2 :- tmp_file('test', File),
   30                     open(File, write, Stream),
   31                     close(Stream),
   32                     delete_file(File).
   33test_open_close_3(Term) :- tmp_file('test', File),
   34                           open(File, write, StreamW),
   35                           write(StreamW, 'sample.'),
   36                           close(StreamW),
   37                           open(File, read, StreamR),
   38                           read(StreamR, Term),
   39                           close(StreamR),
   40                           delete_file(File).
   41test_open_close_4 :- open('file', unknown, Stream).
   42test_open_close_5 :- open('non-existent', read, Stream).
   43
   44throws_exception(test_open_close_4).
   45throws_exception(test_open_close_5).
   46
   47
   48%
   49% read/1 tests
   50% - ISO -
   51%
   52
   53% Note that these tests have additional code in order to create
   54% and use temporary files
   55
   56test_read_1_1(T) :- create_temp_file('term1. term2.', File),
   57                    see(File),
   58                    read(T),
   59                    seen,
   60                    delete_file(File).
   61test_read_1_2 :- create_temp_file('term1. term2.', File),
   62                 see(File),
   63                 read(term1),
   64                 seen,
   65                 delete_file(File).
   66test_read_1_3(T) :- create_temp_file('3.1. term2.', File),
   67                    see(File),
   68                    read(T),
   69                    seen,
   70                    delete_file(File).
   71test_read_1_4 :- create_temp_file('3.1. term2.', File),
   72                 see(File),
   73                 (
   74                    read(4.1),
   75                    seen,
   76                    delete_file(File)
   77                 ;
   78                    seen,
   79                    delete_file(File),
   80                    fail
   81                 ).
   82test_read_1_5(T) :- create_temp_file('foo 123. term2.', File),
   83                    see(File),
   84                    catch(
   85                          (read(T)),
   86                          Error,
   87                          (seen, delete_file(File), throw(Error))
   88                    ),
   89                    seen,
   90                    delete_file(File).
   91test_read_1_6(T) :- create_temp_file('3.1', File),
   92                    see(File),
   93                    catch(
   94                          (read(T)),
   95                          Error,
   96                          (seen, delete_file(File), throw(Error))
   97                    ),
   98                    seen,
   99                    delete_file(File).
  100
  101throws_exception(test_read_1_5).
  102throws_exception(test_read_1_6).
  103
  104
  105%
  106% read/2 tests
  107% - ISO -
  108%
  109
  110% There're no examples for this predicate in the 2nd draft of ISO Prolog
  111% Standard; the following tests have been created from the read/1 examples
  112
  113test_read_2_1(T) :- create_temp_file('term1. term2.', File),
  114                    open(File, read, Stream),
  115                    read(Stream, T),
  116                    close(Stream),
  117                    delete_file(File).
  118test_read_2_2 :- create_temp_file('term1. term2.', File),
  119                 open(File, read, Stream),
  120                 read(Stream, term1),
  121                 close(Stream),
  122                 delete_file(File).
  123test_read_2_3(T) :- create_temp_file('3.1. term2.', File),
  124                    open(File, read, Stream),
  125                    read(Stream, T),
  126                    close(Stream),
  127                    delete_file(File).
  128test_read_2_4 :- create_temp_file('3.1. term2.', File),
  129                 open(File, read, Stream),
  130                 (
  131                    read(Stream, 4.1),
  132                    close(Stream),
  133                    delete_file(File)
  134                 ;
  135                    close(Stream),
  136                    delete_file(File),
  137                    fail
  138                 ).
  139test_read_2_5(T) :- create_temp_file('foo 123. term2.', File),
  140                    open(File, read, Stream),
  141                    catch(
  142                          (read(Stream, T)),
  143                          Error,
  144                          (close(Stream), delete_file(File), throw(Error))
  145                    ),
  146                    close(Stream),
  147                    delete_file(File).
  148test_read_2_6(T) :- create_temp_file('3.1', File),
  149                    open(File, read, Stream),
  150                    catch(
  151                          (read(Stream, T)),
  152                          Error,
  153                          (close(Stream), delete_file(File), throw(Error))
  154                    ),
  155                    close(Stream),
  156                    delete_file(File).
  157
  158throws_exception(test_read_2_5).
  159throws_exception(test_read_2_6).
  160
  161
  162%
  163% write/1 tests
  164% - ISO -
  165%
  166
  167% There're no examples for this predicate in the 2nd draft of ISO Prolog
  168% Standard; the following tests have been created from the write/2 examples
  169
  170test_write_1_1 :- write([1, 2, 3]).
  171test_write_1_2 :- write(1 < 2).
  172test_write_1_3 :- write('1<2').
  173test_write_1_4 :- write('$VAR'(0) < '$VAR'(1)).
  174
  175
  176%
  177% write/2 tests
  178% - ISO -
  179%
  180
  181% Note that these tests have additional code in order to create and
  182% use temporary files, and verify the behavior of the write/2 predicate
  183
  184test_write_2_1(Codes) :- tmp_file('test', File),
  185                         open(File, write, Stream),
  186                         write(Stream, [1, 2, 3]),
  187                         close(Stream),
  188                         read_file_to_codes(File, Codes, []),
  189                         delete_file(File).
  190test_write_2_2(Codes) :- tmp_file('test', File),
  191                         open(File, write, Stream),
  192                         write(Stream, 1 < 2),
  193                         close(Stream),
  194                         read_file_to_codes(File, Codes, []),
  195                         delete_file(File).
  196test_write_2_3(Codes) :- tmp_file('test', File),
  197                         open(File, write, Stream),
  198                         write(Stream, '1<2'),
  199                         close(Stream),
  200                         read_file_to_codes(File, Codes, []),
  201                         delete_file(File).
  202test_write_2_4(Codes) :- tmp_file('test', File),
  203                         open(File, write, Stream),
  204                         write(Stream, '$VAR'(0) < '$VAR'(1)),
  205                         close(Stream),
  206                         read_file_to_codes(File, Codes, []),
  207                         delete_file(File).
  208
  209
  210%
  211% nl/0 tests
  212% - ISO -
  213%
  214
  215test_nl_1_1 :- nl, put_char(a).
  216
  217
  218%
  219% nl/1 tests
  220% - ISO -
  221%
  222
  223% Note that these tests have additional code in order to create and
  224% use temporary files, and verify the behavior of the nl/1 predicate
  225
  226test_nl_2_1(Codes) :- tmp_file('test', File),
  227                      open(File, write, Stream),
  228                      nl(Stream), put_char(Stream, a),
  229                      close(Stream),
  230                      read_file_to_codes(File, Codes, []),
  231                      delete_file(File).
  232test_nl_2_2(Str) :- nl(Str).
  233test_nl_2_3 :- nl([my_file]).
  234
  235throws_exception(test_nl_2_2).
  236throws_exception(test_nl_2_3).
  237
  238
  239%
  240% get_char/1 tests
  241% - ISO -
  242%
  243
  244% Note that these tests have additional code in order to create
  245% and use temporary files
  246
  247test_get_char_1_1(Char) :- create_temp_file('qwerty', File),
  248                           see(File),
  249                           get_char(Char),
  250                           seen,
  251                           delete_file(File).
  252
  253
  254%
  255% get_char/2 tests
  256% - ISO -
  257%
  258
  259% Note that these tests have additional code in order to create
  260% and use temporary files
  261
  262test_get_char_2_1(Char) :- create_temp_file('qwerty', File),
  263                           open(File, read, Stream),
  264                           get_char(Stream, Char),
  265                           close(Stream),
  266                           delete_file(File).
  267test_get_char_2_2(Char) :- create_temp_file('\'qwerty\'', File),
  268                           open(File, read, Stream),
  269                           get_char(Stream, Char),
  270                           close(Stream),
  271                           delete_file(File).
  272test_get_char_2_3 :- create_temp_file('\13\10\newline', File),
  273                     open(File, read, Stream),
  274                     get_char(Stream, '\13\'),
  275                     close(Stream),
  276                     delete_file(File).
  277test_get_char_2_4(Char) :- create_temp_file('', File),
  278                           open(File, read, Stream),
  279                           get_char(Stream, Char),
  280                           close(Stream),
  281                           delete_file(File).
  282test_get_char_2_5(X) :- get_char(user_output, X).
  283test_get_char_2_6 :- create_temp_file('qwerty', File),
  284                     open(File, read, Stream),
  285                     (
  286                        get_char(Stream, p),
  287                        close(Stream),
  288                        delete_file(File)
  289                     ;
  290                        close(Stream),
  291                        delete_file(File),
  292                        fail
  293                     ).
  294
  295throws_exception(test_get_char_2_5).
  296
  297
  298%
  299% put_char/1 tests
  300% - ISO -
  301%
  302
  303test_put_char_1_1 :- put_char(t).
  304
  305
  306%
  307% put_char/2 tests
  308% - ISO -
  309%
  310
  311% Note that these tests have additional code in order to create and use
  312% temporary files, and verify the behavior of the put_char/2 predicate 
  313
  314test_put_char_2_1(Codes) :- tmp_file('test', File),
  315                            open(File, write, Stream),
  316                            put_char(Stream, t),
  317                            close(Stream),
  318                            read_file_to_codes(File, Codes, []),
  319                            delete_file(File).
  320test_put_char_2_2(C) :- put_char(my_file, C).
  321test_put_char_2_3(Stream, C) :- put_char(Stream, C).
  322test_put_char_2_4(Codes) :- tmp_file('test', File),
  323                            open(File, write, Stream),
  324                            put_char(Stream, 'A'),
  325                            close(Stream),
  326                            read_file_to_codes(File, Codes, []),
  327                            delete_file(File).
  328
  329throws_exception(test_put_char_2_2).
  330throws_exception(test_put_char_2_3).
  331
  332
  333%
  334% Helper predicates
  335%
  336
  337create_temp_file(Text, File) :- tmp_file('test', File),
  338                                open(File, write, Stream),
  339                                write(Stream, Text),
  340                                close(Stream)