PLaneT Package Repository : Home > clements > libxml2.plt

Home > clements > libxml2.plt > package version 1.0
tests.ss
#lang scheme

(require "main.ss"
         (planet schematics/schemeunit:3))

(define tf (make-temporary-file))

(define (write-and-read-test-file str #:spec [spec-bytes #f])
  (display-to-file #:exists 'truncate str tf)
  (xml->sxml/file tf))

;; copied from w3schools.org (IIRC)
(define test1
  #<<|
<?xml version="1.0" encoding="ISO-8859-1"?>
<!-- Edited by XMLSpy® -->
<note>
 <to>Tove</to>
 <from>Jani</from>
 <heading>Reminder</heading>
 <body>Don't forget me this weekend!</body>
</note>
|
  )

(check-equal?
 (xml->sxml/bytes (string->bytes/utf-8 test1))
 '(*TOP* (note "\n " (to "Tove") "\n " (from "Jani") "\n " (heading "Reminder") "\n " (body "Don't forget me this weekend!") "\n")))

(check-equal?
 (write-and-read-test-file test1)
 '(*TOP* (note "\n " (to "Tove") "\n " (from "Jani") "\n " (heading "Reminder") "\n " (body "Don't forget me this weekend!") "\n")))

;; copied from my gnucash file:
(define test2 
  #<<|
<?xml version="1.0" encoding="utf-8" ?>
<gnc-v2
     xmlns:gnc="http://www.gnucash.org/XML/gnc"
     xmlns:act="http://www.gnucash.org/XML/act"
     xmlns:book="http://www.gnucash.org/XML/book"
     xmlns:cd="http://www.gnucash.org/XML/cd"
     xmlns:cmdty="http://www.gnucash.org/XML/cmdty"
     xmlns:price="http://www.gnucash.org/XML/price">
<gnc:count-data cd:type="book">1</gnc:count-data>
<gnc:book version="2.0.0">
<book:id type="guid">0f02a5e69d1c76a6af8d20872dc44b09</book:id>
<gnc:count-data cd:type="commodity">110</gnc:count-data>
<gnc:count-data cd:type="account">516</gnc:count-data>
<gnc:count-data cd:type="transaction">18699</gnc:count-data>
<gnc:commodity version="2.0.0">
  <cmdty:space>AMEX</cmdty:space>
  <cmdty:id>DD</cmdty:id>
  <cmdty:name>Du Pont</cmdty:name>
  <cmdty:fraction>10000</cmdty:fraction>
  <cmdty:get_quotes/>
  <cmdty:quote_source>yahoo</cmdty:quote_source>
  <cmdty:quote_tz/>
</gnc:commodity>
</gnc:book>
</gnc-v2>
|
  )

(define test2-result
  '(*TOP*
    (gnc-v2
     "\n"
     (http://www.gnucash.org/XML/gnc:count-data (@ (http://www.gnucash.org/XML/cd:type "book")) "1")
     "\n"
     (http://www.gnucash.org/XML/gnc:book
      (@ (version "2.0.0"))
      "\n"
      (http://www.gnucash.org/XML/book:id (@ (type "guid")) "0f02a5e69d1c76a6af8d20872dc44b09")
      "\n"
      (http://www.gnucash.org/XML/gnc:count-data (@ (http://www.gnucash.org/XML/cd:type "commodity")) "110")
      "\n"
      (http://www.gnucash.org/XML/gnc:count-data (@ (http://www.gnucash.org/XML/cd:type "account")) "516")
      "\n"
      (http://www.gnucash.org/XML/gnc:count-data (@ (http://www.gnucash.org/XML/cd:type "transaction")) "18699")
      "\n"
      (http://www.gnucash.org/XML/gnc:commodity
       (@ (version "2.0.0"))
       "\n  "
       (http://www.gnucash.org/XML/cmdty:space "AMEX")
       "\n  "
       (http://www.gnucash.org/XML/cmdty:id "DD")
       "\n  "
       (http://www.gnucash.org/XML/cmdty:name "Du Pont")
       "\n  "
       (http://www.gnucash.org/XML/cmdty:fraction "10000")
       "\n  "
       (http://www.gnucash.org/XML/cmdty:get_quotes)
       "\n  "
       (http://www.gnucash.org/XML/cmdty:quote_source "yahoo")
       "\n  "
       (http://www.gnucash.org/XML/cmdty:quote_tz)
       "\n")
      "\n")
     "\n")))


;; this is out-and-out regression testing:
(check-equal?
 (write-and-read-test-file test2)
 test2-result)

(check-equal?
 (xml->sxml/bytes (string->bytes/utf-8 test2))
 test2-result)



;; test of Relax NG checking:

(define specification
  #<<|
<?xml version="1.0" encoding="UTF-8"?>
<element name="TARGETDECK" xmlns="http://relaxng.org/ns/structure/1.0">
  <zeroOrMore>
    <element name="TARGET">
      <optional>
        <attribute name="name"/>
      </optional>
      <element name="POSITION">
        <value/>
      </element>
    </element>
  </zeroOrMore>
</element>
|
  )

(define vc (bytes->validation-context (string->bytes/utf-8 specification)))

(define test3
  #<<|
<TARGETDECK><TARGET><POSITION /></TARGET><TARGET>
  <POSITION></POSITION></TARGET></TARGETDECK>
|
  )

(check-equal? 
 (xml->sxml/bytes (string->bytes/utf-8 test3)
                  #:valid vc)
 '(*TOP* (TARGETDECK (TARGET (POSITION)) (TARGET  "\n  " (POSITION)))))


;; one target is missing its position
(define test4
  #<<|
<TARGETDECK><TARGET><POSITION /></TARGET><TARGET>
  </TARGET></TARGETDECK>
|
  )

(check-exn exn:fail?
           (lambda ()
             (xml->sxml/bytes (string->bytes/utf-8 test4)
                              #:valid vc)))

(check-equal? (validation-context? vc) #t)
(check-equal? (validation-context? 1234) #f)



#;(check-equal?
 (write-and-read-test-file-with-spec specification test3))

(delete-file tf)