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

Handle full codes in olc-recover-compound

parent 006eae9f
No related branches found
No related tags found
1 merge request!1Resolve "olc-recover-compound fails on non-compound codes"
Hide whitespace changes
Inline Side-by-side
CHANGELOG
+ 10
− 0
View file @ f277e2be
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> 2020-07-22 David Byers <david.byers@liu.se>
Fix test cases: Fix test cases:
......
Makefile
+ 11
− 0
View file @ f277e2be
...@@ -22,6 +22,17 @@ ...@@ -22,6 +22,17 @@
all: olc.elc olc.info 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 olc.elc: olc.el
emacs --batch -f batch-byte-compile olc.el emacs --batch -f batch-byte-compile olc.el
......
olc.el
+ 52
− 34
View file @ f277e2be
...@@ -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 ;; Version: 1.0.1
;; 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
...@@ -25,12 +25,12 @@ ...@@ -25,12 +25,12 @@
;;; Commentary: ;;; Commentary:
;; This program provides basic open location code support in Emacs ;; 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 ;; request library and uses OpenStreetMap; please check the terms of
;; use for the service to ensure that you remain compliant. ;; use for the service to ensure that you remain compliant.
;; ;;
;; All methods required by the open location code specification are ;; 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 ;; in the open location code github repository at the time of writing
;; almost cleanly -- there are some minor rounding issues in decode. ;; almost cleanly -- there are some minor rounding issues in decode.
...@@ -65,6 +65,8 @@ ...@@ -65,6 +65,8 @@
"Error encoding open location code" 'olc-error) "Error encoding open location code" 'olc-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-recover-error
"Error recovering open location code" 'olc-error)
;;; Base 20 digits: ;;; Base 20 digits:
...@@ -354,13 +356,13 @@ values cannot (legally) be encoded to the selected length." ...@@ -354,13 +356,13 @@ values cannot (legally) be encoded to the selected length."
(defun olc-decode (code) (defun olc-decode (code)
"Decode open location code 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 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 decoded (e.g. a padded shortened code, a padded code with grid
coordinates, an empty code, and so forth). coordinates, an empty code, and so forth).
Since this function uses floating point calculations, the results 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." differences, however, are extremely small."
(let* ((parse (olc-parse-code code)) (let* ((parse (olc-parse-code code))
(latscale (* (expt 20 4) (expt 5 5))) (latscale (* (expt 20 4) (expt 5 5)))
...@@ -469,7 +471,8 @@ faster. ...@@ -469,7 +471,8 @@ faster.
(while (< zoom-lo zoom-hi) (while (< zoom-lo zoom-hi)
(let* ((zoom (floor (+ zoom-lo zoom-hi) 2)) (let* ((zoom (floor (+ zoom-lo zoom-hi) 2))
(resp (request-response-data (resp (request-response-data
(request "https://nominatim.openstreetmap.org/reverse" (request
"https://nominatim.openstreetmap.org/reverse"
:params `((lat . ,(olc-area-lat area)) :params `((lat . ,(olc-area-lat area))
(lon . ,(olc-area-lon area)) (lon . ,(olc-area-lon area))
(zoom . ,zoom) (zoom . ,zoom)
...@@ -545,43 +548,58 @@ full open location code." ...@@ -545,43 +548,58 @@ full open location code."
(olc-encode lat lon :len (olc-parse-precision parse))))))) (olc-encode lat lon :len (olc-parse-precision parse)))))))
(cl-defun olc-recover-compound (arg1 &optional arg2 &key (format 'area)) (cl-defun olc-recover-compound (code &key ref (format 'area))
"Recover a location from a short code and reference. "Recover a location from a compound code CODE.
When called with one argument, ARG1, it must be a string Optional keyword argument REF indicates the reference to use. If
consisting of a shortened open location code followed by not specified, the reference is assumed to be embedded into CODE.
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.
If FORMAT is `area' (or any other value), the returned value is an If FORMAT is `area' (or any other value), the returned value is an
full open location code." full open location code."
(unless (fboundp 'request) ;; Make sure we can do requests
(error "`request' library is not loaded")) (unless (fboundp 'request) (signal 'void-function 'request))
(let (code reference) ;; Check types (defer check of ref
(cond ((and (stringp arg1) (not (stringp arg2))) (cl-check-type code stringp)
(if (string-match "^\\(\\S-+\\)\\s-+\\(.*\\)$" arg1) (cl-check-type format (member latlon area nil))
(setq code (match-string 1 arg1)
reference (match-string 2 arg1)) (if (string-match "^\\(\\S-+\\)\\s-+\\(.*\\)$" code)
(signal 'wrong-type-argument arg1))) (progn (cl-check-type ref null)
((and (stringp arg1) (stringp arg2)) (setq ref (match-string 2 code)
(setq code arg1 reference arg2)) code (match-string 1 code)))
(t (signal 'wrong-type-argument arg1))) (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" (let ((resp (request "https://nominatim.openstreetmap.org/search"
:params `((q . ,reference) :params `((q . ,ref)
(format . "json") (format . "json")
(limit . 1)) (limit . 1))
:parser #'json-read :parser #'json-read
:sync t))) :sync t)))
(when (eq 200 (request-response-status-code resp))
(let ((data (elt (request-response-data resp) 0))) ;; Check that we got a response
(olc-recover code (unless (eq 200 (request-response-status-code resp))
(string-to-number (alist-get 'lat data)) (signal 'olc-recover-error
(string-to-number (alist-get 'lon data)) (list "error decoding reference"
:format format)))))) (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) (provide 'olc)
......
test/olctest.el
+ 168
− 99
View file @ f277e2be
...@@ -23,11 +23,62 @@ ...@@ -23,11 +23,62 @@
;; it only affects decoding, that is an insignificant error level. ;; it only affects decoding, that is an insignificant error level.
(defvar olctest-decode-tolerance 0.0000000001) (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) (defun olctest-read-csv (filename)
"Read a CSV file with test data." "Read a CSV file with test data."
(let ((buffer (generate-new-buffer "*olctest*"))) (let ((buffer (generate-new-buffer "*olctest*"))
(lineno 1))
(unwind-protect (unwind-protect
(save-window-excursion (save-window-excursion
(set-buffer buffer) (set-buffer buffer)
...@@ -38,27 +89,29 @@ ...@@ -38,27 +89,29 @@
(unless (re-search-forward "^# Format.*:$" nil t) (unless (re-search-forward "^# Format.*:$" nil t)
(error "format line not found in test data")) (error "format line not found in test data"))
(forward-line 1) (forward-line 1)
(setq lineno (1+ lineno))
(beginning-of-line) (beginning-of-line)
(looking-at "^# *\\(\\S-*\\)") (looking-at "^# *\\(\\S-*\\)")
(let ((columns (split-string (match-string 1) "," nil)) (let ((columns (split-string (match-string 1) "," nil))
(cases nil)) (cases nil))
(while (= 0 (forward-line 1)) (while (= 0 (forward-line 1))
(setq lineno (1+ lineno))
(beginning-of-line) (beginning-of-line)
(cond ((looking-at "^#")) (cond ((looking-at "^#"))
((looking-at "^\\s-*$")) ((looking-at "^\\s-*$"))
((looking-at "^\\(\\S-+\\)$") ((looking-at "^\\(\\S-+\\)$")
(setq cases (setq cases
(cons (cons `((lineno . , lineno)
(cl-mapcar (lambda (key val) ,@(cl-mapcar (lambda (key val)
(cons (intern key) (cons (intern key)
(cond ((string-match "^[-0-9.]+$" val) (cond ((string-match "^[-0-9.]+$" val)
(string-to-number val)) (string-to-number val))
((string= val "true") t) ((string= val "true") t)
((string= val "false") nil) ((string= val "false") nil)
(t val)))) (t val))))
columns columns
(split-string (match-string 1) "," nil)) (split-string (match-string 1) "," nil)))
cases))) cases)))
(t (error (format "unable to parse test data: %s" (t (error (format "unable to parse test data: %s"
(buffer-substring (buffer-substring
(point) (point)
...@@ -72,12 +125,11 @@ ...@@ -72,12 +125,11 @@
\(fn (VAR LIST) BODY...)" \(fn (VAR LIST) BODY...)"
(declare (indent 1) (debug ((form symbolp) body))) (declare (indent 1) (debug ((form symbolp) body)))
(let ((data (gensym "$olctest"))) (let ((data (gensym "---olctest")))
`(let* ((,data (olctest-read-csv ,(elt spec 0))) `(let* ((,data (olctest-read-csv ,(elt spec 0))))
($olctest-results nil))
(dolist (,(elt spec 1) ,data) (dolist (,(elt spec 1) ,data)
,@body) ,@body))))
(olctest-report-results $olctest-results))))
(defmacro olctest-run-list (spec &rest body) (defmacro olctest-run-list (spec &rest body)
"Run open location code tests. "Run open location code tests.
...@@ -91,93 +143,82 @@ ...@@ -91,93 +143,82 @@
,@body) ,@body)
(olctest-report-results $olctest-results)))) (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 () (defun olctest-encode ()
"Test encoding." "Test encoding."
(olctest-run-csv ("encoding.csv" case) (olctest-testcase "reference:encoding"
(let ((code (olc-encode (alist-get 'latitude case) (olctest-run-csv ("encoding.csv" case)
(alist-get 'longitude case) (let ((code (olc-encode (alist-get 'latitude case)
:len (alist-get 'length case)))) (alist-get 'longitude case)
(unless (string= code (alist-get 'expected case)) :len (alist-get 'length case))))
(olctest-record-failure case (alist-get 'expected case) code))))) (olctest-string= :act code
:exp (alist-get 'expected case)
:msg (alist-get 'msg case))))))
(defun olctest-decode () (defun olctest-decode ()
"Test decoding." "Test decoding."
(olctest-run-csv ("decoding.csv" case) (olctest-testcase "reference:decoding"
(let ((area (olc-decode (alist-get 'code case))) (olctest-run-csv ("decoding.csv" case)
(exp-latlo (alist-get 'latLo case)) (let ((area (olc-decode (alist-get 'code case)))
(exp-lathi (alist-get 'latHi case)) (exp-latlo (alist-get 'latLo case))
(exp-lonlo (alist-get 'lngLo case)) (exp-lathi (alist-get 'latHi case))
(exp-lonhi (alist-get 'lngHi case)) (exp-lonlo (alist-get 'lngLo case))
(exp-len (alist-get 'length case))) (exp-lonhi (alist-get 'lngHi case))
(unless (and (= exp-len (olc-code-precision (alist-get 'code case))) (exp-len (alist-get 'length case)))
(< (abs (- (olc-area-latlo area) exp-latlo)) olctest-decode-tolerance) (unless (and (= exp-len (olc-code-precision (alist-get 'code case)))
(< (abs (- (olc-area-lathi area) exp-lathi)) olctest-decode-tolerance) (< (abs (- (olc-area-latlo area) exp-latlo)) olctest-decode-tolerance)
(< (abs (- (olc-area-lonlo area) exp-lonlo)) olctest-decode-tolerance) (< (abs (- (olc-area-lathi area) exp-lathi)) olctest-decode-tolerance)
(< (abs (- (olc-area-lonhi area) exp-lonhi)) olctest-decode-tolerance)) (< (abs (- (olc-area-lonlo area) exp-lonlo)) olctest-decode-tolerance)
(olctest-record-failure case (< (abs (- (olc-area-lonhi area) exp-lonhi)) olctest-decode-tolerance))
(format "%d,%f,%f,%f,%f" exp-len exp-latlo exp-lonlo exp-lathi exp-lonhi) (olctest-record-failure
(format "%d,%f,%f,%f,%f" :exp (format "%d,%f,%f,%f,%f" exp-len exp-latlo exp-lonlo exp-lathi exp-lonhi)
(olc-code-precision (alist-get 'code case)) :act (format "%d,%f,%f,%f,%f"
(olc-area-latlo area) (olc-code-precision (alist-get 'code case))
(olc-area-lonlo area) (olc-area-latlo area)
(olc-area-lathi area) (olc-area-lonlo area)
(olc-area-lonhi area))))))) (olc-area-lathi area)
(olc-area-lonhi area))
:msg (alist-get 'lineno case)))))))
(defun olctest-shortcodes () (defun olctest-shortcodes ()
"Test recovering." "Test recovering."
(olctest-run-csv ("shortCodeTests.csv" case) (olctest-testcase "reference:shortcodes"
(let ((fullcode (alist-get 'fullcode case)) (olctest-run-csv ("shortCodeTests.csv" case)
(lat (alist-get 'lat case)) (let ((fullcode (alist-get 'fullcode case))
(lon (alist-get 'lng case)) (lat (alist-get 'lat case))
(shortcode (alist-get 'shortcode case)) (lon (alist-get 'lng case))
(test-type (alist-get 'test_type case))) (shortcode (alist-get 'shortcode case))
(test-type (alist-get 'test_type case))
;; Test recover (lineno (alist-get 'lineno case)))
(when (or (string= test-type "B") (string= test-type "R"))
(let ((recovered (olc-recover shortcode lat lon))) ;; Test recover
(unless (string= recovered fullcode) (when (or (string= test-type "B") (string= test-type "R"))
(olctest-record-failure case fullcode recovered)))) (olctest-string= :act (olc-recover shortcode lat lon)
:exp fullcode
;; Test shorten :msg lineno))
(when (or (string= test-type "B") (string= test-type "S"))
(let ((shortened (olc-shorten fullcode lat lon))) ;; Test shorten
(unless (string= shortened shortcode) (when (or (string= test-type "B") (string= test-type "S"))
(olctest-record-failure case shortcode shortened)))) (olctest-string= :act (olc-shorten fullcode lat lon)
))) :exp shortcode
:msg lineno))))))
(defun olctest-validity () (defun olctest-validity ()
"Test validity." "Test validity."
(olctest-run-csv ("validityTests.csv" case) (olctest-testcase "reference:validity"
(let* ((code (alist-get 'code case)) (olctest-run-csv ("validityTests.csv" case)
(expected (list (alist-get 'isValid case) (let* ((code (alist-get 'code case))
(alist-get 'isShort case) (exp (list (alist-get 'isValid case)
(alist-get 'isFull case))) (alist-get 'isShort case)
(actual (list (not (not (olc-is-valid code))) (alist-get 'isFull case)))
(not (not (olc-is-short code))) (act (list (not (not (olc-is-valid code)))
(not (not (olc-is-full code)))))) (not (not (olc-is-short code)))
(unless (equal expected actual) (not (not (olc-is-full code))))))
(olctest-record-failure case expected actual))))) (olctest-equal :exp exp :act act :msg code)))))
(defvar olctest-local-shorten-tests (defvar olctest-local-shorten-tests
'(((code . "9C3W9QCJ+2VX") (lat . 51.3701125) (lon . -1.217765625) (len . 8) (exp . "+2VX")) '(((code . "9C3W9QCJ+2VX") (lat . 51.3701125) (lon . -1.217765625) (len . 8) (exp . "+2VX"))
...@@ -186,15 +227,42 @@ ...@@ -186,15 +227,42 @@
((code . "9C3W9QCJ+2VX") (lat . 51.3701125) (lon . -1.217765625) (len . 2) (exp . "3W9QCJ+2VX")))) ((code . "9C3W9QCJ+2VX") (lat . 51.3701125) (lon . -1.217765625) (len . 2) (exp . "3W9QCJ+2VX"))))
(defun olctest-localtests () (defun olctest-localtests ()
(olctest-run-list (olctest-local-shorten-tests case) (olctest-testcase "local:misc"
(let* ((fullcode (alist-get 'code case)) (olctest-run-list (olctest-local-shorten-tests case)
(lat (alist-get 'lat case)) (let* ((fullcode (alist-get 'code case))
(lon (alist-get 'lon case)) (lat (alist-get 'lat case))
(len (alist-get 'len case)) (lon (alist-get 'lon case))
(shortcode (alist-get 'exp case)) (len (alist-get 'len case))
(actual (olc-shorten fullcode lat lon :limit len))) (shortcode (alist-get 'exp case))
(unless (string= actual shortcode) (actual (olc-shorten fullcode lat lon :limit len)))
(olctest-record-failure case shortcode actual))))) (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 () (defun olctest-run-all ()
...@@ -204,6 +272,7 @@ ...@@ -204,6 +272,7 @@
(olctest-shortcodes) (olctest-shortcodes)
(olctest-validity) (olctest-validity)
(olctest-localtests) (olctest-localtests)
(olctest-issue-1)
)) ))
(defun olctest-batch-test () (defun olctest-batch-test ()
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment