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

;; Copyright (C) 2008-2019 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) ".rkt"))


(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)))
      (let* ((result1
	      (if (member index custom1-programs)
		  (system (string-append
			   gl-theme-d-linker-path
			   " -m :../theme-d-code --pretty-print "
			   "-i racket "
			   "-x rnrs/bytevectors-6 "
			   "-y custom1.rkt "
			   "-n "
			   target-path
			   " " source-path " 2>&1"))
		  (system (string-append
			   gl-theme-d-linker-path
			   " -m :../theme-d-code --pretty-print "
			   "-i racket "
			   "-n "
			   target-path
			   " " source-path " 2>&1"))))
	     (result2
	      (if (= result1 0)
		  (system (string-append "raco make " target-path))
		  0)))
	(if (and (= result1 0) (= result2 0))
	    (begin
	      (display "Target compilation succeeded.\n")
	      (display "Linking of " output-file)
	      (display source-filename output-file)
	      (display " succeeded." output-file)
	      (newline output-file))
	    (begin
	      (display "Target compilation failed.\n")
	      (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 (and (not (member i modules))
	     (not (member i custom2-programs))
	     (not (member i guile-hashtable-units))
	     (not (member i extra-math-units)))
  	(link-program i output-file))))


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