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>
Fix test cases:
......
Makefile
+ 11
− 0
View file @ f277e2be
......@@ -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
......
olc.el
+ 52
− 34
View file @ f277e2be
......@@ -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)
......
test/olctest.el
+ 168
− 99
View file @ f277e2be
......@@ -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 ()
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment