* netlink/error.scm (&netlink-decoder-error)[sub-type]: New field.
* netlink/data.scm (get-next-deserialize, get-current-deserialize): Fill
it out.
---
netlink/data.scm | 13 +++++++++----
netlink/error.scm | 4 +++-
2 files changed, 12 insertions(+), 5 deletions(-)
diff --git a/netlink/data.scm b/netlink/data.scm
index c9b5fb8..ac95051 100644
--- a/netlink/data.scm
+++ b/netlink/data.scm
@@ -51,15 +51,20 @@
(match (assoc-ref decoder current-type)
((_ . type-alist)
(or (assoc-ref type-alist target-type)
- (assoc-ref type-alist 'default)))
+ (assoc-ref type-alist 'default)
+ (raise (condition (&netlink-decoder-error
+ (type current-type)
+ (sub-type target-type))))))
(#f (raise (condition (&netlink-decoder-error
- (type current-type)))))))
-
+ (type current-type)
+ (sub-type target-type)))))))
+
(define (get-current-deserialize decoder current-type)
(match (assoc-ref decoder current-type)
((current-deserialize . _) current-deserialize)
(#f (raise (condition (&netlink-decoder-error
- (type current-type)))))))
+ (type current-type)
+ (sub-type #f)))))))
(define (deserialize type decoder bv pos)
(let ((deserialize (get-current-deserialize decoder type)))
diff --git a/netlink/error.scm b/netlink/error.scm
index 3e101ed..fa1dba6 100644
--- a/netlink/error.scm
+++ b/netlink/error.scm
@@ -23,6 +23,7 @@
&netlink-decoder-error
netlink-decoder-error?
netlink-decoder-error-type
+ netlink-decoder-error-sub-type
&netlink-family-error
netlink-family-error?
@@ -57,7 +58,8 @@
;; No decoder for type
(define-condition-type &netlink-decoder-error &netlink-error
netlink-decoder-error?
- (type netlink-decoder-error-type))
+ (type netlink-decoder-error-type)
+ (sub-type netlink-decoder-error-sub-type))
;; Unknown protocol family
(define-condition-type &netlink-family-error &netlink-error
--
2.40.1
