all-the-same.ss

#! /bin/sh
#| Hey Emacs, this is -*-scheme-*- code!
#$Id: v4-script-template.ss 6086 2009-06-14 20:14:28Z erich $
exec  mzscheme -l errortrace --require "$0" --main -- ${1+"$@"}
|#

#lang scheme
(require schemeunit schemeunit/text-ui)

(define (all-the-same seq)
  (or (null? seq)
      (null? (cdr seq))
      (and (equal? (car seq)
                   (cadr seq))
           (all-the-same (cdr seq)))))

(define-test-suite all-the-same-tests

  (check-true (all-the-same '()))
  (check-true (all-the-same '(1)))
  (check-true (all-the-same '(1 1)))
  (check-false (all-the-same (list 1 2)))
  (check-false (all-the-same (list 1 2 1))))

(define (main . args)
  (exit (run-tests all-the-same-tests 'verbose)))
(provide all-the-same main)