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

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


(import (rnrs exceptions))
(import (theme-d common theme-d-config))
(import (theme-d testing test-info))
	

(init-theme-d-config)

(define gl-theme-d-linker-path
  (get-theme-d-config-var 'linker-path))


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


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


(define (get-target-filename i)
  (string-append "test" (number->string i) ".go"))


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


(define (link-program index output-file)
  (let* ((s-unit-type (if (member index scripts) 'script 'proper-program))
	 (source-filename (get-source-filename index s-unit-type))
	 (target-filename (get-target-filename index)))
    (display (string-append "Linking program "))
    (display source-filename)
    (newline)
    (flush-all-ports)
    (let ((source-path (get-test-path source-filename))
	  (target-path (get-test-path target-filename))
	  (str-extra-modules
	   (cond
	    ((member index custom1-programs)
	     "-x \"(theme-d testing custom1)\"")
	    ((member index custom2-programs)
	     "-x \"(theme-d testing custom2)\"")
	    (else ""))))
      (let ((result
	     (system (string-append
		      gl-theme-d-linker-path
		      " -m :../theme-d-code --pretty-print "
		      str-extra-modules
		      " -o "
		      target-path
		      " " source-path " 2>&1"))))
	(if (= result 0)
	    (begin
	      (display "Linking of " output-file)
	      (display source-filename output-file)
	      (display " succeeded." output-file)
	      (newline output-file))
	    (begin
	      (display "Linking of " output-file)
	      (display source-filename output-file)
	      (display " failed." output-file)
	      (newline output-file)))))))


(define (link-programs output-file)
  (do ((i 1 (+ i 1))) ((> i nr-of-tests))
    (if (not (member i modules))
  	(link-program i output-file))))


(define (main args)
  (call-with-output-file "link-test-programs.log"
    (lambda (output-file)
      (link-programs output-file))))
