;; -*- mode: Scheme; -*-
;;
;; This file is part of Protocol Buffers for CHICKEN
;; Copyright (c) 2013 by Thomas Chust.  All rights reserved.
;;
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the Software), to deal in the Software without restriction,
;; including without limitation the rights to use, copy, modify,
;; merge, publish, distribute, sublicense, and/or sell copies of the
;; Software, and to permit persons to whom the Software is furnished
;; to do so, subject to the following conditions:
;; 
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;; 
;; THE SOFTWARE IS PROVIDED ASIS, WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.

(define-record-type (foo
		     #:uid '4b9aa808-96ef-48e3-bb97-d71f37068fe1)
  #t #t
  a b)

(define (read-bar port)
  (make-bar (read-string #f port)))

(define (write-bar v port)
  (write-string (bar-ref v) #f port))

(define-record-type (bar
		     #:property prop:serialization-info
		     (make-serialization-info read-bar write-bar))
  #t #t
  ref)

(define (serialize+deserialize v)
  (call-with-input-string
   (call-with-output-string (cut serialize v <>))
   deserialize))

(define (check-invariance v #!optional [test equal?])
  (check (serialize+deserialize v) (=> test) v))

(define (run)
  (check-invariance (void) eq?)
  (check-invariance '() eq?)
  (check-invariance #!eof eq?)
  (check-invariance #f eq?)
  (check-invariance #t eq?)
  (check-invariance #\x eq?)
  
  (check-invariance 42 eq?)
  (check-invariance 23.45 eqv?)
  
  (check-invariance 42+23i)
  (check-invariance 4/2+2/3i)
  (check-invariance 0+2.34i)
  (check-invariance 2.34+3.56i)
  
  (check-invariance "foo")
  (check-invariance 'blubb eq?)
  (check-invariance #:troet eq?)
  
  (let* ([sym0 (gensym 'blubb)]
	 [sym1 (serialize+deserialize sym0)])
    (check (symbol->string sym1) (=> equal?) (symbol->string sym0))
    (check (eq? sym1 sym0) => #f))
  
  (check-invariance (cons 1 2))
  (check-invariance '(a b 42))
  
  (let* ([lst0 (circular-list 1 2 3)]
	 [lst1 (serialize+deserialize lst0)])
    (check (eq? (cdddr lst1) lst1) => #t)
    (check (car lst1) => (car lst0))
    (check (cadr lst1) => (cadr lst0))
    (check (caddr lst1) => (caddr lst0)))
  
  (check-invariance '#(42+23i "foo"))

  (let ([vec0 (vector 'a 'b (void))])
    (vector-set! vec0 2 vec0)
    (let ([vec1 (serialize+deserialize vec0)])
      (check (eq? (vector-ref vec1 2) vec1) => #t)
      (check (vector-ref vec1 0) (=> eq?) (vector-ref vec0 0))
      (check (vector-ref vec1 1) (=> eq?) (vector-ref vec0 1))))
  
  (let* ([lst0 '(("blubb" . 23) ("boing" . 42))]
	 [lst1 (sort
		(hash-table->alist
		 (serialize+deserialize
		  (alist->hash-table lst0 #:test string=? #:hash string-hash)))
		(lambda (a b)
		  (string<? (car a) (car b))))])
    (check lst1 => lst0))
  
  (let* ([lst0 '((3 . "boo") (55 . "hoo"))]
	 [lst1 (sort
		(hash-table->alist
		 (serialize+deserialize
		  (alist->hash-table lst0)))
		(lambda (a b)
		  (< (car a) (car b))))])
    (check lst1 => lst0))
  
  (check ((serialize+deserialize (lambda (x) (* x 42))) 2) => 84)
  
  (check-invariance '#u8(1 2 3))
  (check-invariance '#s8(-1 0 +1))
  (check-invariance '#u16(1 2 3))
  (check-invariance '#s16(-1 0 +1))
  (check-invariance '#u32(1 2 3))
  (check-invariance '#s32(-1 0 +1))
  (check-invariance '#f32(1.234 5.678))
  (check-invariance '#f64(1.234 5.678))
  (check-invariance '#${983729423476237887246302})
  
  (check-invariance (make-foo 42+23i "Hallo Welt!"))
  (check-invariance (make-bar "kawumm!")))