newlisp/qa-specific-tests/qa-xml

#!/usr/bin/newlisp

# qa-xml - test newLISP xml-parse, xml-type-tags functions

(unless xml-parse
    (println ">>>>> compiles without XML support")
    (exit)
)

(println)
(println "Testing XML functions")

(set 'example-xml
[text]

<DATABASE name="example.xml">
<!--This is a database of fruits-->
    <FRUIT>
        <NAME>apple</NAME>
        <COLOR>red</COLOR>
        <PRICE>0.80</PRICE>
    </FRUIT>

    <FRUIT>
        <NAME>orange</NAME>
        <COLOR>orange</COLOR>
        <PRICE>1.00</PRICE>
    </FRUIT>

    <FRUIT>
       <NAME>banana</NAME>
       <COLOR>yellow</COLOR>
       <PRICE>0.60</PRICE>
    </FRUIT>
</DATABASE>
[/text])


(set 'result1 '(
  ("ELEMENT" "DATABASE" (("name" "example.xml")) (("TEXT" "\n") (
     "COMMENT" "This is a database of fruits") 
    ("TEXT" "\n    ") 
    ("ELEMENT" "FRUIT" () (("TEXT" "\n        ") ("ELEMENT" "NAME" 
       () 
       (("TEXT" "apple"))) 
      ("TEXT" "\n        ") 
      ("ELEMENT" "COLOR" () (("TEXT" "red"))) 
      ("TEXT" "\n        ") 
      ("ELEMENT" "PRICE" () (("TEXT" "0.80"))) 
      ("TEXT" "\n    "))) 
    ("TEXT" "\n\n    ") 
    ("ELEMENT" "FRUIT" () (("TEXT" "\n        ") ("ELEMENT" "NAME" 
       () 
       (("TEXT" "orange"))) 
      ("TEXT" "\n        ") 
      ("ELEMENT" "COLOR" () (("TEXT" "orange"))) 
      ("TEXT" "\n        ") 
      ("ELEMENT" "PRICE" () (("TEXT" "1.00"))) 
      ("TEXT" "\n    "))) 
    ("TEXT" "\n\n    ") 
    ("ELEMENT" "FRUIT" () (("TEXT" "\n       ") ("ELEMENT" "NAME" 
       () 
       (("TEXT" "banana"))) 
      ("TEXT" "\n       ") 
      ("ELEMENT" "COLOR" () (("TEXT" "yellow"))) 
      ("TEXT" "\n       ") 
      ("ELEMENT" "PRICE" () (("TEXT" "0.60"))) 
      ("TEXT" "\n    "))) 
    ("TEXT" "\n")))))


(set 'result2 '(
  ("ELEMENT" "DATABASE" (("name" "example.xml")) (("ELEMENT" "FRUIT" 
     (("ELEMENT" "NAME" (("TEXT" "apple"))) ("ELEMENT" "COLOR" ((
         "TEXT" "red"))) 
      ("ELEMENT" "PRICE" (("TEXT" "0.80"))))) 
    ("ELEMENT" "FRUIT" (("ELEMENT" "NAME" (("TEXT" "orange"))) ("ELEMENT" 
       "COLOR" 
       (("TEXT" "orange"))) 
      ("ELEMENT" "PRICE" (("TEXT" "1.00"))))) 
    ("ELEMENT" "FRUIT" (("ELEMENT" "NAME" (("TEXT" "banana"))) ("ELEMENT" 
       "COLOR" 
       (("TEXT" "yellow"))) 
      ("ELEMENT" "PRICE" (("TEXT" "0.60")))))))))


(set 'result3 '(
  (DATABASE ((name "example.xml")) (!-- "This is a database of fruits") 
   (FRUIT (NAME "apple") (COLOR "red") (PRICE "0.80")) 
   (FRUIT (NAME "orange") (COLOR "orange") (PRICE "1.00")) 
   (FRUIT (NAME "banana") (COLOR "yellow") (PRICE "0.60")))))

