Skip to content
Snippets Groups Projects
Commit 28656f5e authored by David Byers's avatar David Byers
Browse files

Fixed issue #4. Improved error handling.

parent bf3b6cdf
Branches
Tags
1 merge request!6Resolve "Handle empty response from nominatim"
2020-07-24 David Byers <david.byers@liu.se>
Fix issue #4:
* olc.el (olc-shorten-compound): Better handling of empty response
from nominatim.
(olc-recover-compound): Detect empty response from nominatim.
(olc-position-of): New function.
(olc-encode): Use cl-check-type to detect invalid encoding
lengths.
(general): Make errors more consistent.
(olc-shorten): Correctly signal shortcode and padded errors.
(olc-shorten-compound): Correctly signal shortcode and padded
errors.
(olc-parse-code): Match padding only at pos so parsing continues
if there are zeros later on in the code. The correct codes were
considred invalid, but we got the wrong errors.
* olc.texi (Errors): Document all the errors.
* test/olctest.el: Improved error-checking assertion. Added
support for expected failures.
2020-07-23 David Byers <david.byers@liu.se> 2020-07-23 David Byers <david.byers@liu.se>
Fix issue #2: Fix issue #2:
......
...@@ -48,4 +48,5 @@ test: ...@@ -48,4 +48,5 @@ test:
-l ../olc.el \ -l ../olc.el \
-l olctest.el \ -l olctest.el \
-f olctest-batch-test \ -f olctest-batch-test \
$(TESTS) \
) )
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
;; Copyright (C) 2020 David Byers ;; Copyright (C) 2020 David Byers
;; ;;
;; Author: David Byers <david.byers@liu.se> ;; Author: David Byers <david.byers@liu.se>
;; Version: 1.0.2 ;; Version: 1.1.0
;; Package-Requires: ((emacs "25.1")) ;; Package-Requires: ((emacs "25.1"))
;; Keywords: extensions, lisp ;; Keywords: extensions, lisp
;; URL: https://gitlab.liu.se/davby02/olc ;; URL: https://gitlab.liu.se/davby02/olc
...@@ -56,17 +56,74 @@ ...@@ -56,17 +56,74 @@
;;; Custom errors: ;;; Custom errors:
(define-error 'olc-error "Error in open location code.") (define-error 'olc-error "Open location code error")
(define-error 'olc-parse-error (define-error 'olc-parse-error
"Parse error in open location code" 'olc-error) "Error parsing open location code" 'olc-error)
(define-error 'olc-parse-error-unexpected-end
"Unexpected end parsing open location code"
'olc-parse-error)
(define-error 'olc-parse-error-invalid-character
"Invalid character parsing open location code"
'olc-parse-error)
(define-error 'olc-parse-error-missing-plus
"Missing plus sign parsing open location code"
'olc-parse-error)
(define-error 'olc-parse-error-invalid-padding
"Invalid padding parsing open location code"
'olc-parse-error)
(define-error 'olc-parse-error-padded-shortcode
"Padded short code parsing open location code"
'olc-parse-error)
(define-error 'olc-parse-error-digit-after-padding
"Unexpected digit after padding parsing open location code"
'olc-parse-error)
(define-error 'olc-parse-error-empty-code
"Empty code when parsing open location code"
'olc-parse-error)
(define-error 'olc-decode-error (define-error 'olc-decode-error
"Error decoding open location code" 'olc-error) "Error decoding open location code"
(define-error 'olc-encode-error 'olc-error)
"Error encoding open location code" 'olc-error)
(define-error 'olc-decode-error-shortcode
"Short codes must be recovered before decoding"
'olc-decode-error)
(define-error 'olc-shorten-error (define-error 'olc-shorten-error
"Error shortening open location code" 'olc-error) "Error shortening open location code."
'olc-error)
(define-error 'olc-shorten-error-shortcode
"Code is already shortened"
'olc-shorten-error)
(define-error 'olc-shorten-error-padded
"Unable to shorten padded codes"
'olc-shorten-error)
(define-error 'olc-recover-error (define-error 'olc-recover-error
"Error recovering open location code" 'olc-error) "Error recovering open location code."
'olc-error)
(define-error 'olc-recover-error-reference-search-failed
"Reference location search failed"
'olc-recover-error)
(define-error 'olc-recover-error-reference-not-found
"Reference location not found"
'olc-recover-error)
(define-error 'olc-recover-error-invalid-reference
"Invalid reference location"
'olc-recover-error)
;;; Base 20 digits: ;;; Base 20 digits:
...@@ -137,11 +194,21 @@ SPEC is a list consisting of an error to catch, the error to ...@@ -137,11 +194,21 @@ SPEC is a list consisting of an error to catch, the error to
raise, and args for the raised error. raise, and args for the raised error.
\(fn (CATCH SIGNAL &rest ARGS) BODY...)" \(fn (CATCH SIGNAL &rest ARGS) BODY...)"
(declare (indent 1)) (declare (indent 1) (debug (listp &rest form)))
`(condition-case nil `(condition-case nil
,@body ,@body
(,(elt spec 0) (signal ',(elt spec 1) (list ,@(cddr spec)))))) (,(elt spec 0) (signal ',(elt spec 1) (list ,@(cddr spec))))))
(defsubst olc-position-of (char code)
"Find the leftmost position of CHAR in CODE."
(let ((index 0))
(catch 'result
(mapc (lambda (letter)
(when (= char letter)
(throw 'result index))
(setq index (1+ index)))
code))))
(defsubst olc-clip-latitude (lat) (defsubst olc-clip-latitude (lat)
"Clip LAT to -90,90." "Clip LAT to -90,90."
(max -90 (min 90 lat))) (max -90 (min 90 lat)))
...@@ -182,49 +249,50 @@ raise, and args for the raised error. ...@@ -182,49 +249,50 @@ raise, and args for the raised error.
(catch 'break (catch 'break
(while (< pos (length code)) (while (< pos (length code))
(olc-transform-error (olc-transform-error
(args-out-of-range olc-parse-error (args-out-of-range olc-parse-error-unexpected-end
"code too short" code (1+ pos)) code (1+ pos))
(cond ((eq (elt code pos) ?+) (throw 'break nil)) (cond ((eq (elt code pos) ?+) (throw 'break nil))
((eq (elt code pos) ?0) (throw 'break nil)) ((eq (elt code pos) ?0) (throw 'break nil))
((= (length pairs) 4) (throw 'break nil)) ((= (length pairs) 4) (throw 'break nil))
((not (olc-valid-char (elt code pos))) ((not (olc-valid-char (elt code pos)))
(signal 'olc-parse-error (signal 'olc-parse-error-invalid-character
(list "invalid character" pos code))) (list code pos (string (elt code pos)))))
((not (olc-valid-char (elt code (1+ pos)))) ((not (olc-valid-char (elt code (1+ pos))))
(signal 'olc-parse-error (signal 'olc-parse-error-invalid-character
(list "invalid character" (1+ pos) code))) (list code (1+ pos)
(string (elt code (1+ pos))))))
(t (setq pairs (cons (cons (elt code pos) (t (setq pairs (cons (cons (elt code pos)
(elt code (1+ pos))) (elt code (1+ pos)))
pairs))))) pairs)))))
(setq pos (+ pos 2)))) (setq pos (+ pos 2))))
;; Measure the padding ;; Measure the padding
(when (string-match "0+" code pos) (when (eq pos (string-match "0+" code pos))
(setq pos (match-end 0) (setq pos (match-end 0)
padding (- (match-end 0) (match-beginning 0)))) padding (- (match-end 0) (match-beginning 0))))
;; Parse the separator ;; Parse the separator
(olc-transform-error (olc-transform-error
(args-out-of-range olc-parse-error (args-out-of-range olc-parse-error-unexpected-end
"code too short" code pos) code pos)
(if (eq (elt code pos) ?+) (if (eq (elt code pos) ?+)
(setq pos (1+ pos)) (setq pos (1+ pos))
(signal 'olc-parse-error (signal 'olc-parse-error-missing-plus
(list "missing separator" pos code)))) (list code pos))))
;; Check the length of the padding ;; Check the length of the padding
(unless (and (= (% padding 2) 0) (unless (and (= (% padding 2) 0)
(<= (+ padding (* 2 (length pairs))) 8)) (<= (+ padding (* 2 (length pairs))) 8))
(signal 'olc-parse-error (signal 'olc-parse-error-invalid-padding
(list "incorrect padding length" pos code))) (list code pos)))
;; Determine if the code is shortened or not ;; Determine if the code is shortened or not
(setq short (< (+ (* 2 (length pairs)) padding) 8)) (setq short (< (+ (* 2 (length pairs)) padding) 8))
;; We cant be short and have padding (not sure why) ;; We cant be short and have padding (not sure why)
(when (and short (> padding 0)) (when (and short (> padding 0))
(signal 'olc-parse-error (signal 'olc-parse-error-padded-shortcode
(list "padded codes can't be shortened" pos code))) (list code pos)))
;; Determine the precision of the code ;; Determine the precision of the code
(setq precision (- 8 padding)) (setq precision (- 8 padding))
...@@ -232,32 +300,38 @@ raise, and args for the raised error. ...@@ -232,32 +300,38 @@ raise, and args for the raised error.
;; Parse what's after the separator ;; Parse what's after the separator
(when (< pos (length code)) (when (< pos (length code))
(when (> padding 0) (when (> padding 0)
(signal 'olc-parse-error (signal 'olc-parse-error-digit-after-padding
(list "padding followed by data" pos code))) (list code pos (string (elt code pos)))))
;; Parse one more pair ;; Parse one more pair
(olc-transform-error (olc-transform-error (args-out-of-range
(args-out-of-range olc-parse-error olc-parse-error-unexpected-end
"code too short" code (1+ pos)) code (1+ pos))
(setq pairs (cons (cons (elt code pos) (cond ((not (olc-valid-char (elt code pos)))
(elt code (1+ pos))) (signal 'olc-parse-error-invalid-character
pairs) (list code pos (string (elt code pos)))))
pos (+ 2 pos) ((not (olc-valid-char (elt code (1+ pos))))
precision (+ 2 precision))) (signal 'olc-parse-error-invalid-character
(list code (1+ pos) (string (elt code (1+ pos))))))
(t (setq pairs (cons (cons (elt code pos)
(elt code (1+ pos)))
pairs)
pos (+ 2 pos)
precision (+ 2 precision))))))
;; Parse grid ;; Parse grid
(while (< pos (length code)) (while (< pos (length code))
(cond ((not (olc-valid-char (elt code pos))) (cond ((not (olc-valid-char (elt code pos)))
(signal 'olc-parse-error (signal 'olc-parse-error-invalid-character
(list "invalid character" pos code))) (list code pos (string (elt code pos)))))
((>= (length grid) 5) (setq pos (1+ pos))) ((>= (length grid) 5) (setq pos (1+ pos)))
(t (setq grid (cons (elt code pos) grid) (t (setq grid (cons (elt code pos) grid)
pos (1+ pos) pos (1+ pos)
precision (1+ precision)))))) precision (1+ precision)))))
;; Check for an empty code ;; Check for an empty code
(unless pairs (unless pairs
(signal 'olc-parse-error (list "invalid code" 0 code))) (signal 'olc-parse-error-empty-code (list code 0)))
;; Return the result ;; Return the result
(olc-parse-create :pairs (nreverse pairs) (olc-parse-create :pairs (nreverse pairs)
...@@ -339,19 +413,14 @@ invalid." ...@@ -339,19 +413,14 @@ invalid."
(cl-defun olc-encode (lat lon &key (len 10)) (cl-defun olc-encode (lat lon &key (len 10))
"Encode LAT and LON as a LEN length open location code. "Encode LAT and LON as a LEN length open location code.
LEN is automatically clipped to between 2 and 15. LEN is automatically clipped to between 2 and 15. Invalid values
`olc-encode-error' is raised if it is otherwise invalid (i.e. 3, raise an error."
5, 7, or 9). If LEN is not specified, it defaults to 10.
Returns an olc-area structure. Raises olc-encode-error if the
values cannot (legally) be encoded to the selected length."
(cl-check-type lat number) (cl-check-type lat number)
(cl-check-type lon number) (cl-check-type lon number)
(cl-check-type len integer) (cl-check-type len integer)
(setq len (max 2 (min 15 len))) (setq len (max 2 (min 15 len)))
(when (and (< len 11) (/= (% len 2) 0)) (cl-check-type len (member 2 4 6 8 10 11 12 13 14 15))
(signal 'olc-encode-error "invalid encoding length"))
(setq lat (olc-normalize-latitude lat len) (setq lat (olc-normalize-latitude lat len)
lon (olc-normalize-longitude lon)) lon (olc-normalize-longitude lon))
...@@ -413,7 +482,7 @@ differences, however, are extremely small." ...@@ -413,7 +482,7 @@ differences, however, are extremely small."
;; We only deal with long codes ;; We only deal with long codes
(when (olc-parse-short parse) (when (olc-parse-short parse)
(signal 'olc-decode-error code)) (signal 'olc-decode-error-shortcode (list code)))
;; Process the pairs ;; Process the pairs
(mapc (lambda (pair) (mapc (lambda (pair)
...@@ -454,14 +523,15 @@ shortened code, of if LIMIT is not positive and even." ...@@ -454,14 +523,15 @@ shortened code, of if LIMIT is not positive and even."
(cl-check-type lon number) (cl-check-type lon number)
(cl-check-type limit (member 2 4 6 8 10 12)) (cl-check-type limit (member 2 4 6 8 10 12))
(when (olc-is-short code)
(signal 'olc-shorten-error-shortcode
(list code)))
(let* ((parse (olc-parse-code code)) (let* ((parse (olc-parse-code code))
(area (olc-decode parse))) (area (olc-decode parse)))
(when (olc-is-short parse)
(signal 'olc-shorten-error
(list "can't shorten shortened codes" code)))
(when (< (olc-parse-precision parse) 8) (when (< (olc-parse-precision parse) 8)
(signal 'olc-shorten-error (signal 'olc-shorten-error-padded
(list "can't shorten padded codes" code))) (list code)))
(setq lat (olc-clip-latitude lat) (setq lat (olc-clip-latitude lat)
lon (olc-normalize-longitude lon)) lon (olc-normalize-longitude lon))
...@@ -503,64 +573,75 @@ faster. ...@@ -503,64 +573,75 @@ faster.
(cl-check-type limit (member 2 4 6 8 10 12)) (cl-check-type limit (member 2 4 6 8 10 12))
(cl-check-type zoom (or integer listp)) (cl-check-type zoom (or integer listp))
(save-match-data (when (olc-is-short code)
(let* ((area (olc-decode code)) (signal 'olc-shorten-error-shortcode
(zoom-lo (cond ((numberp zoom) zoom) (list code)))
((listp zoom) (elt zoom 0))
(t (signal 'args-out-of-range zoom)))) (let* ((parse (olc-parse-code code))
(zoom-hi (cond ((numberp zoom) zoom) (area (olc-decode code))
((listp zoom) (elt zoom 1)) (zoom-lo (cond ((numberp zoom) zoom)
(t (signal 'args-out-of-range zoom)))) ((listp zoom) (elt zoom 0))
result) (t (signal 'args-out-of-range (list '(1 18) zoom)))))
(zoom-hi (cond ((numberp zoom) zoom)
;; Check that zoom range is not inverted ((listp zoom) (elt zoom 1))
(when (or (< zoom-hi zoom-lo) (t (signal 'args-out-of-range (list '(1 18) zoom)))))
(< zoom-hi 1) (> zoom-hi 18) result)
(< zoom-lo 1) (> zoom-lo 18))
(signal 'args-out-of-range zoom)) ;; Check for padding
(when (< (olc-parse-precision parse) 8)
;; Otherwise we may never hit the high limit (signal 'olc-shorten-error-padded
(setq zoom-hi (1+ zoom-hi)) (list code)))
(catch 'result ;; Check that zoom range is not inverted
(while (< zoom-lo zoom-hi) (when (or (< zoom-hi zoom-lo)
(let* ((zoom (floor (+ zoom-lo zoom-hi) 2)) (< zoom-hi 1) (> zoom-hi 18)
(resp (request-response-data (< zoom-lo 1) (> zoom-lo 18))
(request (signal 'args-out-of-range (list '(1 18) zoom)))
"https://nominatim.openstreetmap.org/reverse"
:params `((lat . ,(olc-area-lat area)) ;; Otherwise we may never hit the high limit
(lon . ,(olc-area-lon area)) (setq zoom-hi (1+ zoom-hi))
(zoom . ,zoom)
(format . "json")) (catch 'result
:parser #'json-read (while (< zoom-lo zoom-hi)
:sync t))) (let* ((zoom (floor (+ zoom-lo zoom-hi) 2))
(tmp-code (resp (request-response-data
(when resp (request
(olc-shorten code "https://nominatim.openstreetmap.org/reverse"
(string-to-number :params `((lat . ,(olc-area-lat area))
(alist-get 'lat resp)) (lon . ,(olc-area-lon area))
(string-to-number (zoom . ,zoom)
(alist-get 'lon resp)) (format . "json"))
:limit limit))) :parser #'json-read
(padlen (when (string-match "+" tmp-code) :sync t)))
(- 8 (match-beginning 0))))) (tmp-code
(when resp
(olc-shorten code
(string-to-number (alist-get 'lat resp))
(string-to-number (alist-get 'lon resp))
:limit limit)))
(padlen
(when tmp-code (- 8 (olc-position-of ?+ tmp-code)))))
;; If resp is nil, then there's no point in going further
(if (null resp)
(setq zoom-lo zoom-hi)
;; Keep the shortest code we see that has at most limit ;; Keep the shortest code we see that has at most limit
;; chars removed ;; chars removed
(when (and (<= padlen limit) (when (and (<= padlen limit)
(or (null result) (or (null result)
(< (length tmp-code) (length (car result))))) (< (length tmp-code) (length (car result)))))
(setq result (cons tmp-code (setq result (cons tmp-code (alist-get 'display_name resp))))
(alist-get 'display_name resp))))
;; Zoom in or out ;; Zoom in or out
(if (< padlen limit) (if (< padlen limit)
(setq zoom-lo (1+ zoom)) (setq zoom-lo (1+ zoom))
(setq zoom-hi zoom)))) (setq zoom-hi zoom)))))
(if (and result (> 8 (progn (string-match "+" (car result)) (if (and result (< (olc-position-of ?+ (car result)) 8))
(match-end 0)))) (concat (car result) " " (cdr result))
(concat (car result) " " (cdr result)) code))))
code)))))
(cl-defun olc-recover (code lat lon &key (format 'area)) (cl-defun olc-recover (code lat lon &key (format 'area))
...@@ -622,7 +703,7 @@ If FORMAT is `area' (or any other value), the returned value is an ...@@ -622,7 +703,7 @@ If FORMAT is `area' (or any other value), the returned value is an
full open location code." full open location code."
;; Make sure we can do requests ;; Make sure we can do requests
(save-match-data (save-match-data
(unless (fboundp 'request) (signal 'void-function 'request)) (unless (fboundp 'request) (signal 'void-function '(request)))
;; Check types (defer check of ref) ;; Check types (defer check of ref)
(cl-check-type code stringp) (cl-check-type code stringp)
...@@ -648,9 +729,12 @@ full open location code." ...@@ -648,9 +729,12 @@ full open location code."
;; Check that we got a response ;; Check that we got a response
(unless (eq 200 (request-response-status-code resp)) (unless (eq 200 (request-response-status-code resp))
(signal 'olc-recover-error (signal 'olc-recover-error-reference-search-failed
(list "error decoding reference" (list code ref)))
(request-response-status-code resp))))
(unless (> (length (request-response-data resp)) 0)
(signal 'olc-recover-error-reference-not-found
(list code ref)))
(let* ((data (elt (request-response-data resp) 0)) (let* ((data (elt (request-response-data resp) 0))
(lat (alist-get 'lat data)) (lat (alist-get 'lat data))
...@@ -658,9 +742,8 @@ full open location code." ...@@ -658,9 +742,8 @@ full open location code."
;; Check that we have a lat and lon ;; Check that we have a lat and lon
(unless (and lat lon) (unless (and lat lon)
(signal 'olc-recover-error (signal 'olc-recover-error-invalid-reference
(list "reference location missing lat or lon" (list code ref)))
data)))
;; Finally recover the code! ;; Finally recover the code!
(olc-recover code (olc-recover code
......
No preview for this file type
...@@ -26,11 +26,12 @@ languages, see https://github.com/google/open-location-code. ...@@ -26,11 +26,12 @@ languages, see https://github.com/google/open-location-code.
@menu @menu
* Data types:: Data types defined by olc. * Data types:: Data types defined by olc.
* Errors:: Errors raised by olc.
* Functions:: Functions defined by olc. * Functions:: Functions defined by olc.
* Index:: Type and function index. * Index:: Type and function index.
@end menu @end menu
@node Data types,Functions,,Top @node Data types,Errors,,Top
@unnumbered Data types @unnumbered Data types
olc defines two data types: olc-area and olc-parse. The former olc defines two data types: olc-area and olc-parse. The former
...@@ -117,7 +118,105 @@ but don't count on this. ...@@ -117,7 +118,105 @@ but don't count on this.
@end defun @end defun
@node Functions,,Data types,Top @node Errors,Functions,Data types,Top
@unnumberedsec Errors
@table @code
@item olc-error
The message is @samp{Open location code error}. This is the parent of
all errors in olc.
@item olc-parse-error
The message is @samp{Error parsing open location code}. This is the
parent of the various parse errors. All parse errors have the same
associated data: (@var{code} @var{pos} @var{data}...), where @var{pos}
is the approximate position of the parse error, @var{code} is the
code being parsed, and @var{data} depends on the error.
@item olc-parse-error-unexpected-end
The message is @samp{Unexpected end parsing open location
code}. Raised when the code is incomplete.
@item olc-parse-error-invalid-character
The message is @samp{Invalid character parsing open location
code}. Raised when an invalid character is encountered. @var{data} is
a string containing the invalid character.
@item olc-parse-error-missing-plus
The message is @samp{Missing plus sign parsing open location
code}. Raised when the plus sign is missing.
@item olc-parse-error-invalid-padding
The message is @samp{Invalid padding parsing open location
code}. Raised when the padding is invalid (e.g. odd in length).
@item olc-parse-error-padded-shortcode
The message is @samp{Padded short code parsing open location
code}. Raised when parsing a code with padding that has been
shortened.
@item olc-parse-error-digit-after-padding
The message is @samp{Unexpected digit after padding parsing open
location code}. Raised when an unexpected digit is encountered
(e.g. after padding).
@item olc-parse-error-empty-code
The message is @samp{Empty code when parsing open location
code}. Raised when the code is empty (i.e. @samp{+}).
@item olc-decode-error
The message is @samp{Error decoding open location code}. The
associated data is a list containing the code being decoded as its
first element. This is the parent of the various decoding errors
raised by @code{olc-decode}.
@item olc-decode-error-shortcode
The message is @samp{Short codes must be recovered before
decoding}. This is raised when an attempt is made to decode a
shortened code.
@item olc-shorten-error
The message is @samp{Error shortening open location code}. The
associated data is a list containing the code being decoded as its
first element. This is the parent of the various shortening errors
raised by @code{olc-shorten} and @code{olc-shorten-compound}.
@item olc-shorten-error-shortcode
The message is @samp{Code is already shortened}. Raised when
attempting to shorten a shortened code.
@item olc-shorten-error-padding
The message is @samp{Unable to shorten padded codes}. Raised when
attempting to shorten a code with padding.
@item olc-recover-error
The message is @samp{Error recovering open location code}. The
associated data depends on the exact code, but is always a list with
the code being recovered as its first element. This is the parent of
the various recovery errors raised by @code{olc-recover} and
@code{olc-recover-compound}.
@item olc-recover-error-geocoding-request
The messags is @samp{Reference location search failed}. Raised when
geographical search fails due to an error at the HTTP layer. The
associated data is (@var{code}, @var{ref}) where @var{ref} is the
reference being searched.
@item olc-recover-error-geocoding-not-found
The messags is @samp{Reference location not found}. Raised when
geographical search returns no result. The associated data is
(@var{code}, @var{ref}) where @var{ref} is the reference being
searched.
@item olc-recover-error-geocoding-invalid
The messags is @samp{Invalid reference location}. Raised when
geographical search returns an invalid result. The associated data is
(@var{code}, @var{ref}) where @var{ref} is the reference being
searched.
@end table
@node Functions,Index,Errors,Top
@unnumberedsec Functions @unnumberedsec Functions
@defun olc-encode lat lon &key length @defun olc-encode lat lon &key length
......
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
(--olctest-current-case ,name)) (--olctest-current-case ,name))
(message "olctest running %s" ,name) (message "olctest running %s" ,name)
,@body ,@body
(olctest-report-results --olctest-results))) (olctest-report-results (reverse --olctest-results))))
(cl-defun olctest-record-failure (&key exp act msg) (cl-defun olctest-record-failure (&key exp act msg)
...@@ -47,6 +47,14 @@ ...@@ -47,6 +47,14 @@
(act . ,act)) (act . ,act))
--olctest-results))) --olctest-results)))
(defmacro olctest-expect-failure (name &rest body)
"Expect a failure."
(declare (indent 1) (debug (form &rest form)))
`(unless (let ((--olctest-results nil))
,@body
--olctest-results)
(olctest-record-failure :exp 'failure :act 'success :msg ,name)))
(defun olctest-report-results (results) (defun olctest-report-results (results)
"Report results from tests." "Report results from tests."
(if (null results) (if (null results)
...@@ -74,7 +82,13 @@ ...@@ -74,7 +82,13 @@
(declare (indent 1)) (declare (indent 1))
`(when (condition-case --olctest-caught-error `(when (condition-case --olctest-caught-error
(progn ,@body t) (progn ,@body t)
(,exp nil) ,@(mapcar (lambda (spec)
(cond ((symbolp spec) `(,spec nil))
((listp spec)
`(,(car spec)
(olctest-equal :exp ',spec :act --olctest-caught-error) nil))
(t (error "invalid olctest error specification"))))
exp)
(error (olctest-record-failure :exp ',exp :act --olctest-caught-error :msg ,msg) nil)) (error (olctest-record-failure :exp ',exp :act --olctest-caught-error :msg ,msg) nil))
(olctest-record-failure :exp ',exp :act 'noerror :msg ,msg))) (olctest-record-failure :exp ',exp :act 'noerror :msg ,msg)))
...@@ -244,7 +258,11 @@ ...@@ -244,7 +258,11 @@
(len (alist-get 'len case)) (len (alist-get 'len case))
(shortcode (alist-get 'exp case)) (shortcode (alist-get 'exp case))
(actual (olc-shorten fullcode lat lon :limit len))) (actual (olc-shorten fullcode lat lon :limit len)))
(olctest-string= :exp shortcode :act actual :msg len))))) (olctest-string= :exp shortcode :act actual :msg len)))
(olctest-equal :act (olc-shorten-compound "546FWWM2+F6")
:exp "WWM2+F6 Adamstown, Pitcairn")
))
(defun olctest-issue-3 () (defun olctest-issue-3 ()
...@@ -413,16 +431,91 @@ ...@@ -413,16 +431,91 @@
)) ))
(defun olctest-errors ()
(olctest-testcase "local:errors"
(olctest-assert-error (:exp ((olc-parse-error-unexpected-end "22" 2)) :msg "P1")
(olc-parse-code "22"))
(olctest-assert-error (:exp ((olc-parse-error-invalid-character "O2+" 0 "O")) :msg "P2")
(olc-parse-code "O2+"))
(olctest-assert-error (:exp ((olc-parse-error-invalid-character "2O+" 1 "O")) :msg "P3")
(olc-parse-code "2O+"))
(olctest-assert-error (:exp ((olc-parse-error-invalid-character "20+" 1 "0")) :msg "P4")
(olc-parse-code "20+"))
(olctest-assert-error (:exp ((olc-parse-error-unexpected-end "FFFFFFFF" 8)) :msg "P5")
(olc-parse-code "FFFFFFFF"))
(olctest-assert-error (:exp ((olc-parse-error-missing-plus "FFFFFFFFF" 8)) :msg "P6")
(olc-parse-code "FFFFFFFFF"))
(olctest-assert-error (:exp ((olc-parse-error-padded-shortcode "FF0000+" 7)) :msg "P7")
(olc-parse-code "FF0000+"))
(olctest-assert-error (:exp ((olc-parse-error-invalid-padding "FF00000+" 8)) :msg "P8")
(olc-parse-code "FF00000+"))
(olctest-assert-error (:exp ((olc-parse-error-digit-after-padding "FF000000+FF" 9 "F")) :msg "P9")
(olc-parse-code "FF000000+FF"))
(olctest-assert-error (:exp ((olc-parse-error-unexpected-end "FFFFFFFF+F" 10)) :msg "P10")
(olc-parse-code "FFFFFFFF+F"))
(olctest-assert-error (:exp ((olc-parse-error-invalid-character "FFFFFFFF+F0" 10 "0")) :msg "P11")
(olc-parse-code "FFFFFFFF+F0"))
(olctest-assert-error (:exp ((olc-parse-error-invalid-character "FFFFFFFF+FF0" 11 "0")) :msg "P12")
(olc-parse-code "FFFFFFFF+FF0"))
(olctest-assert-error (:exp ((olc-parse-error-empty-code "+" 0)) :msg "P13")
(olc-parse-code "+"))
(olctest-assert-error (:exp ((olc-decode-error-shortcode "22+")) :msg "D1")
(olc-decode "22+"))
(olctest-assert-error (:exp ((olc-shorten-error-padded "22222200+")) :msg "S1")
(olc-shorten "22222200+" 0 0))
(olctest-assert-error (:exp ((olc-shorten-error-shortcode "22+")) :msg "S2")
(olc-shorten-compound "22+"))
(olctest-assert-error (:exp ((olc-shorten-error-padded "FFFFFF00+")) :msg "S3")
(olc-shorten-compound "FFFFFF00+"))
(olctest-assert-error (:exp ((olc-recover-error-reference-not-found
"22+" "Nowhere Special, Pitcairn")) :msg "R1")
(olc-recover-compound "22+ Nowhere Special, Pitcairn"))
(olctest-expect-failure "R2"
(let ((olc-nominatim-url "https://invalid.domain/nominatim"))
(olctest-assert-error (:exp ((olc-recover-error-reference-search-failed
"22+" "Sweden")) :msg "R2")
(olc-recover-compound "22+ Sweden"))))
))
(defmacro run-test (arg)
`(or (null (ignore-errors olctest-selected-tests))
(not (memq ',arg olctest-selected-tests))
(funcall (intern (concat "olctest-" (symbol-name ',arg))))))
(defun olctest-run-all () (defun olctest-run-all ()
"Run all tests." "Run all tests."
(and (olctest-decode) (let ((olctest-selected-tests
(olctest-encode) (mapcar 'intern command-line-args-left)))
(olctest-shortcodes) (and (run-test decode)
(olctest-validity) (run-test encode)
(olctest-localtests) (run-test shortcodes)
(olctest-issue-3) (run-test validity)
(olctest-issue-2) (run-test localtests)
(olctest-issue-1) (run-test errors)
(run-test issue-3)
(run-test issue-2)
(run-test issue-1)
)
)) ))
(defun olctest-batch-test () (defun olctest-batch-test ()
...@@ -431,3 +524,4 @@ ...@@ -431,3 +524,4 @@
(olctest-run-all) (olctest-run-all)
(error (message (format "error: %s %s" (car err) (cdr err))) nil)) (error (message (format "error: %s %s" (car err) (cdr err))) nil))
0 1))) 0 1)))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment