shape:record: always fill head with nil when shorter list is given

This commit is contained in:
Helmut Merz 2024-08-08 09:29:23 +02:00
parent 8488eeb26c
commit e92bc4d8a7
3 changed files with 10 additions and 4 deletions

View file

@ -11,9 +11,12 @@
(defclass record () (defclass record ()
((head-fields :reader head-fields :initarg :head-fields ((head-fields :reader head-fields :initarg :head-fields
:initform '(:taskid :username) :allocation :class) :initform '(:taskid :username) :allocation :class)
(head :accessor head :initarg :head) (head :reader head :initarg :head)
(data :accessor data :initarg :data :initform nil))) (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) (defun head-plist (rec)
(let (pl (hv (head rec))) (let (pl (hv (head rec)))
(dolist (hf (head-fields rec)) (dolist (hf (head-fields rec))

View file

@ -128,7 +128,7 @@
;;;; auxiliary functions for queries, ... ;;;; auxiliary functions for queries, ...
(defun track-equal (old new) (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)) (return-from track-equal nil))
(if (timestamp new) (if (timestamp new)
(unless (equal (timestamp new) (timestamp old)) (unless (equal (timestamp new) (timestamp old))
@ -168,7 +168,7 @@
(when row (when row
(let ((hv (mapcar #'(lambda (x) (util:to-keyword (getf row x))) (let ((hv (mapcar #'(lambda (x) (util:to-keyword (getf row x)))
(shape:head-fields tr)))) (shape:head-fields tr))))
(setf (shape:head tr) hv) (setf (slot-value tr 'shape:head) hv)
(setf (trackid tr) (getf row :trackid)) (setf (trackid tr) (getf row :trackid))
(setf (timestamp tr) (getf row :timestamp)) (setf (timestamp tr) (getf row :timestamp))
(setf (shape:data tr) (setf (shape:data tr)

View file

@ -3,7 +3,7 @@
(defpackage :scopes/util (defpackage :scopes/util
(:use :common-lisp) (:use :common-lisp)
(:export #:lg #:lgd #:lgi (: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 #:flatten-str #:to-keyword #:keyword-to-string #:to-string
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
#:relative-path #:runtime-path #:system-path)) #:relative-path #:runtime-path #:system-path))
@ -20,6 +20,9 @@
;;;; lists and loops ;;;; lists and loops
(defun rfill (ll ls)
(mapcar #'(lambda (x) (pop ls)) ll))
(defun rtrim (lst) (defun rtrim (lst)
(nreverse (member-if #'identity (reverse lst)))) (nreverse (member-if #'identity (reverse lst))))