#! /usr/bin/guile-@guile_version@ \
-e main -s
!#

;; Copyright (C) 2018 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.


(import (theme-d testing test-info))


(define (get-test-name i)
  (string->symbol (string-append "test" (number->string i))))


(define (get-str-test-name i)
  (string-append "test" (number->string i)))


(define (get-mod-name i)
  (let* ((test-name (get-test-name i)))
    `(tests ,test-name)))


(define (get-str-mod-name i)
  (let* ((test-name (get-str-test-name i)))
    (string-append "(tests " test-name ")")))


(define (get-test-filename i unit-type)
  (case unit-type
    ((proper-program) (string-append (get-str-test-name i) ".thp"))
    ((script) (string-append (get-str-test-name i) ".ths"))
    ((interface) (string-append (get-str-test-name i) ".thi"))
    ((body) (string-append (get-str-test-name i) ".thb"))
    (else (raise 'error))))


(define (get-test-path i unit-type)
  (let ((filename (get-test-filename i unit-type)))
    (string-append "../theme-d-code/tests/" filename)))


(define (check-program i)
  (let* ((unit-type (if (member i scripts) 'script 'proper-program))
	 (mod-name (get-test-filename i unit-type))
	 (test-path (get-test-path i unit-type))
	 (log-filename "compile-tests.log")
	 ;; (comp-success?
	 ;;  (= (run
	 ;;      (| (grep ,mod-name ,log-filename)
         ;;         (grep -q succeeded)))
         ;;     0))
	 (comp-success?
	  (= (system (string-append "grep " mod-name " " log-filename
				    " | grep -q succeeded"))
             0))
         ;; (comp-failure?
	 ;;  (= (run
	 ;;      (| (grep ,mod-name ,log-filename)
         ;;         (grep -q failed)))
         ;;     0))
	 (comp-failure?
	  (= (system (string-append "grep " mod-name " " log-filename
				    " | grep -q failed"))
             0))
	 ;; (expected-success?
	 ;;  (=
	 ;;   (run
	 ;;    (| (grep "Expected results:" ,test-path)
         ;;       (grep -q "translation and running OK")))
         ;;    0))
	 (expected-success?
	  (or
	   (= (system (string-append
		       "grep \"Expected results:\" " test-path
		       " | grep -q \"translation and running OK\""))
              0)
	   (= (system (string-append
		       "grep \"Expected results:\" " test-path
		       " | grep -q \"translation OK\""))
              0))))
	 ;; (expected-error?
	 ;;  (= (system (string-append "grep \"Expected results:\" " test-path
	 ;; 			    " | grep -q \"translation error\""))
         ;;     0)))
    (cond
     ((eq? comp-success? comp-failure?) 'error)
     ;; ((eq? expected-success? expected-error?) 'error)
     ((and comp-failure? expected-success?) 'fail)
     (else 'pass))))


(define (check-unit? i unit-type)
  (let* ((mod-name (get-test-filename i unit-type))
	 (test-path (get-test-path i unit-type))
	 (log-filename "compile-tests.log")
	 ;; (comp-success?
	 ;;  (= (run
	 ;;      (| (grep ,mod-name "compile-tests.log")
         ;;         (grep -q succeeded)))
         ;;     0))
	 (comp-success?
	  (= (system (string-append "grep " mod-name
				    " " log-filename
				    " | grep -q succeeded"))
             0))
         ;; (comp-failure?
	 ;;  (= (run
	 ;;      (| (grep ,mod-name "compile-tests.log")
         ;;         (grep -q failed)))
         ;;     0))
	 (comp-failure?
	  (= (system (string-append "grep " mod-name
				    " " log-filename
				    " | grep -q failed"))
             0))
	 ;; (expected-success?
	 ;;  (=
	 ;;   (run
	 ;;    (| (grep "Expected results:" ,test-path)
         ;;       (grep -q "compilation OK")))
         ;;    0))
	 (expected-success?
	  (= (system (string-append "grep \"Expected results:\" "
				    test-path
				    " | grep -q \"compilation OK\""))
	     0))
	 ;; (expected-error?
	 ;;  (=
	 ;;   (run
	 ;;    (| (grep "Expected results:" ,test-path)
         ;;       (grep -q "error")))
         ;;    0)))
	 (expected-error?
	  (= (system (string-append "grep \"Expected results:\" "
				    test-path
				    " | grep -q error"))
	     0)))
    (cond
     ((eq? comp-success? comp-failure?) 'error)
     ((eq? expected-success? expected-error?) 'error)
     ((and comp-failure? expected-success?) 'fail)
     ((and comp-success? expected-error?) 'fail)
     (else 'pass))))


(define (get-result s-result)
 (case s-result
   ((pass) "PASS")
   ((fail) "FAIL")
   ((error) "ERROR")
   (else (raise 'internal-error))))


(define (check-units)
  (do ((i 1 (+ i 1))) ((> i nr-of-tests))
    (if (member i modules)
	(let ((intf-result 
	       (check-unit? i 'interface))
	      (body-result
	       (check-unit? i 'body))
	      (intf-filename (get-test-filename i 'interface))
	      (body-filename (get-test-filename i 'body)))
	  (display intf-filename)
	  (display ": ")
	  (display (get-result intf-result))
	  (newline)
	  (display body-filename)
	  (display ": ")
	  (display (get-result body-result))
	  (newline))
	(let* ((result (check-program i))
	       (unit-type (if (member i scripts) 'script 'proper-program))
	       (program-filename (get-test-filename i unit-type)))
	  (display program-filename)
	  (display ": ")
	  (display (get-result result))
	  (newline)))))


(define (main args)
  (check-units))
