#!/usr/bin/guile -s
!#

;;;; greg - Regression testing command-line tool
;;;;
;;;; Copyright (C) 1998 Free Software Foundation, Inc.
;;;;
;;;; Written by:  Richard frith-Macdonald <richard@brainstorm.co.uk>
;;;; Date: 1998
;;;;   
;;;; This file is part of the Greg package - part of the GNUstep project.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;; 
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING.  If not, write to
;;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

(use-modules (greg compiled))
(use-modules (ice-9 greg))
(use-modules (ice-9 expect))

(set! greg-debug #f)
(set! greg-verbose 0)

(define greg-ok-to-proceed #t)
(define greg-last-option "")

(define (get-files args)
  (do
    ()
    (
      (or
	(< (length args) 2)
	(and
	  (> (string-length (cadr args)) 1)
	  (string=? "-" (substring (cadr args) 0 1))
	)
      )
    )
    (begin
      (define file (cadr args))
      (if 
	(and
	  (> (string-length file) 4)
	  (string=? (substring file (- (string-length file) 4)
			        (string-length file)) ".scm"))
	(set! file (substring file (- (string-length file) 4)
				(string-length file)))
      )
      (set! greg-files (cons file greg-files))
      (set! args (cdr args))
    )
  )
  args
)

(define (get-tools args)
  (do
    ()
    (
      (or
	(< (length args) 2)
	(and
	  (> (string-length (cadr args)) 1)
	  (string=? "-" (substring (cadr args) 0 1))
	)
      )
    )
    (begin
      (set! args (cdr args))
      (set! greg-tools (cons (car args) greg-tools))
    )
  )
  args
)

(define (options args) (if (> (length args) 1) (begin
  (define args (cdr args))
  (define s (car args))
  (if (and (> (string-length s) 1) (string=? "-" (substring s 0 1)))
    (cond
      ((or (string=? s "--debug") (string=? s "-de"))
	(set! greg-debug #t)
      )
      ((string=? s "--file")
	(set! greg-files ())
	(set! args (get-files args))
	(if (= (length greg-files) 0)
	  (display "No 'files' specified\n")
	  (set! greg-files (reverse greg-files))
	)
      )
      ((or (string=? s "--help") (string=? s "-H"))
	(display "\nGreg is a Gnustep REGression testing framework\n\n")
	(display "With no options - runs tests in the 'tests' directory\n")
	(display "\nUSAGE: greg [options...]\n")
	(display "        --debug (-de)            Perform debug logging\n")
	(display "        --file [name(s)]         Test files to use\n")
	(display "        --objdir [name]          Where to find binaries\n")
	(display "        --outdir [name]          Where to put log files\n")
	(display "        --posix                  Make it posix complient\n")
	(display "        --srcdir [name]          Where to put find tests\n")
	(display "        --tool [name(s)]         Test directories to use\n")
	(display "        --verbose (-v)           More detailed output\n")
	(display "        --version (-V)           Output version numbers\n")
	(display "\n")
	(set! greg-ok-to-proceed #f)
	(set! args ())	; End loop
      )
      ((string=? s "--objdir")
	(if (> (length args) 0)
	  (begin
	    (set! args (cdr args))
	    (set! greg-obj-dir (car args))
	  )
	  (display "No 'obj' directory specified\n")
	)
      )
      ((string=? s "--outdir")
	(if (> (length args) 0)
	  (begin
	    (set! args (cdr args))
	    (set! greg-out-dir (car args))
	  )
	  (display "No 'out' directory specified\n")
	)
      )
      ((string=? s "--posix")
	(set! greg-posix #t)
      )
      ((string=? s "--srcdir")
	(if (> (length args) 0)
	  (begin
	    (set! args (cdr args))
	    (set! greg-src-dir (car args))
	  )
	  (display "No 'src' directory specified\n")
	)
      )
      ((string=? s "--tool")
	(set! greg-tools ())
	(set! args (get-tools args))
	(if (= (length greg-tools) 0)
	  (display "No 'tools' directories specified\n")
	  (set! greg-tools (reverse greg-tools))
	)
      )
      ((or (string=? s "--verbose") (string=? s "-v"))
	(set! greg-verbose (+ 1 greg-verbose))
      )
      ((or (string=? s "--version") (string=? s "-V"))
	(display "Greg version  ")
	(display (greg-version))
	(display "\n")
	(display "Guile version ")
	(display (version))
	(display "\n")
	(set! greg-ok-to-proceed #f)
	(set! args ())	; End loop
      )
      (else
	(display "Unknown option - '")
	(display s)
	(display "'\n")
	(set! greg-ok-to-proceed #f)
	(set! args ())	; End loop
      )
    )
    (begin
      (display "Unknown option - '")
      (display s)
      (display "'\n")
      (set! greg-ok-to-proceed #f)
      (set! args ())	; End loop
    )
  )
  (options args)
))())

(options (command-line))

;
;	Tun tests and return 0 on success, 1 on any error.
;
(if greg-ok-to-proceed
  (if (greg-test-run)
    0
    1
  )
  1
)



