#!/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-source-filename i s-unit-type)
  (let ((str-ext (if (eq? s-unit-type 'script) ".ths" ".thp")))
    (string-append (get-str-test-name i) str-ext)))


(define (get-target-filename i s-unit-type)
  (let ((str-ext (if (eq? s-unit-type 'script) ".tcs" ".tcp")))
    (string-append (get-str-test-name i) str-ext)))


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


(define (check-program i)
  (let* ((s-unit-type (if (member i scripts) 'script 'proper-program))
	 (mod-name (get-target-filename i s-unit-type))
	 (test-path (get-source-test-path i s-unit-type))
	 (log-filename "link-test-programs.log")
	 ;; (comp-success?
	 ;;  (= (run
	 ;;      (| (grep ,mod-name "link-test-programs.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 "link-test-programs.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 "translation and running OK")))
         ;;    0))
	 ;; The following is #t for translation errors, too.
	 (expected-success?
	  (= (system (string-append "grep \"Expected results:\" "
				    test-path
				    " | grep -q \"translation and running 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))
	 ;; (expected-xlat-error?
	 ;;  (=
	 ;;   (run
	 ;;    (grep -q "Expected results: translation error" ,test-path))
         ;;    0)))
	 (expected-xlat-error?
	  (= (system (string-append "grep -q \"Expected results: translation error\" " test-path))
	     0)))
    (cond
     ((eq? comp-success? comp-failure?) 'error)
     ((eq? expected-success? expected-error?) 'error)
     ((and comp-failure? expected-success?) 'fail)
     ((and comp-success? expected-xlat-error?) 'fail)
     (else 'pass))))


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


(define (check-programs)
  (do ((i 1 (+ i 1))) ((> i nr-of-tests))
    (if (and (not (member i modules))
	     (not (member i custom2-programs))
	     (not (member i guile-hashtable-units))
	     (not (member i extra-math-units)))
	(let* ((result (check-program i))
	       (s-unit-type (if (member i scripts) 'script 'proper-program))
	       (program-filename (get-source-filename i s-unit-type)))
	  (display program-filename)
	  (display ": ")
	  (display (get-result result))
	  (newline)))))


(define (main args)
  (check-programs))
