tests.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: getopt-tests -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          getopt-tests.lisp
   6 ;;;; Purpose:       getopt tests file
   7 ;;;; Author:        Kevin M. Rosenberg
   8 ;;;; Date Started:  Sep 2003
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file is Copyright (c) 2003 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; *************************************************************************
  15
  16 (in-package cl)
  17 (defpackage getopt-tests
  18   (:use #:getopt #:cl #:ptester))
  19 (in-package getopt-tests)
  20
  21 (defmacro test-mv (values form)
  22   `(test ,values ,form :multiple-values t :test #'equal))
  23
  24 (defun do-tests ()
  25   (with-tests (:name "GETOPT")
  26     (let ((*break-on-test-failures* nil))
  27
  28       ;; match-unique-abbreviation
  29       (test nil (match-unique-abbreviation "abc" nil))
  30       (test nil (match-unique-abbreviation "abc" '("ab")))
  31       (test 0 (match-unique-abbreviation "ab" '("ab")))
  32       (test 0 (match-unique-abbreviation "a" '("ab")))
  33       (test nil (match-unique-abbreviation "b" '("ab")))
  34       (test nil (match-unique-abbreviation "ab" '("ab" "abc")))
  35       (test 1 (match-unique-abbreviation "ac" '("ab" "ac")))
  36       (test 1 (match-unique-abbreviation "ac" '("ab" "acb")))
  37
  38       ;; getopt
  39       (test-mv '(("argv") nil nil) (getopt '("argv") nil))
  40       (test-mv '(("argv" "2") nil nil) (getopt '("argv" "2") nil))
  41
  42       (test-mv '(("argv") (("c")) nil) (getopt '("argv" "-c") '(("c" :none))))
  43
  44       (test-mv '(("argv") (("c" . "val")) nil)
  45                (getopt '("argv" "-c" "val") '(("c" :optional))))
  46       (test-mv '(("argv" "v1") (("c" . "val")) nil)
  47                (getopt '("argv" "-c" "val" "v1") '(("c" :optional))))
  48       (test-mv '(( "v1") (("colon" . "val")) nil)
  49                (getopt '("--colon" "val" "v1") '(("colon" :optional))))
  50       (test-mv '(("ab" "-c") (("colon" . "val")) nil)
  51                (getopt '("ab" "--colon" "val" "--" "-c")
  52                        '(("colon" :optional) ("-c" :none))))
  53       (test-mv '(("argv") (("c" . "cd")) nil)
  54                (getopt '("argv" "-c" "cd") '(("c" :required))))
  55       (test-mv '(("argv") nil ("c"))
  56                (getopt '("argv" "-c") '(("c" :required))))
  57       (test-mv '(("argv") (("c" . "10")) nil)
  58                (getopt '("argv" "-c=10") '(("c" :required))))
  59       (test-mv '(("argv") nil ("c"))
  60                (getopt '("argv" "-c=10") '(("c" :none))))
  61       (test-mv '(nil (("along" . "10")) nil)
  62                (getopt '("--along=10") '(("along" :optional))))
  63       (test-mv '(nil nil ("along"))
  64                (getopt '("--along=10") '(("along" :none))))
  65       (test-mv '(nil (("along" . "10")) nil)
  66                (getopt '("--a=10") '(("along" :optional))))
  67       (test-mv '(nil nil ("a"))
  68                (getopt '("--a=10") '(("along" :optional) ("aboot" :optional))))
  69       (test-mv '(("a") nil nil)
  70                (getopt '("a") '(("a" :none))))
  71       (test-mv '(("a") (("foo") ("bar")) nil)
  72                (getopt '("a" "--foo" "--bar") '(("foo" :none) ("bar" :none))))
  73       (test-mv '(("a") (("foo") ("bar")) nil)
  74                (getopt '("a" "--f" "--bar") '(("foo" :none) ("bar" :none))))
  75       ))
  76   t)