(set 'result4 
	'((CTX:DATABASE (@ (CTX:name "example.xml")) 
		(CTX:FRUIT (CTX:NAME "apple") (CTX:COLOR "red") (CTX:PRICE "0.80"))
		(CTX:FRUIT (CTX:NAME "orange") (CTX:COLOR "orange") (CTX:PRICE "1.00"))
		(CTX:FRUIT (CTX:NAME "banana") (CTX:COLOR "yellow") (CTX:PRICE "0.60"))))
)

;(define CTX:msg)

(println "testing: xml-parse and xml-type-tags")
(define (test-xml-parse)
  (and
	(= (xml-type-tags "TEXT" "CDATA" "COMMENT" "ELEMENT")
		'("TEXT" "CDATA" "COMMENT" "ELEMENT"))
	(print (= result1 (xml-parse example-xml)) " ")
	(print (= result2 (xml-parse example-xml (+ 1 2 4))) " ")
 	(xml-type-tags nil 'cdata '!-- nil) 
	(print (= result3 (xml-parse example-xml (+ 1 2 8))) " ")
	(print (= result4 (xml-parse example-xml (+ 1 2 4 8 16) 'CTX)) " ")
	(xml-type-tags nil nil nil nil)
	(print (= (xml-parse "<msg>Hello World</msg>" (+ 1 2 4 8 16) 'CTX)
    		'((CTX:msg "Hello World"))) )
    (= (xml-parse "<foo:var>Hello</foo:var>" 31) '((foo.var "Hello")))
	(begin (println) (println) true)
))

(if (test-xml-parse)
	(println ">>>>> XML API tested SUCCESSFUL")
    (println ">>>>> PROBLEM in XML API"))
(println)

;; test callback feature
(define (xml-callback s-expr start size)
	(if (or (= (s-expr 0) 'NAME) (= (s-expr 0) 'COLOR) (= (s-expr 0) 'PRICE))
		(begin
			(print "parsed expresson:" s-expr)
			(println ", source:" (start size example-xml))
			(push (list s-expr start size) xml-callback-result -1)
		)
	)
)


(set 'xml-callback-result-test
'(((NAME "apple") 88 18) ((COLOR "red") 115 18) ((PRICE "0.80") 142 19) 
  ((NAME "orange") 196 19) ((COLOR "orange") 224 21) ((PRICE "1.00") 254 19) 
  ((NAME "banana") 307 19) ((COLOR "yellow") 334 21) ((PRICE "0.60") 363 19)
))
  

(println "Testing xml-parse with callback feature")
(xml-type-tags nil 'cdata '!-- nil) 
(set 'xml-callback-result '())
(xml-parse example-xml (+ 1 2 8) MAIN xml-callback)
(println)
;(println "===>"  xml-callback-result)
;(println "===>"  xml-callback-result-test)
(println)
(if (=  xml-callback-result xml-callback-result-test)
	(println ">>>>> XML callback tested SUCCESSFUL")
	(println ">>>>> PROBLEM in XML callback")
)


; produces this output:
[text]
parsed expresson:(NAME "apple"), source:<NAME>apple</NAME>
parsed expresson:(COLOR "red"), source:<COLOR>red</COLOR>
parsed expresson:(PRICE "0.80"), source:<PRICE>0.80</PRICE>
parsed expresson:(NAME "orange"), source:<NAME>orange</NAME>
parsed expresson:(COLOR "orange"), source:<COLOR>orange</COLOR>
parsed expresson:(PRICE "1.00"), source:<PRICE>1.00</PRICE>
parsed expresson:(NAME "banana"), source:<NAME>banana</NAME>
parsed expresson:(COLOR "yellow"), source:<COLOR>yellow</COLOR>
parsed expresson:(PRICE "0.60"), source:<PRICE>0.60</PRICE>
[/text]

(println)
(exit)

;; eof