cgen/cgen-testsuite.scm

   1 ; CGEN testsuite driver.
   2 ; Copyright (C) 2009 Doug Evans
   3 ; This file is part of CGEN.
   4 ;
   5 ; This is a standalone script, we don't load anything until we parse the
   6 ; -s argument (keeps reliance off of environment variables, etc.).
   7
   8 ; Load the various support routines.
   9
  10 (define (load-files srcdir)
  11   (load (string-append srcdir "/read.scm"))
  12   (load (string-append srcdir "/desc.scm"))
  13   (load (string-append srcdir "/desc-cpu.scm"))
  14   (load (string-append srcdir "/testsuite.scm"))
  15 )
  16
  17 (define testsuite-arguments
  18   (list
  19    (list "-T" "file" "generate $arch-test.h in <file>"
  20          #f
  21          (lambda (arg) (file-write arg cgen-test.h)))
  22    )
  23 )
  24
  25 ; Kept global so it's available to the other .scm files.
  26 (define srcdir ".")
  27
  28 ; Scan argv for -s srcdir.
  29 ; We can't process any other args until we find the cgen source dir.
  30 ; The result is srcdir.
  31 ; We assume "-s" isn't the argument to another option.  Unwise, yes.
  32 ; Alternatives are to require it to be the first argument or at least preceed
  33 ; any option with a "-s" argument, or to put knowledge of the common argument
  34 ; set and common argument parsing code in every top level file.
  35
  36 (define (find-srcdir argv)
  37   (let loop ((argv argv))
  38     (if (null? argv)
  39         (error "`-s srcdir' not present, can't load cgen"))
  40     (if (string=? "-s" (car argv))
  41         (begin
  42           (if (null? (cdr argv))
  43               (error "missing srcdir arg to `-s'"))
  44           (cadr argv))
  45         (loop (cdr argv))))
  46 )
  47
  48 ; Main routine, parses options and calls generators.
  49
  50 (define (cgen-testsuite argv)
  51   (let ()
  52
  53     ; Find and set srcdir, then load all Scheme code.
  54     ; Drop the first argument, it is the script name (i.e. argv[0]).
  55     (set! srcdir (find-srcdir (cdr argv)))
  56     (set! %load-path (cons srcdir %load-path))
  57     (load-files srcdir)
  58
  59     (display-argv argv)
  60
  61     (cgen #:argv argv
  62           #:app-name "testsuite"
  63           #:arg-spec testsuite-arguments
  64           #:init testsuite-init!
  65           #:finish testsuite-finish!
  66           #:analyze testsuite-analyze!)
  67     )
  68 )
  69
  70 (cgen-testsuite (program-arguments))