Constant Story "ExternalFile"; Constant Headline "Not a game.^"; Release 8; Global mainwin = 0; Constant BUFLEN = 80; Array buffer -> BUFLEN+4; Array buffer2 -> BUFLEN+4; Array gg_result --> 2; Global errorcount = 0; Constant HDR_GLULXVERSION $04; ! long word Constant ROM_GAMERELEASE $34; ! short word Constant ROM_GAMESERIAL $36; ! six ASCII characters [ Main; @setiosys 2 0; ! select Glk I/O system mainwin = glk($0023, 0, 0, 0, 3, 0); ! glk_window_open glk($002F, mainwin); ! glk_set_window new_line; Banner(); new_line; RoomDesc(); RunReadWriteFuncTest(); RunTerminalNullTest(); RunOpenModeTest(); print "This test should have created a set of files, named ~testfile1.glkdata~ to ~testfile15.glkdata~. (The file suffixes might be different, but ~.glkdata~ is recommended by the current Glk spec.) These files should be identical -- each 26 bytes long, containing the string ~Purple monkey dishwasher.~ followed by a Unix newline (ctrl-J).^^"; RunInvalidCharacterTest(); if (errorcount) print "^", errorcount, " tests failed.^"; else print "^All tests passed.^"; ]; [ Banner i ix; if (Story ~= 0) { glk($0086, 3); ! set header style print (string) Story; glk($0086, 0); ! set normal style } if (Headline ~= 0) print ": ", (string) Headline; print "Release "; @aloads ROM_GAMERELEASE 0 i; print i; print " / Serial number "; for (i=0 : i<6 : i++) print (char) ROM_GAMESERIAL->i; print " / Inform v"; inversion; print ", compiler options "; i = false; #Ifdef STRICT_MODE; print "S"; i++; #Endif; ! STRICT_MODE #Ifdef INFIX; print "X"; i++; #Ifnot; #Ifdef DEBUG; print "D"; i++; #Endif; ! DEBUG #Endif; ! INFIX if (~~i) print "(none)"; new_line; @gestalt 1 0 ix; print "Interpreter version ", ix / $10000, ".", (ix & $FF00) / $100, ".", ix & $FF, " / "; @gestalt 0 0 ix; print "VM ", ix / $10000, ".", (ix & $FF00) / $100, ".", ix & $FF, " / "; ix = HDR_GLULXVERSION-->0; print "game file format ", ix / $10000, ".", (ix & $FF00) / $100, ".", ix & $FF, "^"; ]; [ RoomDesc; print "A voice booooms out: Welcome to the test chamber.^^"; ]; [ make_fref name len fref; len = name.print_to_array(buffer, BUFLEN); buffer->3 = $E0; buffer->(4+len) = 0; fref = glk($0061, 0, buffer+3, 0); ! fileref_create_by_name ! (This is a type-data, binary file.) if (~~fref) { print "Unable to create fileref: ", name, "^"; quit; } return fref; ]; [ delete_if_exists fref name val; val = glk($0067, fref); ! fileref_does_file_exist if (val) { print "(Deleting existing file: ", (string) name, ")^"; glk($0066, fref); ! fileref_delete_file } ]; [ open_file fref name mode str; str = glk($0042, fref, mode, 0); ! stream_open_file if (~~str) { print "Unable to open stream: ", (string) name, "^"; quit; } return str; ]; [ open_file_uni fref name mode str; str = glk($0138, fref, mode, 0); ! stream_open_file_uni if (~~str) { print "Unable to open stream: ", (string) name, "^"; quit; } return str; ]; [ write_stream str val len; len = val.print_to_array(buffer, BUFLEN); glk($0085, str, buffer+4, len); ! put_buffer_stream ]; [ write_cstring_stream str val len; len = val.print_to_array(buffer, BUFLEN); buffer->3 = $E0; buffer->(4+len) = 0; glk($0083, str, buffer+3); ! put_string_stream ]; [ write_chars_stream str val len ix; len = val.print_to_array(buffer, BUFLEN); for (ix=0 : ix(4+ix)); ! put_char_stream } ]; [ write_unichars_stream str val len ix ch; len = val.print_to_array(buffer, BUFLEN); for (ix=0 : ix(4+ix)) & $FF; glk($0012B, str, ch); ! put_char_stream_uni } ]; [ write_unibuf_stream str val len ix ch; len = val.print_to_array(buffer, BUFLEN); for (ix=0 : ix(4+ix)) & $FF; buffer2->(4*ix+0) = 0; buffer2->(4*ix+1) = 0; buffer2->(4*ix+2) = 0; buffer2->(4*ix+3) = ch; } glk($012D, str, buffer2, len); ! put_buffer_stream_uni ]; [ write_unistring_stream str val len ix ch; len = val.print_to_array(buffer, BUFLEN); buffer2->0 = $E2; buffer2->1 = $0; buffer2->2 = $0; buffer2->3 = $0; for (ix=0 : ix(4+ix)) & $FF; buffer2->(4+4*ix+0) = 0; buffer2->(4+4*ix+1) = 0; buffer2->(4+4*ix+2) = 0; buffer2->(4+4*ix+3) = ch; } buffer2->(4+4*len+0) = 0; buffer2->(4+4*len+1) = 0; buffer2->(4+4*len+2) = 0; buffer2->(4+4*len+3) = 0; glk($012C, str, buffer2); ! put_string_stream_uni ]; [ compare_string buf blen val len ix; len = val.print_to_array(buffer2, BUFLEN); if (len ~= blen) { print "ERROR: String does not match -- wrong length: ", len, ", not ", blen, "^"; errorcount++; return; } for (ix=0 : ixix ~= buffer2->(4+ix)) { print "ERROR: String does not match -- character ", ix, " is ", (char) buf->ix, ", not ", (char) buffer2->(4+ix), "^"; errorcount++; return; } } ]; [ check_result label val target; if (val ~= target) { print "ERROR: ", (string) label, " was wrong: ", val, ", not ", target, "^"; errorcount++; } ]; [ check_result_counts readcount writecount; if (gg_result-->0 ~= readcount) { print "ERROR: Read count was wrong: ", gg_result-->0, ", not ", readcount, "^"; errorcount++; } if (gg_result-->1 ~= writecount) { print "ERROR: Read count was wrong: ", gg_result-->1, ", not ", writecount, "^"; errorcount++; } ]; Constant filemode_Write = 1; Constant filemode_Read = 2; Constant filemode_ReadWrite = 3; Constant filemode_WriteAppend = 5; [ RunReadWriteFuncTest name fref str len ch cx ix jx kx; print "* RunReadWriteFuncTest^"; name = "testfile0"; fref = make_fref(name); delete_if_exists(fref, name); for (ix=0 : ix<2 : ix++) { ! byte or unicode file if (ix == 0) print "byte file"; else print "unicode file"; print ", "; for (jx=0 : jx<6 : jx++) { ! pick a write function switch (jx) { 0: print "put_char"; 1: print "put_buffer"; 2: print "put_string"; 3: print "put_char_uni"; 4: print "put_buffer_uni"; 5: print "put_string_uni"; } print ", "; for (kx=0 : kx<6 : kx++) { ! pick a read function switch (kx) { 0: print "get_char"; 1: print "get_buffer"; 2: print "get_line"; 3: print "get_char_uni"; 4: print "get_buffer_uni"; 5: print "get_line_uni"; } print ": "; if (ix == 0) str = open_file(fref, name, filemode_Write); else str = open_file_uni(fref, name, filemode_Write); switch (jx) { 0: write_chars_stream(str, "Zapp@:olicious.^"); 1: write_stream(str, "Zapp@:olicious.^"); 2: write_cstring_stream(str, "Zapp@:olicious.^"); 3: write_unichars_stream(str, "Zapp@:olicious.^"); 4: write_unibuf_stream(str, "Zapp@:olicious.^"); 5: write_unistring_stream(str, "Zapp@:olicious.^"); } glk($0044, str, gg_result); ! stream_close check_result_counts(0, 14); if (ix == 0) str = open_file(fref, name, filemode_Read); else str = open_file_uni(fref, name, filemode_Read); switch (kx) { 0: len = 0; while (1) { ch = glk($0090, str); ! get_char_stream if (ch == -1) break; buffer->len = ch; len++; } 1: len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream 2: len = glk($0091, str, buffer, BUFLEN); ! get_line_stream 3: len = 0; while (1) { ch = glk($0130, str); ! get_char_stream_uni if (ch == -1) break; buffer->len = ch; len++; } 4: len = glk($0131, str, buffer2, BUFLEN/4); ! get_buffer_stream_uni for (cx=0 : cxcx = (buffer2+0)-->cx; } 5: len = glk($0132, str, buffer2, BUFLEN/4); ! get_line_stream_uni for (cx=0 : cxcx = (buffer2+0)-->cx; } } compare_string(buffer, len, "Zapp@:olicious.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(14, 0); print "read.^"; glk($0066, fref); ! fileref_delete_file } } } ]; [ RunTerminalNullTest name fref str len ix jx; print "* RunTerminalNullTest^"; name = "testfile0"; fref = make_fref(name); delete_if_exists(fref, name); for (ix=0 : ix<2 : ix++) { ! byte or unicode file if (ix == 0) print "byte file"; else print "unicode file"; print ", "; if (ix == 0) str = open_file(fref, name, filemode_Write); else str = open_file_uni(fref, name, filemode_Write); write_chars_stream(str, "01234567"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 8); if (ix == 0) str = open_file(fref, name, filemode_Read); else str = open_file_uni(fref, name, filemode_Read); for (jx=0 : jx<12 : jx++) buffer->jx = '#'; len = glk($0091, str, buffer, BUFLEN); ! get_line_stream compare_string(buffer, len, "01234567"); if (buffer->8 ~= 0) { print "ERROR: no terminal null^"; errorcount++; } glk($0044, str, gg_result); ! stream_close check_result_counts(8, 0); print "char read.^"; if (ix == 0) str = open_file(fref, name, filemode_Read); else str = open_file_uni(fref, name, filemode_Read); for (jx=0 : jx<12 : jx++) (buffer2+0)-->jx = '#'; len = glk($0132, str, buffer2, BUFLEN/4); ! get_line_stream_uni if ((buffer2+0)-->8 ~= 0) { print "ERROR: no terminal null^"; errorcount++; } glk($0044, str, gg_result); ! stream_close check_result_counts(8, 0); print "uni read.^"; glk($0066, fref); ! fileref_delete_file } ]; [ RunOpenModeTest name fref str len pos; print "* RunOpenModeTest^"; ! Write once, close, then read. name = "testfile1"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_Write); write_stream(str, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 26); str = open_file(fref, name, filemode_Read); len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 0); ! Write, reopen, write, then read. name = "testfile2"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_Write); write_stream(str, "Obsequious, purple, and clairvoyant.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 37); str = open_file(fref, name, filemode_Write); write_stream(str, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 26); str = open_file(fref, name, filemode_Read); len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 0); ! Write, seek to beginning, write, then close and read. name = "testfile3"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_Write); write_stream(str, "Orange gerbil dishwasher.^"); glk($0045, str, 0, 0); ! stream_set_position write_stream(str, "Purple monkey"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 39); str = open_file(fref, name, filemode_Read); len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 0); ! Write, seek, and read. name = "testfile4"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_ReadWrite); write_stream(str, "Purple monkey dishwasher.^"); glk($0045, str, 0, 0); ! stream_set_position len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 26); ! Write, seek, write, seek, read. name = "testfile5"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_ReadWrite); write_stream(str, "Purple rabbit dishwasher.^"); glk($0045, str, 7, 0); ! stream_set_position write_stream(str, "monkey"); glk($0045, str, 0, 0); ! stream_set_position len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 32); ! Write, close, append, write, close, read. name = "testfile6"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_Write); write_stream(str, "Purple"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 6); str = open_file(fref, name, filemode_WriteAppend); write_stream(str, " monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 20); str = open_file(fref, name, filemode_Read); len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 0); ! Append, seek, write, close, read. name = "testfile7"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_WriteAppend); write_stream(str, "Purple monkey chef.^"); glk($0045, str, 14, 0); ! stream_set_position write_stream(str, "dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 32); str = open_file(fref, name, filemode_Read); len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 0); ! Write, close, seek, write, close, read. name = "testfile8"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_ReadWrite); write_stream(str, "Purple synchroscopes.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 22); str = open_file(fref, name, filemode_ReadWrite); glk($0045, str, 7, 1); ! stream_set_position write_stream(str, "monkey dishwasher.^"); glk($0045, str, 0, 0); ! stream_set_position len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 19); ! Write, close, write, close, read. name = "testfile9"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_ReadWrite); write_stream(str, "Yellow monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 26); str = open_file(fref, name, filemode_ReadWrite); write_stream(str, "Purple"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 6); str = open_file(fref, name, filemode_ReadWrite); len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 0); ! Write, close, read, write, close, read. name = "testfile10"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_ReadWrite); write_stream(str, "Purple synchroscopes.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 22); str = open_file(fref, name, filemode_ReadWrite); len = glk($0092, str, buffer, 7); ! get_buffer_stream compare_string(buffer, len, "Purple "); write_stream(str, "monkey dishwasher.^"); glk($0045, str, 0, 0); ! stream_set_position len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(33, 19); ! Write with stream_string, close, then read. name = "testfile11"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_Write); write_cstring_stream(str, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 26); str = open_file(fref, name, filemode_Read); len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 0); ! Write with stream_char, close, then read. name = "testfile12"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_Write); write_chars_stream(str, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 26); str = open_file(fref, name, filemode_Read); len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 0); ! Write with stream_char_uni, close, then read. name = "testfile13"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_Write); write_unichars_stream(str, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 26); str = open_file(fref, name, filemode_Read); len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 0); ! Write, close, write, read, write, close, read. name = "testfile14"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_ReadWrite); write_stream(str, "!urple synchroscopes.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 22); str = open_file(fref, name, filemode_ReadWrite); glk($0081, str, 'P'); ! put_char_stream len = glk($0092, str, buffer, 6); ! get_buffer_stream compare_string(buffer, len, "urple "); write_stream(str, "monkey dishwasher.^"); glk($0045, str, 0, 0); ! stream_set_position len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(32, 20); ! Write, seek, write, seek, write, seek, write, then close and read. name = "testfile15"; print "Testing: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_Write); pos = glk($0046, str); ! stream_get_position check_result("seek", pos, 0); write_stream(str, "P**ple m**key dishwash**.^"); pos = glk($0046, str); ! stream_get_position check_result("seek", pos, 26); glk($0045, str, 1, 0); ! stream_set_position (start) write_stream(str, "ur"); pos = glk($0046, str); ! stream_get_position check_result("seek", pos, 3); glk($0045, str, 5, 1); ! stream_set_position (current) pos = glk($0046, str); ! stream_get_position check_result("seek", pos, 8); write_stream(str, "on"); pos = glk($0046, str); ! stream_get_position check_result("seek", pos, 10); glk($0045, str, -4, 2); ! stream_set_position (end) pos = glk($0046, str); ! stream_get_position check_result("seek", pos, 22); write_stream(str, "er"); pos = glk($0046, str); ! stream_get_position check_result("seek", pos, 24); glk($0044, str, gg_result); ! stream_close check_result_counts(0, 32); str = open_file(fref, name, filemode_Read); len = glk($0092, str, buffer, BUFLEN); ! get_buffer_stream compare_string(buffer, len, "Purple monkey dishwasher.^"); glk($0044, str, gg_result); ! stream_close check_result_counts(26, 0); if (errorcount) print "^FAILED: ", errorcount, " errors occurred.^^"; else print "^All files created.^^"; ]; [ RunInvalidCharacterTest name name2 fref fref2 str val; print "* RunInvalidCharacterTest^"; name = "testx/@@92<>:~|?*y.fake"; print "Creating: ", (string) name, "^"; fref = make_fref(name); delete_if_exists(fref, name); str = open_file(fref, name, filemode_Write); glk($0044, str, gg_result); ! stream_close name2 = "testxy"; print "Checking: ", (string) name2, "^"; fref2 = make_fref(name2); val = glk($0067, fref2); ! fileref_does_file_exist if (val) { print "File exists, with standard name simplification.^"; } else { print "The file ~", (string) name2, "~ does not exist; ~", (string) name, "~ should have been simplified to that. This is not an error, because this sort of simplification is not a spec requirement. However, it is recommended so that Glk implementations can exchange files more easily.^"; } delete_if_exists(fref, name); ];