diff --git a/CHANGELOG b/CHANGELOG
index 370675d18ab9ad7b2297ded26904c1cd4ef79cbf..0261a616cc4d2063c2d55ffdc9a39029e8afec3f 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,13 @@
+2020-07-23 David Byers <david.byers@liu.se>
+
+ Fix issue #1 (olc-recover-compound fails on full codes):
+ * test/olctest.el: Improved test macros. Tests for issue 1.
+
+ * olc.el (general): Whitespace fixes.
+ (olc-recover-error): New error.
+ (olc-recover-compound): New argument list. Type checks. Handle
+ full codes being passed.
+
2020-07-22 David Byers <david.byers@liu.se>
Fix test cases:
diff --git a/Makefile b/Makefile
index c760d85a20975aa2069a64e5d9852841736e890a..e84406c2838450399eb0e7c88d0abafb2e8e1f2f 100644
--- a/Makefile
+++ b/Makefile
@@ -22,6 +22,17 @@
all: olc.elc olc.info
+check:
+ emacs --batch \
+ --eval "(setq-default indent-tabs-mode nil)" \
+ -f package-initialize \
+ -l elisp-lint \
+ -f elisp-lint-files-batch \
+ --no-check-declare \
+ --no-indent \
+ olc.el ; \
+ rm -f olc-autoloads.el olc-autoloads.el~
+
olc.elc: olc.el
emacs --batch -f batch-byte-compile olc.el
diff --git a/olc.el b/olc.el
index a43a90a183c2cb9623e360662e0bb316d9f1d9ba..0d59bad7638ec66f7d3abf424a88b4d4a2ac7ac5 100644
--- a/olc.el
+++ b/olc.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2020 David Byers
;;
;; Author: David Byers <david.byers@liu.se>
-;; Version: 1.0
+;; Version: 1.0.1
;; Package-Requires: ((emacs "25.1"))
;; Keywords: extensions, lisp
;; URL: https://gitlab.liu.se/davby02/olc
@@ -25,12 +25,12 @@
;;; Commentary:
;; This program provides basic open location code support in Emacs
-;; Lisp. The support for recovering shortened codes depends on the
+;; Lisp. The support for recovering shortened codes depends on the
;; request library and uses OpenStreetMap; please check the terms of
;; use for the service to ensure that you remain compliant.
;;
;; All methods required by the open location code specification are
-;; provided in some form. The implementation passed the tests present
+;; provided in some form. The implementation passed the tests present
;; in the open location code github repository at the time of writing
;; almost cleanly -- there are some minor rounding issues in decode.
@@ -65,6 +65,8 @@
"Error encoding open location code" 'olc-error)
(define-error 'olc-shorten-error
"Error shortening open location code" 'olc-error)
+(define-error 'olc-recover-error
+ "Error recovering open location code" 'olc-error)
;;; Base 20 digits:
@@ -354,13 +356,13 @@ values cannot (legally) be encoded to the selected length."
(defun olc-decode (code)
"Decode open location code CODE.
-Returns an `olc-area' structure. Raises `olc-parse-error' if the
+Returns an `olc-area' structure. Raises `olc-parse-error' if the
code can't be parsed, and `olc-decode-error' if it can't be
decoded (e.g. a padded shortened code, a padded code with grid
coordinates, an empty code, and so forth).
Since this function uses floating point calculations, the results
-are not identical to e.g. the C++ reference implementation. The
+are not identical to e.g. the C++ reference implementation. The
differences, however, are extremely small."
(let* ((parse (olc-parse-code code))
(latscale (* (expt 20 4) (expt 5 5)))
@@ -469,7 +471,8 @@ faster.
(while (< zoom-lo zoom-hi)
(let* ((zoom (floor (+ zoom-lo zoom-hi) 2))
(resp (request-response-data
- (request "https://nominatim.openstreetmap.org/reverse"
+ (request
+ "https://nominatim.openstreetmap.org/reverse"
:params `((lat . ,(olc-area-lat area))
(lon . ,(olc-area-lon area))
(zoom . ,zoom)
@@ -545,43 +548,58 @@ full open location code."
(olc-encode lat lon :len (olc-parse-precision parse)))))))
-(cl-defun olc-recover-compound (arg1 &optional arg2 &key (format 'area))
- "Recover a location from a short code and reference.
+(cl-defun olc-recover-compound (code &key ref (format 'area))
+ "Recover a location from a compound code CODE.
-When called with one argument, ARG1, it must be a string
-consisting of a shortened open location code followed by
-whitespace and a geographical location.
-
-When called with two strings, ARG1 and ARG2, the first must be a
-shortened open location code and the second if the geographical
-location.
+Optional keyword argument REF indicates the reference to use. If
+not specified, the reference is assumed to be embedded into CODE.
If FORMAT is `area' (or any other value), the returned value is an
full open location code."
- (unless (fboundp 'request)
- (error "`request' library is not loaded"))
-
- (let (code reference)
- (cond ((and (stringp arg1) (not (stringp arg2)))
- (if (string-match "^\\(\\S-+\\)\\s-+\\(.*\\)$" arg1)
- (setq code (match-string 1 arg1)
- reference (match-string 2 arg1))
- (signal 'wrong-type-argument arg1)))
- ((and (stringp arg1) (stringp arg2))
- (setq code arg1 reference arg2))
- (t (signal 'wrong-type-argument arg1)))
+ ;; Make sure we can do requests
+ (unless (fboundp 'request) (signal 'void-function 'request))
+
+ ;; Check types (defer check of ref
+ (cl-check-type code stringp)
+ (cl-check-type format (member latlon area nil))
+
+ (if (string-match "^\\(\\S-+\\)\\s-+\\(.*\\)$" code)
+ (progn (cl-check-type ref null)
+ (setq ref (match-string 2 code)
+ code (match-string 1 code)))
+ (cl-check-type ref stringp))
+
+ ;; If the code is full then return it
+ (if (olc-is-full code)
+ code
(let ((resp (request "https://nominatim.openstreetmap.org/search"
- :params `((q . ,reference)
+ :params `((q . ,ref)
(format . "json")
(limit . 1))
:parser #'json-read
:sync t)))
- (when (eq 200 (request-response-status-code resp))
- (let ((data (elt (request-response-data resp) 0)))
- (olc-recover code
- (string-to-number (alist-get 'lat data))
- (string-to-number (alist-get 'lon data))
- :format format))))))
+
+ ;; Check that we got a response
+ (unless (eq 200 (request-response-status-code resp))
+ (signal 'olc-recover-error
+ (list "error decoding reference"
+ (request-response-status-code resp))))
+
+ (let* ((data (elt (request-response-data resp) 0))
+ (lat (alist-get 'lat data))
+ (lon (alist-get 'lon data)))
+
+ ;; Check that we have a lat and lon
+ (unless (and lat lon)
+ (signal 'olc-recover-error
+ (list "reference location missing lat or lon"
+ data)))
+
+ ;; Finally recover the code!
+ (olc-recover code
+ (string-to-number lat)
+ (string-to-number lon)
+ :format format)))))
(provide 'olc)
diff --git a/test/olctest.el b/test/olctest.el
index ae67632c754f4a8b233077b2968d4aff0ccfb717..a1c02c16887d322fdc27d7ed8cba7e3007f87fbe 100644
--- a/test/olctest.el
+++ b/test/olctest.el
@@ -23,11 +23,62 @@
;; it only affects decoding, that is an insignificant error level.
(defvar olctest-decode-tolerance 0.0000000001)
-(defvar $olctest-results)
+(defvar --olctest-results)
+(defvar --olctest-current-case)
+
+
+(defmacro olctest-testcase (name &rest body)
+ "Set up an open location code test case."
+ (declare (indent 1)
+ (debug (form &rest form)))
+ `(let ((--olctest-results nil)
+ (--olctest-current-case ,name))
+ (message "olctest running %s" ,name)
+ ,@body
+ (olctest-report-results --olctest-results)))
+
+
+(cl-defun olctest-record-failure (&key exp act msg)
+ "Record a test failure."
+ (setq --olctest-results
+ (cons `((name . ,--olctest-current-case)
+ (msg . ,msg)
+ (exp . ,exp)
+ (act . ,act))
+ --olctest-results)))
+
+(defun olctest-report-results (results)
+ "Report results from tests."
+ (if (null results)
+ t
+ (dolist (result results)
+ (princ (format "%s:%s: expected %s got %s\n"
+ (alist-get 'name result)
+ (or (alist-get 'msg result) "-")
+ (alist-get 'exp result)
+ (alist-get 'act result))))))
+
+(cl-defun olctest-string= (&key exp act msg)
+ (unless (string= exp act)
+ (olctest-record-failure :exp exp :act act :msg msg)))
+
+(cl-defun olctest-equal (&key exp act msg)
+ (unless (equal exp act)
+ (olctest-record-failure :exp exp :act act :msg msg)))
+
+(cl-defmacro olctest-assert-error ((&key exp msg) &rest body)
+ (declare (indent 1))
+ `(when (condition-case --olctest-caught-error
+ (progn ,@body t)
+ (,exp nil)
+ (error (olctest-record-failure :exp ',exp :act --olctest-caught-error :msg ,msg) nil))
+ (olctest-record-failure :exp ',exp :act 'noerror :msg ,msg)))
+
(defun olctest-read-csv (filename)
"Read a CSV file with test data."
- (let ((buffer (generate-new-buffer "*olctest*")))
+ (let ((buffer (generate-new-buffer "*olctest*"))
+ (lineno 1))
(unwind-protect
(save-window-excursion
(set-buffer buffer)
@@ -38,27 +89,29 @@
(unless (re-search-forward "^# Format.*:$" nil t)
(error "format line not found in test data"))
(forward-line 1)
+ (setq lineno (1+ lineno))
(beginning-of-line)
(looking-at "^# *\\(\\S-*\\)")
(let ((columns (split-string (match-string 1) "," nil))
(cases nil))
(while (= 0 (forward-line 1))
+ (setq lineno (1+ lineno))
(beginning-of-line)
(cond ((looking-at "^#"))
((looking-at "^\\s-*$"))
((looking-at "^\\(\\S-+\\)$")
(setq cases
- (cons
- (cl-mapcar (lambda (key val)
- (cons (intern key)
- (cond ((string-match "^[-0-9.]+$" val)
- (string-to-number val))
- ((string= val "true") t)
- ((string= val "false") nil)
- (t val))))
- columns
- (split-string (match-string 1) "," nil))
- cases)))
+ (cons `((lineno . , lineno)
+ ,@(cl-mapcar (lambda (key val)
+ (cons (intern key)
+ (cond ((string-match "^[-0-9.]+$" val)
+ (string-to-number val))
+ ((string= val "true") t)
+ ((string= val "false") nil)
+ (t val))))
+ columns
+ (split-string (match-string 1) "," nil)))
+ cases)))
(t (error (format "unable to parse test data: %s"
(buffer-substring
(point)
@@ -72,12 +125,11 @@
\(fn (VAR LIST) BODY...)"
(declare (indent 1) (debug ((form symbolp) body)))
- (let ((data (gensym "$olctest")))
- `(let* ((,data (olctest-read-csv ,(elt spec 0)))
- ($olctest-results nil))
+ (let ((data (gensym "---olctest")))
+ `(let* ((,data (olctest-read-csv ,(elt spec 0))))
(dolist (,(elt spec 1) ,data)
- ,@body)
- (olctest-report-results $olctest-results))))
+ ,@body))))
+
(defmacro olctest-run-list (spec &rest body)
"Run open location code tests.
@@ -91,93 +143,82 @@
,@body)
(olctest-report-results $olctest-results))))
-(defun olctest-record-failure (case expected actual)
- "Record a test failure."
- (setq $olctest-results (cons `((case . ,case)
- (expected . ,expected)
- (actual . ,actual))
- $olctest-results)))
-
-(defun olctest-report-results (results)
- "Report results from tests."
- (if (null results)
- t
- (dolist (result results)
- (princ (format "%s: expected %s got %s\n"
- (mapconcat (lambda (val) (format "%s" (cdr val))) (alist-get 'case result) ",")
- (alist-get 'expected result)
- (alist-get 'actual result))))))
-
(defun olctest-encode ()
"Test encoding."
- (olctest-run-csv ("encoding.csv" case)
- (let ((code (olc-encode (alist-get 'latitude case)
- (alist-get 'longitude case)
- :len (alist-get 'length case))))
- (unless (string= code (alist-get 'expected case))
- (olctest-record-failure case (alist-get 'expected case) code)))))
+ (olctest-testcase "reference:encoding"
+ (olctest-run-csv ("encoding.csv" case)
+ (let ((code (olc-encode (alist-get 'latitude case)
+ (alist-get 'longitude case)
+ :len (alist-get 'length case))))
+ (olctest-string= :act code
+ :exp (alist-get 'expected case)
+ :msg (alist-get 'msg case))))))
(defun olctest-decode ()
"Test decoding."
- (olctest-run-csv ("decoding.csv" case)
- (let ((area (olc-decode (alist-get 'code case)))
- (exp-latlo (alist-get 'latLo case))
- (exp-lathi (alist-get 'latHi case))
- (exp-lonlo (alist-get 'lngLo case))
- (exp-lonhi (alist-get 'lngHi case))
- (exp-len (alist-get 'length case)))
- (unless (and (= exp-len (olc-code-precision (alist-get 'code case)))
- (< (abs (- (olc-area-latlo area) exp-latlo)) olctest-decode-tolerance)
- (< (abs (- (olc-area-lathi area) exp-lathi)) olctest-decode-tolerance)
- (< (abs (- (olc-area-lonlo area) exp-lonlo)) olctest-decode-tolerance)
- (< (abs (- (olc-area-lonhi area) exp-lonhi)) olctest-decode-tolerance))
- (olctest-record-failure case
- (format "%d,%f,%f,%f,%f" exp-len exp-latlo exp-lonlo exp-lathi exp-lonhi)
- (format "%d,%f,%f,%f,%f"
- (olc-code-precision (alist-get 'code case))
- (olc-area-latlo area)
- (olc-area-lonlo area)
- (olc-area-lathi area)
- (olc-area-lonhi area)))))))
+ (olctest-testcase "reference:decoding"
+ (olctest-run-csv ("decoding.csv" case)
+ (let ((area (olc-decode (alist-get 'code case)))
+ (exp-latlo (alist-get 'latLo case))
+ (exp-lathi (alist-get 'latHi case))
+ (exp-lonlo (alist-get 'lngLo case))
+ (exp-lonhi (alist-get 'lngHi case))
+ (exp-len (alist-get 'length case)))
+ (unless (and (= exp-len (olc-code-precision (alist-get 'code case)))
+ (< (abs (- (olc-area-latlo area) exp-latlo)) olctest-decode-tolerance)
+ (< (abs (- (olc-area-lathi area) exp-lathi)) olctest-decode-tolerance)
+ (< (abs (- (olc-area-lonlo area) exp-lonlo)) olctest-decode-tolerance)
+ (< (abs (- (olc-area-lonhi area) exp-lonhi)) olctest-decode-tolerance))
+ (olctest-record-failure
+ :exp (format "%d,%f,%f,%f,%f" exp-len exp-latlo exp-lonlo exp-lathi exp-lonhi)
+ :act (format "%d,%f,%f,%f,%f"
+ (olc-code-precision (alist-get 'code case))
+ (olc-area-latlo area)
+ (olc-area-lonlo area)
+ (olc-area-lathi area)
+ (olc-area-lonhi area))
+ :msg (alist-get 'lineno case)))))))
(defun olctest-shortcodes ()
"Test recovering."
- (olctest-run-csv ("shortCodeTests.csv" case)
- (let ((fullcode (alist-get 'fullcode case))
- (lat (alist-get 'lat case))
- (lon (alist-get 'lng case))
- (shortcode (alist-get 'shortcode case))
- (test-type (alist-get 'test_type case)))
-
- ;; Test recover
- (when (or (string= test-type "B") (string= test-type "R"))
- (let ((recovered (olc-recover shortcode lat lon)))
- (unless (string= recovered fullcode)
- (olctest-record-failure case fullcode recovered))))
-
- ;; Test shorten
- (when (or (string= test-type "B") (string= test-type "S"))
- (let ((shortened (olc-shorten fullcode lat lon)))
- (unless (string= shortened shortcode)
- (olctest-record-failure case shortcode shortened))))
- )))
+ (olctest-testcase "reference:shortcodes"
+ (olctest-run-csv ("shortCodeTests.csv" case)
+ (let ((fullcode (alist-get 'fullcode case))
+ (lat (alist-get 'lat case))
+ (lon (alist-get 'lng case))
+ (shortcode (alist-get 'shortcode case))
+ (test-type (alist-get 'test_type case))
+ (lineno (alist-get 'lineno case)))
+
+ ;; Test recover
+ (when (or (string= test-type "B") (string= test-type "R"))
+ (olctest-string= :act (olc-recover shortcode lat lon)
+ :exp fullcode
+ :msg lineno))
+
+ ;; Test shorten
+ (when (or (string= test-type "B") (string= test-type "S"))
+ (olctest-string= :act (olc-shorten fullcode lat lon)
+ :exp shortcode
+ :msg lineno))))))
(defun olctest-validity ()
"Test validity."
- (olctest-run-csv ("validityTests.csv" case)
- (let* ((code (alist-get 'code case))
- (expected (list (alist-get 'isValid case)
- (alist-get 'isShort case)
- (alist-get 'isFull case)))
- (actual (list (not (not (olc-is-valid code)))
- (not (not (olc-is-short code)))
- (not (not (olc-is-full code))))))
- (unless (equal expected actual)
- (olctest-record-failure case expected actual)))))
+ (olctest-testcase "reference:validity"
+ (olctest-run-csv ("validityTests.csv" case)
+ (let* ((code (alist-get 'code case))
+ (exp (list (alist-get 'isValid case)
+ (alist-get 'isShort case)
+ (alist-get 'isFull case)))
+ (act (list (not (not (olc-is-valid code)))
+ (not (not (olc-is-short code)))
+ (not (not (olc-is-full code))))))
+ (olctest-equal :exp exp :act act :msg code)))))
+
(defvar olctest-local-shorten-tests
'(((code . "9C3W9QCJ+2VX") (lat . 51.3701125) (lon . -1.217765625) (len . 8) (exp . "+2VX"))
@@ -186,15 +227,42 @@
((code . "9C3W9QCJ+2VX") (lat . 51.3701125) (lon . -1.217765625) (len . 2) (exp . "3W9QCJ+2VX"))))
(defun olctest-localtests ()
- (olctest-run-list (olctest-local-shorten-tests case)
- (let* ((fullcode (alist-get 'code case))
- (lat (alist-get 'lat case))
- (lon (alist-get 'lon case))
- (len (alist-get 'len case))
- (shortcode (alist-get 'exp case))
- (actual (olc-shorten fullcode lat lon :limit len)))
- (unless (string= actual shortcode)
- (olctest-record-failure case shortcode actual)))))
+ (olctest-testcase "local:misc"
+ (olctest-run-list (olctest-local-shorten-tests case)
+ (let* ((fullcode (alist-get 'code case))
+ (lat (alist-get 'lat case))
+ (lon (alist-get 'lon case))
+ (len (alist-get 'len case))
+ (shortcode (alist-get 'exp case))
+ (actual (olc-shorten fullcode lat lon :limit len)))
+ (olctest-string= :exp shortcode :act actual :msg len)))))
+
+
+(defun olctest-issue-1 ()
+ (olctest-testcase "local:issue-1"
+ (olctest-string= :exp "9FFV9VH8+9C"
+ :act (olc-recover-compound "9FFV9VH8+9C" :ref "Antarctica")
+ :msg "O1")
+
+ (olctest-string= :exp "9FFPMGGC+9C"
+ :act (olc-recover-compound "+9C Sweden")
+ :msg "O2")
+
+ (olctest-string= :exp "9FFPMGGC+9C"
+ :act (olc-recover-compound "+9C" :ref "Sweden")
+ :msg "O3")
+
+ (olctest-assert-error (:exp (wrong-type-argument) :msg "F1")
+ (olc-recover-compound nil))
+
+ (olctest-assert-error (:exp (wrong-type-argument) :msg "F2")
+ (olc-recover-compound "+9C Sweden" :ref "Norway"))
+
+ (olctest-assert-error (:exp (wrong-type-argument) :msg "F3")
+ (olc-recover-compound "+9C" :ref nil))
+
+ (olctest-assert-error (:exp (wrong-type-argument) :msg "F4")
+ (olc-recover-compound "+9C Sweden" :format 'undefined))))
(defun olctest-run-all ()
@@ -204,6 +272,7 @@
(olctest-shortcodes)
(olctest-validity)
(olctest-localtests)
+ (olctest-issue-1)
))
(defun olctest-batch-test ()