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

;;;; greg - Regression testing command-line tool
;;;;
;;;; Copyright (C) 1998 Free Software Foundation, Inc.
;;;;
;;;; Written by:  Richard frith-Macdonald <rfm@gnu.org>
;;;; Date: 1998
;;;;   
;;;; This file is part of the Greg package - part of the GNUstep project.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2.1 of the License, or (at your option) any later version.
;;;; 
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
;;;;

;;; Dynamically link the glue code for accessing the pty library,
;;; but only when it isn't already present.

(load-extension "libgreg" "scm_init_greg")

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

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

(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))
	)
      )
    )
    (let
      ((file (cadr args)))
      (begin
	(set! greg-files (cons file greg-files))
	(set! args (cdr args))
      )
    )
  )
  args
)

(define (get-paths 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-paths (cons (car args) greg-paths))
    )
  )
  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)
(let*
  (
    (args (cdr args))
    (s (car args))
  )
(begin
  (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)]         Limit test files to use\n")
	(display "        --objdir [name]          Where to find binaries\n")
	(display "        --outdir [name]          Where to put log files\n")
	(display "        --path [name(s)]         Run specific files rather\n")
	(display "                                 than test directories\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
      )
    )
    (if (> (string-length s) 1)
      (begin
	(set! greg-paths (cons s greg-paths))
	(set! args (get-paths args))
      )
      (display "Nul argument ignored!\n")
    )
  )
  (options args)
)))'())

(if (> (length greg-paths) 0)
  (begin
    (set! greg-paths (reverse greg-paths))
    (if (> (length greg-tools) 0)
      (begin
	(display "Use of filename in command-line args overrides --tool\n")
	(set! greg-tools '())
      )
    )
    (if (> (length greg-files) 0)
      (begin
	(display "Use of filename in command-line args overrides --file\n")
	(set! greg-files '())
      )
    )
  )
)

(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
)


