srfi-6.test 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101
  1. ;;;; srfi-6.test --- test suite for SRFI-6 -*- scheme -*-
  2. ;;;;
  3. ;;;; Copyright (C) 2003, 2006, 2012 Free Software Foundation, Inc.
  4. ;;;;
  5. ;;;; This library is free software; you can redistribute it and/or
  6. ;;;; modify it under the terms of the GNU Lesser General Public
  7. ;;;; License as published by the Free Software Foundation; either
  8. ;;;; version 3 of the License, or (at your option) any later version.
  9. ;;;;
  10. ;;;; This library 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 GNU
  13. ;;;; Lesser General Public License for more details.
  14. ;;;;
  15. ;;;; You should have received a copy of the GNU Lesser General Public
  16. ;;;; License along with this library; if not, write to the Free Software
  17. ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18. (use-modules (test-suite lib))
  19. ;; use #:select to see that the bindings we expect are indeed exported
  20. (use-modules ((srfi srfi-6)
  21. #:select ((open-input-string . open-input-string)
  22. (open-output-string . open-output-string)
  23. (get-output-string . get-output-string))))
  24. (with-test-prefix "open-input-string"
  25. (pass-if "eof on empty"
  26. (let ((port (open-input-string "")))
  27. (eof-object? (read-char port))))
  28. (pass-if "read-char"
  29. (let ((port (open-input-string "xyz")))
  30. (and (char=? #\x (read-char port))
  31. (char=? #\y (read-char port))
  32. (char=? #\z (read-char port))
  33. (eof-object? (read-char port)))))
  34. (pass-if "read-char, Unicode"
  35. ;; String ports should always be Unicode-capable.
  36. ;; See <http://bugs.gnu.org/11197>.
  37. (with-fluids ((%default-port-encoding "ISO-8859-1"))
  38. (let ((port (open-input-string "λμ")))
  39. (and (char=? #\λ (read-char port))
  40. (char=? #\μ (read-char port))))))
  41. (with-test-prefix "unread-char"
  42. (pass-if "one char"
  43. (let ((port (open-input-string "")))
  44. (unread-char #\x port)
  45. (and (char=? #\x (read-char port))
  46. (eof-object? (read-char port)))))
  47. (pass-if "after eof"
  48. (let ((port (open-input-string "")))
  49. (and (eof-object? (read-char port))
  50. (begin
  51. (unread-char #\x port)
  52. (and (char=? #\x (read-char port))
  53. (eof-object? (read-char port)))))))
  54. (pass-if "order"
  55. (let ((port (open-input-string "")))
  56. (unread-char #\x port)
  57. (unread-char #\y port)
  58. (unread-char #\z port)
  59. (and (char=? #\z (read-char port))
  60. (char=? #\y (read-char port))
  61. (char=? #\x (read-char port))
  62. (eof-object? (read-char port)))))))
  63. (with-test-prefix "open-output-string"
  64. (pass-if "empty"
  65. (let ((port (open-output-string)))
  66. (string=? "" (get-output-string port))))
  67. (pass-if "xyz"
  68. (let ((port (open-output-string)))
  69. (display "xyz" port)
  70. (string=? "xyz" (get-output-string port))))
  71. (pass-if "λ"
  72. ;; Writing to an output string should always work.
  73. ;; See <http://bugs.gnu.org/11197>.
  74. (with-fluids ((%default-port-encoding "ISO-8859-1"))
  75. (let ((port (open-output-string)))
  76. (display "λ" port)
  77. (string=? "λ" (get-output-string port)))))
  78. (pass-if "seek"
  79. (let ((port (open-output-string)))
  80. (display "abcdef" port)
  81. (seek port 2 SEEK_SET)
  82. (display "--" port)
  83. (string=? "ab--ef" (get-output-string port)))))