(require-extension ports npdiff format-textdiff patch test)

(define format make-format-textdiff)

(test-group "empty input sequences"

   (let ((empty (with-input-from-string "" read-lines))
	 (abc (with-input-from-string "abc" read-lines)))
     (let ((hunks1 (textdiff empty abc 3))
	   (hunks2 (textdiff abc empty 3)))
       

       (test-group "diff empty -> abc"
		   (test "normal format" 
#<<EOF
0a1
> abc

EOF
                   (call-with-output-string
		    (lambda (out) ((format 'normal) out hunks1))))
		   (test "ed format"
#<<EOF
0a
abc
.

EOF
                   (call-with-output-string
		    (lambda (out) ((format 'ed) out hunks1))))
		   (test "rcs format"
#<<EOF
a0 1
abc

EOF
                   (call-with-output-string
		    (lambda (out) ((format 'rcs) out hunks1))))
		   (test "context format"
#<<EOF
*** empty 
--- abc 
***************
*** 0 ****
--- 1 ----
+ abc

EOF
                   (call-with-output-string
		    (lambda (out) ((format 'context) out hunks1
				   "empty" "" "abc" ""))))
		   )

       (test-group "diff abc -> empty"
		   (test "normal format" 
#<<EOF
1d0
< abc

EOF
                   (call-with-output-string
		    (lambda (out) ((format 'normal) out hunks2))))
		   (test "ed format"
#<<EOF
1d

EOF
                   (call-with-output-string
		    (lambda (out) ((format 'ed) out hunks2))))
		   (test "rcs format"
#<<EOF
d1 1

EOF
                   (call-with-output-string
		    (lambda (out) ((format 'rcs) out hunks2))))
		   (test "context format"
#<<EOF
*** abc 
--- empty 
***************
*** 1 ****
- abc
--- 0 ----

EOF
                   (call-with-output-string
		    (lambda (out) ((format 'context) out hunks2
				   "abc" "" "empty" ""))))
		   )
		   
     )))

(test-group "text1 -> text2"

(let* ((text1 (call-with-input-file "text1" read-lines))
       (text2 (call-with-input-file "text2" read-lines))
       (hunks (textdiff text1 text2 3)))

  (test "normal format"
#<<EOF
0a1
> w
3,4c4,6
< c
< d
---
> x
> y
> z
6,7d7
< f
< g

EOF
   (call-with-output-string
    (lambda (out) ((format 'normal) out hunks))))
  (test "ed format"
#<<EOF
6,7d
3,4c
x
y
z
.
0a
w
.

EOF
   (call-with-output-string
    (lambda (out) ((format 'ed) out hunks))))
  (test "rcs format"
#<<EOF
a0 1
w
d3 2
a4 3
x
y
z
d6 2

EOF
   (call-with-output-string
    (lambda (out)  ((format 'rcs) out hunks))))
  (test "context format"
#<<EOF
*** text1 
--- text2 
***************
*** 1,7 ****
  a
  b
! c
! d
  e
- f
- g
--- 1,7 ----
+ w
  a
  b
! x
! y
! z
  e

EOF
   (call-with-output-string
    (lambda (out)  ((format 'context) out hunks "text1" "" "text2" ""))))
  ))

(test-group "pointers1 -> pointers2"

(let* ((text1 (call-with-input-file "pointers1" read-lines))
       (text2 (call-with-input-file "pointers2" read-lines))
       (hunks (textdiff text1 text2 3)))

  (test "normal format"
#<<EOF
7d6
< <li><a href="100share/filer/base/filer.html">Filer (without login)</a></li>
9c8
< <li><a href="100share/waitlesql/base/waitlesql_query.html">WaitleSQL</a></li>
---
> <li><a href="100share/filer/base/filer.html">Filer (without login)</a></li>
14d12
< 

EOF
   (call-with-output-string
    (lambda (out) ((format 'normal) out hunks))))

  (test "ed format"
#<<EOF
14d
9c
<li><a href="100share/filer/base/filer.html">Filer (without login)</a></li>
.
7d

EOF
   (call-with-output-string
    (lambda (out) ((format 'ed) out hunks))))
  (test "rcs format"
#<<EOF
d7 1
d9 1
a9 1
<li><a href="100share/filer/base/filer.html">Filer (without login)</a></li>
d14 1

EOF
   (call-with-output-string
    (lambda (out)  ((format 'rcs) out hunks))))

  (test "context format"
#<<EOF
*** pointers1 
--- pointers2 
***************
*** 4,17 ****
  here is some useful pointers.
  
  <ul>
- <li><a href="100share/filer/base/filer.html">Filer (without login)</a></li>
  <li><a href="AUTH/100share/filer/base/filer.html">Filer (with login)</a></li>
! <li><a href="100share/waitlesql/base/waitlesql_query.html">WaitleSQL</a></li>
  </ul>
  
  Have fun!!!
  
- 
  </body>
  </html>
  
--- 4,15 ----
  here is some useful pointers.
  
  <ul>
  <li><a href="AUTH/100share/filer/base/filer.html">Filer (with login)</a></li>
! <li><a href="100share/filer/base/filer.html">Filer (without login)</a></li>
  </ul>
  
  Have fun!!!
  
  </body>
  </html>
  

EOF
   (call-with-output-string
    (lambda (out)  ((format 'context) out hunks "pointers1" "" "pointers2" ""))))
  ))

(define hunks
  (let ((large0 (call-with-input-file "large0" read-lines))
	(large1 (call-with-input-file "large1" read-lines)))
    (textdiff large0 large1 3)))

(test-group "s-expression patch"
  (let* ((spatch (textdiff->sexp hunks))
	 (large1 (with-input-from-file "large1" read-string)))
    (test "large0 -> large1" large1
	  (with-output-to-string
	    (lambda ()
	      (with-input-from-file "large0" 
		(lambda ()
		  (apply-patch spatch))))))))

(test-group "normal diff patch"
  (let* ((npatch (call-with-output-string (lambda (out) ((format 'normal) out hunks))))
	 (large1 (with-input-from-file "large1" read-string)))
    (test "large0 -> large1" large1
	  (with-output-to-string
	    (lambda ()
	      (with-input-from-file "large0" 
		(lambda ()
		  (apply-patch (with-input-from-string npatch make-patch)))))))))

(define patch-files
  (list "large0.patch.ed"
	"large0.patch.rcs"
	"large0.patch.context"))

(define patch-procs
  (list  (lambda (port) ((format 'ed) port hunks))
	 (lambda (port) ((format 'rcs) port hunks))
	 (lambda (port) ((format 'context) port hunks
			 "large0" "Sun Jun  3 18:28:06 2007" 
			 "large1" "Sun Jun  3 18:28:06 2007"))))

(for-each
 (lambda (patch-file f) (call-with-output-file patch-file f))
 patch-files patch-procs)