From e92bc4d8a7548b8b012f7a6c022328e18159567d Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Thu, 8 Aug 2024 09:29:23 +0200
Subject: [PATCH] shape:record: always fill head with nil when shorter list is
 given

---
 shape/shape.lisp      | 5 ++++-
 storage/tracking.lisp | 4 ++--
 util.lisp             | 5 ++++-
 3 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/shape/shape.lisp b/shape/shape.lisp
index 518d445..4fdcc13 100644
--- a/shape/shape.lisp
+++ b/shape/shape.lisp
@@ -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))
diff --git a/storage/tracking.lisp b/storage/tracking.lisp
index 43300ac..21f956a 100644
--- a/storage/tracking.lisp
+++ b/storage/tracking.lisp
@@ -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) 
diff --git a/util.lisp b/util.lisp
index 18e6584..7c6024e 100644
--- a/util.lisp
+++ b/util.lisp
@@ -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))))