Browse code
Split tests into a separate file, xunit support
The tests for the parser are now in test-parser.lisp
The generated binary now takes a `--run-tests` option that will run
the unit tests and, optionally print them out in xUnit format.
fiddlerwoaroof authored on 27/04/2016 01:18:05Showing 5 changed files
| ... | ... |
@@ -38,16 +38,23 @@ sbcl --no-userinit \ |
| 38 | 38 |
## Examples: |
| 39 | 39 |
|
| 40 | 40 |
``` |
| 41 |
-Usage: timesheet [-crWisvh] [OPTIONS] TIMESHEETS ... |
|
| 41 |
+Usage: timesheet [-sWircvh] [OPTIONS] TIMESHEETS ... |
|
| 42 | 42 |
|
| 43 | 43 |
A program for managing logs of hours worked |
| 44 |
-Main actions |
|
| 45 |
- -c, --client Sort records by client |
|
| 46 |
- -r, --reverse Reverse the sort direction |
|
| 44 |
+Display options |
|
| 45 |
+ -s, --status Print a short summary of work status |
|
| 47 | 46 |
-W, --ignore-whitespace Ignore whitespace errors in input |
| 48 | 47 |
-i, --interactive Run interactively |
| 49 |
- -s, --status Print a short summary of work status |
|
| 50 |
-Other options |
|
| 48 |
+Sort options |
|
| 49 |
+ -r, --reverse Reverse the sort direction |
|
| 50 |
+ -c, --client Sort records by client |
|
| 51 |
+Freshbooks |
|
| 52 |
+ --post-hours Post hours to freshbooks (requires manual setup of Freshbooks keys) |
|
| 53 |
+Self-test options |
|
| 54 |
+ --run-tests Run the tests |
|
| 55 |
+ --output-style=TYPE The kind of output to produce |
|
| 56 |
+ Default: normal |
|
| 57 |
+Generic options |
|
| 51 | 58 |
-v, --version Show the program version |
| 52 | 59 |
-h, --help Show this help |
| 53 | 60 |
``` |
| 54 | 61 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,250 @@ |
| 1 |
+(in-package #:timesheet.parser) |
|
| 2 |
+ |
|
| 3 |
+;; This will help make sure everything is consumed when |
|
| 4 |
+;; we don't care about the parser's output. |
|
| 5 |
+ |
|
| 6 |
+(defun cdar-equal (a b) (== (cdar a) (cdar b))) |
|
| 7 |
+ |
|
| 8 |
+(st:deftest time-line-test () |
|
| 9 |
+ (st:should be cdar-equal '((" start@" . ""))
|
|
| 10 |
+ (run (.time-line-start) " start@")) |
|
| 11 |
+ (st:should be == '(((((0 0 0))) . "")) |
|
| 12 |
+ (run (.time-line) (format nil " start@00:00:00--~%"))) |
|
| 13 |
+ (st:should be == '(((((0 0 0) (1 0 0))) . "")) |
|
| 14 |
+ (run (.time-line) (format nil " start@00:00:00--01:00:00~%"))) |
|
| 15 |
+ (st:should be == '(((((0 0 0) (1 0 0)) |
|
| 16 |
+ ((2 0 0))) |
|
| 17 |
+ . "")) |
|
| 18 |
+ (run (.time-line) (format nil " start@00:00:00--01:00:00,02:00:00--~%"))) |
|
| 19 |
+ (st:should be == '(((((0 0 0) (1 0 0)) |
|
| 20 |
+ ((2 0 0) (3 0 0))) |
|
| 21 |
+ . "")) |
|
| 22 |
+ (run (.time-line) (format nil " start@00:00:00--01:00:00,02:00:00--03:00:00~%"))) |
|
| 23 |
+ (st:should be == '(((((0 0 0) (1 0 0)) |
|
| 24 |
+ ((2 0 0))) |
|
| 25 |
+ . "")) |
|
| 26 |
+ (run (.time-line) (format nil " start@00:00:00--01:00:00, 02:00:00--~%")))) |
|
| 27 |
+ |
|
| 28 |
+(st:deftest range-list-test () |
|
| 29 |
+ (st:should be == '((#\, . "")) |
|
| 30 |
+ (run (.range-list-separator) ",")) |
|
| 31 |
+ (st:should signal invalid-time |
|
| 32 |
+ (run (.range-list) "30:00:00")) |
|
| 33 |
+ (st:should be == nil |
|
| 34 |
+ (run (.range-list) "00:00:00")) |
|
| 35 |
+ (st:should be == nil |
|
| 36 |
+ (run (.range-list) "00:00:00--,00:00:00")) |
|
| 37 |
+ (st:should be == '(((((0 0 0))) . "")) |
|
| 38 |
+ (run (.range-list) (format nil "00:00:00--~%"))) |
|
| 39 |
+ (st:should be == '(((((0 0 0) (1 0 0))) . "")) |
|
| 40 |
+ (run (.range-list) (format nil "00:00:00--01:00:00~%"))) |
|
| 41 |
+ (st:should be == '(((((0 0 0) (1 0 0)) |
|
| 42 |
+ ((2 0 0))) |
|
| 43 |
+ . "")) |
|
| 44 |
+ (run (.range-list) (format nil "00:00:00--01:00:00,02:00:00--~%"))) |
|
| 45 |
+ (st:should be == '(((((0 0 0) (1 0 0)) |
|
| 46 |
+ ((2 0 0) (3 0 0))) |
|
| 47 |
+ . "")) |
|
| 48 |
+ (run (.range-list) (format nil "00:00:00--01:00:00,02:00:00--03:00:00~%"))) |
|
| 49 |
+ (st:should be == `(((((0 0 0) (1 0 0) ,(make-time-mod -10 "mins")) |
|
| 50 |
+ ((2 0 0) (3 0 0)) |
|
| 51 |
+ ) |
|
| 52 |
+ . "")) |
|
| 53 |
+ (run (.range-list) (format nil "00:00:00--01:00:00-10mins,02:00:00--03:00:00~%"))) |
|
| 54 |
+ (st:should be == `(((((0 0 0) (1 0 0) ,(make-time-mod 10 "mins")) |
|
| 55 |
+ ((2 0 0) (3 0 0)) |
|
| 56 |
+ ) |
|
| 57 |
+ . "")) |
|
| 58 |
+ (run (.range-list) (format nil "00:00:00--01:00:00+10mins,02:00:00--03:00:00~%"))) |
|
| 59 |
+ (st:should be == '(((((0 0 0) (1 0 0)) |
|
| 60 |
+ ((2 0 0))) |
|
| 61 |
+ . "")) |
|
| 62 |
+ (run (.range-list) (format nil "00:00:00--01:00:00, 02:00:00--~%")))) ;; space allowed between ranges |
|
| 63 |
+ |
|
| 64 |
+(st:deftest time-range-test () |
|
| 65 |
+ (st:should be == '(("--" . ""))
|
|
| 66 |
+ (run (.time-range-separator) "--")) |
|
| 67 |
+ (st:should be == nil |
|
| 68 |
+ (run (.time-range) "30:00:00")) |
|
| 69 |
+ (st:should be == nil |
|
| 70 |
+ (run (.time-range) "00:00:00")) |
|
| 71 |
+ (st:should be == nil |
|
| 72 |
+ (run (.time-range) "00:00:00--,01:00:00--")) |
|
| 73 |
+ (st:should be == '((((0 0 0)) . "")) |
|
| 74 |
+ (run (.time-range) "00:00:00--")) |
|
| 75 |
+ (st:should be == '((((0 0 0) (1 0 0)) . "")) |
|
| 76 |
+ (run (.time-range) "00:00:00--01:00:00"))) |
|
| 77 |
+ |
|
| 78 |
+(st:deftest time-test () |
|
| 79 |
+ (st:should signal invalid-time |
|
| 80 |
+ (run (.time) "00:0a:00")) |
|
| 81 |
+ (st:should be == '(((0 0 0) . "")) |
|
| 82 |
+ (handler-bind ((invalid-time |
|
| 83 |
+ (lambda (x) x |
|
| 84 |
+ (smug:replace-invalid "00:0a:00" "00:00:00")))) |
|
| 85 |
+ (run (.time) "00:0a:00"))) |
|
| 86 |
+ (st:should be == '((#\: . "")) |
|
| 87 |
+ (run (.time-separator) ":")) |
|
| 88 |
+ (st:should signal invalid-time |
|
| 89 |
+ (run (.time) "30:00:00")) |
|
| 90 |
+ (st:should be == '(((0 0 0) . "")) |
|
| 91 |
+ (run (.time) "00:00:00"))) |
|
| 92 |
+ |
|
| 93 |
+(st:deftest digit-test () |
|
| 94 |
+ (loop for char in '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) |
|
| 95 |
+ do (st:should be == `((,char . "")) |
|
| 96 |
+ (run (.digit) (make-string 1 :initial-element char)))) ) |
|
| 97 |
+ |
|
| 98 |
+(st:deftest minute-test () |
|
| 99 |
+ (st:should be == nil |
|
| 100 |
+ (run (.first-minute-char) "a")) |
|
| 101 |
+ (st:should be == nil |
|
| 102 |
+ (run (.first-minute-char) "6")) |
|
| 103 |
+ (st:should be == nil |
|
| 104 |
+ (run (.first-minute-char) "-1")) |
|
| 105 |
+ (loop for char in '(#\0 #\1 #\2 #\3 #\4 #\5) |
|
| 106 |
+ do (st:should be == `((,char . "")) |
|
| 107 |
+ (run (.first-minute-char) (make-string 1 :initial-element char)))) |
|
| 108 |
+ (st:should be == nil |
|
| 109 |
+ (run (.minute-or-second) "61")) |
|
| 110 |
+ (st:should be == nil |
|
| 111 |
+ (run (.minute-or-second) "71")) |
|
| 112 |
+ (st:should be == nil |
|
| 113 |
+ (run (.minute-or-second) "0")) ;; one digit |
|
| 114 |
+ (st:should be == nil |
|
| 115 |
+ (run (.minute-or-second) "aa")) |
|
| 116 |
+ (st:should be == `(("01" . ""))
|
|
| 117 |
+ (run (.minute-or-second) "01"))) |
|
| 118 |
+ |
|
| 119 |
+(st:deftest hour-test () |
|
| 120 |
+ (st:should be == nil |
|
| 121 |
+ (run (.first-hour-char) "a")) |
|
| 122 |
+ (st:should be == nil |
|
| 123 |
+ (run (.first-hour-char) "3")) |
|
| 124 |
+ (st:should be == nil |
|
| 125 |
+ (run (.first-hour-char) "-1")) |
|
| 126 |
+ (st:should be eq T |
|
| 127 |
+ (every #'identity |
|
| 128 |
+ (loop for char in '(#\0 #\1 #\2) |
|
| 129 |
+ collect (== `((,char . "")) |
|
| 130 |
+ (run (.first-hour-char) (make-string 1 :initial-element char)))))) |
|
| 131 |
+ (st:should be == nil |
|
| 132 |
+ (run (.hour) "24")) |
|
| 133 |
+ (st:should be == nil |
|
| 134 |
+ (run (.hour) "71")) |
|
| 135 |
+ (st:should be == nil |
|
| 136 |
+ (run (.hour) "0")) |
|
| 137 |
+ (st:should be == nil |
|
| 138 |
+ (run (.hour) "aa")) |
|
| 139 |
+ (st:should be == `(("20" . ""))
|
|
| 140 |
+ (run (.prog1 (.hour) (.not (.item))) "20")) |
|
| 141 |
+ (st:should be == `(("01" . ""))
|
|
| 142 |
+ (run (.prog1 (.hour) (.not (.item))) "01"))) |
|
| 143 |
+ |
|
| 144 |
+(st:deftest month-test () |
|
| 145 |
+ (st:should be == nil |
|
| 146 |
+ (run (.first-month-char) "a")) |
|
| 147 |
+ (st:should be == nil |
|
| 148 |
+ (run (.first-month-char) "4")) |
|
| 149 |
+ (st:should be == nil |
|
| 150 |
+ (run (.first-month-char) "-1")) |
|
| 151 |
+ (loop for char in '(#\0 #\1 #\2 #\3) |
|
| 152 |
+ do (st:should be == `((,char . "")) |
|
| 153 |
+ (run (.first-month-char) (make-string 1 :initial-element char)))) |
|
| 154 |
+ (st:should be == nil |
|
| 155 |
+ (run (.month) "32")) |
|
| 156 |
+ (st:should be == nil |
|
| 157 |
+ (run (.month) "71")) |
|
| 158 |
+ (st:should be == nil |
|
| 159 |
+ (run (.month) "0")) |
|
| 160 |
+ (st:should be == nil |
|
| 161 |
+ (run (.month) "aa")) |
|
| 162 |
+ (st:should be == `(("30" . ""))
|
|
| 163 |
+ (run (.prog1 (.month) (.not (.item))) "30")) |
|
| 164 |
+ (st:should be == `(("20" . ""))
|
|
| 165 |
+ (run (.prog1 (.month) (.not (.item))) "20")) |
|
| 166 |
+ (st:should be == `(("10" . ""))
|
|
| 167 |
+ (run (.prog1 (.month) (.not (.item))) "10")) |
|
| 168 |
+ (st:should be == `(("01" . ""))
|
|
| 169 |
+ (run (.prog1 (.month) (.not (.item))) "01"))) |
|
| 170 |
+ |
|
| 171 |
+(st:deftest time-range-test () |
|
| 172 |
+ (st:should be == nil |
|
| 173 |
+ (run (.time-range) "00:00:00")) |
|
| 174 |
+ (st:should be == `(( (,(make-time-obj 0 0 0)) . "")) |
|
| 175 |
+ (run (.time-range) "00:00:00--")) |
|
| 176 |
+ (st:should be == `(( (,(make-time-obj 0 0 0)) . "")) |
|
| 177 |
+ (run (.time-range) "00:00--")) |
|
| 178 |
+ (st:should be == `(((,(make-time-obj 0 0 0) ,(make-time-obj 1 0 0)) . "")) |
|
| 179 |
+ (run (.time-range) "00:00:00--01:00:00")) |
|
| 180 |
+ (st:should be == `(((,(make-time-obj 0 0 0) ,(make-time-obj 1 0 0)) . "")) |
|
| 181 |
+ (run (.time-range) "00:00--01:00")) |
|
| 182 |
+ (st:should be == `(((,(make-time-obj 0 0 0) ,(make-time-obj 1 0 0) ,(make-time-mod 10 "mins")) . "")) |
|
| 183 |
+ (run (.time-range) "00:00--01:00+10mins")) |
|
| 184 |
+ (st:should be == `(((,(make-time-obj 0 0 0) ,(make-time-obj 1 0 0) ,(make-time-mod -10 "mins")) . "")) |
|
| 185 |
+ (run (.time-range) "00:00--01:00-10mins"))) |
|
| 186 |
+ |
|
| 187 |
+(st:deftest memo-test () |
|
| 188 |
+ (st:should be == '(("asdf" . ""))
|
|
| 189 |
+ (run (.client-name) "asdf:")) |
|
| 190 |
+ (st:should be == '(("asdf" . ""))
|
|
| 191 |
+ (run (.memo) (format nil " asdf"))) |
|
| 192 |
+ (st:should be == '((("asdf" "asdf") . ""))
|
|
| 193 |
+ (run (.memo-line) (format nil " asdf: asdf")))) |
|
| 194 |
+ |
|
| 195 |
+(st:deftest initial-space () |
|
| 196 |
+ (st:should signal invalid-whitespace |
|
| 197 |
+ (smug:parse (.initial-space) " ")) |
|
| 198 |
+ (st:should signal invalid-whitespace |
|
| 199 |
+ (smug:parse (.initial-space) (concatenate 'string |
|
| 200 |
+ (string #\tab) |
|
| 201 |
+ " "))) |
|
| 202 |
+ (st:should signal invalid-whitespace |
|
| 203 |
+ (smug:parse (.initial-space) (concatenate 'string |
|
| 204 |
+ (string #\tab) |
|
| 205 |
+ (string #\tab)))) |
|
| 206 |
+ (st:should signal invalid-whitespace |
|
| 207 |
+ (smug:parse (.initial-space) (concatenate 'string |
|
| 208 |
+ (string #\tab) |
|
| 209 |
+ " "))) |
|
| 210 |
+ (st:should be == (string #\tab) |
|
| 211 |
+ (smug:parse (.initial-space) (string #\tab))) |
|
| 212 |
+ (st:should be == " " |
|
| 213 |
+ (smug:parse (.initial-space) " "))) |
|
| 214 |
+ |
|
| 215 |
+(st:deftest date-test () |
|
| 216 |
+ (st:should be == nil |
|
| 217 |
+ (caar (smug:run (.date) "Monday 2020/01-01"))) |
|
| 218 |
+ (st:should be == (make-date-obj "Monday" 2020 01 01) |
|
| 219 |
+ (caar (smug:run (.date) "Monday, 2020-01-01"))) |
|
| 220 |
+ (st:should be == (make-date-obj "Monday" 2020 01 01) |
|
| 221 |
+ (caar (smug:run (.date) "Monday 2020-01-01"))) |
|
| 222 |
+ (st:should be == (make-date-obj "Monday" 2020 01 01) |
|
| 223 |
+ (caar (smug:run (.date) "Monday 2020/01/01")))) |
|
| 224 |
+ |
|
| 225 |
+(st:deftest generic-eq () |
|
| 226 |
+ "Note: this really should be in the equality package with the name == |
|
| 227 |
+ should-test only checks tests for _internal_ symbols." |
|
| 228 |
+ (st:should be eql t (== #\1 #\1)) |
|
| 229 |
+ (st:should be eql t (== 1 1)) |
|
| 230 |
+ (st:should be eql t (== "1" "1")) |
|
| 231 |
+ (st:should be eql t (== '("1") '("1")))
|
|
| 232 |
+ (st:should be eql t (== #("1") #("1")))
|
|
| 233 |
+ (st:should be eql t (== '(1 . 2) '(1 . 2))) |
|
| 234 |
+ (st:should be eql t (== '((1 . 2)) '((1 . 2)))) |
|
| 235 |
+ (st:should be eql t (== #1=(make-date-obj "Monday" 2020 01 01) #1#)) |
|
| 236 |
+ (st:should be eql t |
|
| 237 |
+ (== (make-date-obj "Monday" 2012 01 01) |
|
| 238 |
+ (make-date-obj "Monday" 2012 01 01))) |
|
| 239 |
+ (st:should be eql t |
|
| 240 |
+ (== (make-time-obj 00 00 00) |
|
| 241 |
+ (make-time-obj 00 00 00))) |
|
| 242 |
+ (st:should be eql t |
|
| 243 |
+ (== (make-time-mod 3 "mins") |
|
| 244 |
+ (make-time-mod 3 "mins"))) |
|
| 245 |
+ (st:should be eql t |
|
| 246 |
+ (== (list (make-time-mod 3 "mins")) |
|
| 247 |
+ (list (make-time-mod 3 "mins")))) |
|
| 248 |
+ (st:should be eql t |
|
| 249 |
+ (== #((make-time-mod 3 "mins")) |
|
| 250 |
+ #((make-time-mod 3 "mins"))))) |
| ... | ... |
@@ -1,7 +1,7 @@ |
| 1 | 1 |
(in-package #:timesheet.cli) |
| 2 | 2 |
|
| 3 | 3 |
(defparameter *interactive* nil) |
| 4 |
-(defparameter *version* "0:6") |
|
| 4 |
+(defparameter *version* "0:7") |
|
| 5 | 5 |
|
| 6 | 6 |
(defun unroll-date (date-obj) |
| 7 | 7 |
(with-slots (year month day) date-obj |
| ... | ... |
@@ -131,7 +131,7 @@ |
| 131 | 131 |
(labels ((sort-func (client) |
| 132 | 132 |
(apply #'compose |
| 133 | 133 |
(list-without-nulls |
| 134 |
- (when reverse #'nreverse) |
|
| 134 |
+ (when reverse #'nreverse) |
|
| 135 | 135 |
(when client |
| 136 | 136 |
(plambda (stable-sort :1 #'string-lessp :key #'client))) |
| 137 | 137 |
#'sort-by-date))) |
| ... | ... |
@@ -174,7 +174,7 @@ |
| 174 | 174 |
:description "Post hours to freshbooks (requires manual setup of Freshbooks keys)")) |
| 175 | 175 |
(group (:header "Self-test options") |
| 176 | 176 |
(flag :long-name "run-tests" |
| 177 |
- :description "Run the tests") |
|
| 177 |
+ :description "Run the tests") |
|
| 178 | 178 |
(enum :long-name "output-style" |
| 179 | 179 |
:description "The kind of output to produce" |
| 180 | 180 |
:default-value :normal |