Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
O
olc
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Requirements
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Test cases
Artifacts
Deploy
Releases
Package registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Issue analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
David Byers
olc
Commits
28656f5e
Commit
28656f5e
authored
4 years ago
by
David Byers
Browse files
Options
Downloads
Patches
Plain Diff
Fixed issue
#4
. Improved error handling.
parent
bf3b6cdf
Branches
Branches containing commit
Tags
Tags containing commit
1 merge request
!6
Resolve "Handle empty response from nominatim"
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
CHANGELOG
+23
-0
23 additions, 0 deletions
CHANGELOG
Makefile
+1
-0
1 addition, 0 deletions
Makefile
olc.el
+190
-107
190 additions, 107 deletions
olc.el
olc.info
+103
-7
103 additions, 7 deletions
olc.info
olc.texi
+101
-2
101 additions, 2 deletions
olc.texi
test/olctest.el
+105
-11
105 additions, 11 deletions
test/olctest.el
with
523 additions
and
127 deletions
CHANGELOG
+
23
−
0
View file @
28656f5e
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:
...
...
This diff is collapsed.
Click to expand it.
Makefile
+
1
−
0
View file @
28656f5e
...
@@ -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
)
\
)
)
This diff is collapsed.
Click to expand it.
olc.el
+
190
−
107
View file @
28656f5e
...
@@ -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
...
...
This diff is collapsed.
Click to expand it.
olc.info
+
103
−
7
View file @
28656f5e
No preview for this file type
This diff is collapsed.
Click to expand it.
olc.texi
+
101
−
2
View file @
28656f5e
...
@@ -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,
Function
s,,Top
@node Data types,
Error
s,,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
...
...
This diff is collapsed.
Click to expand it.
test/olctest.el
+
105
−
11
View file @
28656f5e
...
@@ -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
)))
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment