shape:record: always fill head with nil when shorter list is given
This commit is contained in:
parent
8488eeb26c
commit
e92bc4d8a7
3 changed files with 10 additions and 4 deletions
|
@ -11,9 +11,12 @@
|
|||
(defclass record ()
|
||||
((head-fields :reader head-fields :initarg :head-fields
|
||||
:initform '(:taskid :username) :allocation :class)
|
||||
(head :accessor head :initarg :head)
|
||||
(head :reader head :initarg :head)
|
||||
(data :accessor data :initarg :data :initform nil)))
|
||||
|
||||
(defmethod initialize-instance :after ((rec record) &key head &allow-other-keys)
|
||||
(setf (slot-value rec 'head) (util:rfill (head-fields rec) head)))
|
||||
|
||||
(defun head-plist (rec)
|
||||
(let (pl (hv (head rec)))
|
||||
(dolist (hf (head-fields rec))
|
||||
|
|
|
@ -128,7 +128,7 @@
|
|||
;;;; auxiliary functions for queries, ...
|
||||
|
||||
(defun track-equal (old new)
|
||||
(unless (equal (util:rtrim (shape:head old)) (util:rtrim (shape:head new)))
|
||||
(unless (equal (shape:head old) (shape:head new))
|
||||
(return-from track-equal nil))
|
||||
(if (timestamp new)
|
||||
(unless (equal (timestamp new) (timestamp old))
|
||||
|
@ -168,7 +168,7 @@
|
|||
(when row
|
||||
(let ((hv (mapcar #'(lambda (x) (util:to-keyword (getf row x)))
|
||||
(shape:head-fields tr))))
|
||||
(setf (shape:head tr) hv)
|
||||
(setf (slot-value tr 'shape:head) hv)
|
||||
(setf (trackid tr) (getf row :trackid))
|
||||
(setf (timestamp tr) (getf row :timestamp))
|
||||
(setf (shape:data tr)
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
(defpackage :scopes/util
|
||||
(:use :common-lisp)
|
||||
(:export #:lg #:lgd #:lgi
|
||||
#:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
|
||||
#:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
|
||||
#:flatten-str #:to-keyword #:keyword-to-string #:to-string
|
||||
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
|
||||
#:relative-path #:runtime-path #:system-path))
|
||||
|
@ -20,6 +20,9 @@
|
|||
|
||||
;;;; lists and loops
|
||||
|
||||
(defun rfill (ll ls)
|
||||
(mapcar #'(lambda (x) (pop ls)) ll))
|
||||
|
||||
(defun rtrim (lst)
|
||||
(nreverse (member-if #'identity (reverse lst))))
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue