srcprop.test 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134
  1. ;;;; srcprop.test --- test Guile source properties -*- scheme -*-
  2. ;;;;
  3. ;;;; Copyright (C) 2003, 2006, 2009 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. (define-module (test-suite test-srcprop)
  19. :use-module (test-suite lib))
  20. ;;;
  21. ;;; source-properties
  22. ;;;
  23. (with-test-prefix "source-properties"
  24. (pass-if "no props"
  25. (null? (source-properties (list 1 2 3))))
  26. (read-enable 'positions)
  27. (with-test-prefix "read properties"
  28. (define (reads-with-srcprops? str)
  29. (let ((x (read (open-input-string str))))
  30. (not (null? (source-properties x)))))
  31. (pass-if "pairs" (reads-with-srcprops? "(1 . 2)"))
  32. (pass-if "vectors" (reads-with-srcprops? "#(1 2 3)"))
  33. (pass-if "bytevectors" (reads-with-srcprops? "#vu8(1 2 3)"))
  34. (pass-if "bitvectors" (reads-with-srcprops? "#*101011"))
  35. (pass-if "srfi4 vectors" (reads-with-srcprops? "#f64(3.1415 2.71)"))
  36. (pass-if "arrays" (reads-with-srcprops? "#2u32@2@3((1 2) (2 3))"))
  37. (pass-if "strings" (reads-with-srcprops? "\"hello\""))
  38. (pass-if "null string" (reads-with-srcprops? "\"\""))
  39. (pass-if "floats" (reads-with-srcprops? "3.1415"))
  40. (pass-if "fractions" (reads-with-srcprops? "1/2"))
  41. (pass-if "complex numbers" (reads-with-srcprops? "1+1i"))
  42. (pass-if "bignums"
  43. (and (reads-with-srcprops? (number->string (1+ most-positive-fixnum)))
  44. (reads-with-srcprops? (number->string (1- most-negative-fixnum)))))
  45. (pass-if "fixnums (should have none)"
  46. (not (or (reads-with-srcprops? "0")
  47. (reads-with-srcprops? "1")
  48. (reads-with-srcprops? "-1")
  49. (reads-with-srcprops? (number->string most-positive-fixnum))
  50. (reads-with-srcprops? (number->string most-negative-fixnum)))))
  51. (pass-if "symbols (should have none)"
  52. (not (reads-with-srcprops? "foo")))
  53. (pass-if "keywords (should have none)"
  54. (not (reads-with-srcprops? "#:foo")))
  55. (pass-if "characters (should have none)"
  56. (not (reads-with-srcprops? "#\\c")))
  57. (pass-if "booleans (should have none)"
  58. (not (or (reads-with-srcprops? "#t")
  59. (reads-with-srcprops? "#f"))))))
  60. ;;;
  61. ;;; set-source-property!
  62. ;;;
  63. (with-test-prefix "set-source-property!"
  64. (read-enable 'positions)
  65. (pass-if "setting the breakpoint property works"
  66. (let ((s (read (open-input-string "(+ 3 4)"))))
  67. (throw 'unresolved)
  68. (set-source-property! s 'breakpoint #t)
  69. (let ((current-trap-opts (evaluator-traps-interface))
  70. (current-debug-opts (debug-options-interface))
  71. (trap-called #f))
  72. (trap-set! enter-frame-handler (lambda _ (set! trap-called #t)))
  73. (trap-enable 'traps)
  74. (debug-enable 'debug)
  75. (debug-enable 'breakpoints)
  76. (with-traps (lambda ()
  77. (primitive-eval s)))
  78. (evaluator-traps-interface current-trap-opts)
  79. (debug-options-interface current-debug-opts)
  80. trap-called))))
  81. ;;;
  82. ;;; set-source-properties!
  83. ;;;
  84. (with-test-prefix "set-source-properties!"
  85. (read-enable 'positions)
  86. (pass-if "setting the breakpoint property works"
  87. (let ((s (read (open-input-string "(+ 3 4)"))))
  88. (throw 'unresolved)
  89. (set-source-properties! s '((breakpoint #t)))
  90. (let ((current-trap-opts (evaluator-traps-interface))
  91. (current-debug-opts (debug-options-interface))
  92. (trap-called #f))
  93. (trap-set! enter-frame-handler (lambda _ (set! trap-called #t)))
  94. (trap-enable 'traps)
  95. (debug-enable 'debug)
  96. (debug-enable 'breakpoints)
  97. (with-traps (lambda ()
  98. (primitive-eval s)))
  99. (evaluator-traps-interface current-trap-opts)
  100. (debug-options-interface current-debug-opts)
  101. trap-called)))
  102. (let ((s (read (open-input-string "(1 . 2)"))))
  103. (with-test-prefix "copied props"
  104. (pass-if "visible to source-property"
  105. (let ((t (cons 3 4)))
  106. (set-source-properties! t (source-properties s))
  107. (number? (source-property t 'line))))
  108. (pass-if "visible to source-properties"
  109. (let ((t (cons 3 4)))
  110. (set-source-properties! t (source-properties s))
  111. (not (null? (source-properties t))))))))