From 754a7660a1716998b557aedeb805ee9040afdcdf Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 19 Nov 2022 17:23:04 +0100
Subject: records: 'match-record' checks fields at macro-expansion time.

This allows 'match-record' to be more efficient (field offsets are
computed at compilation time) and to report unknown fields at
macro-expansion time.

* guix/records.scm (map-fields): New macro.
(define-record-type*)[rtd-identifier]: New procedure.
Define TYPE as a macro and use a separate identifier for the RTD.
(lookup-field, match-record-inner): New macros.
(match-record): Rewrite in terms of 'match-error-inner'.
* tests/records.scm ("match-record, simple")
("match-record, unknown field"): New tests.
* gnu/services/cuirass.scm (cuirass-shepherd-service): Rename 'log-file'
local variable to 'main-log-file'.
* gnu/services/getmail.scm (serialize-getmail-configuration-file): Move
after <getmail-configuration-file> definition.
---
 tests/records.scm | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

(limited to 'tests')

diff --git a/tests/records.scm b/tests/records.scm
index 00c58b0736..8504c8d5a5 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -528,4 +528,37 @@ Description: 1st line,
                  '("a" "b" "c")
                  '("a")))
 
+(test-equal "match-record, simple"
+  '((1 2) (a b))
+  (let ()
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (first  foo-first (default 1))
+      (second foo-second))
+
+    (list (match-record (foo (second 2)) <foo>
+            (first second)
+            (list first second))
+          (match-record (foo (first 'a) (second 'b)) <foo>
+            (second first)
+            (list first second)))))
+
+(test-equal "match-record, unknown field"
+  'syntax-error
+  (catch 'syntax-error
+    (lambda ()
+      (eval '(begin
+               (use-modules (guix records))
+
+               (define-record-type* <foo> foo make-foo
+                 foo?
+                 (first  foo-first (default 1))
+                 (second foo-second))
+
+               (match-record (foo (second 2)) <foo>
+                 (one two)
+                 #f))
+            (make-fresh-user-module)))
+    (lambda (key . args) key)))
+
 (test-end)
-- 
cgit v1.2.3


From b129026e2e242e9068158ae6e6fcd8d7c5ea092e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 10 Dec 2022 10:56:48 +0100
Subject: deduplicate: Use 'sendfile' for small file copies.

* guix/store/deduplication.scm (dump-file/deduplicate): Use 'sendfile'
instead of 'dump-port'.
* tests/store-deduplication.scm ("copy-file/deduplicate, below %deduplication-minimum-size"):
New test.
---
 guix/store/deduplication.scm  |  4 ++--
 tests/store-deduplication.scm | 17 ++++++++++++++++-
 2 files changed, 18 insertions(+), 3 deletions(-)

(limited to 'tests')

diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index ab982e3b3d..9953675319 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Caleb Ristvedt <caleb.ristvedt@cune.org>
-;;; Copyright © 2018-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -262,7 +262,7 @@ down the road."
       (deduplicate file (dump-and-compute-hash) #:store store)
       (call-with-output-file file
         (lambda (output)
-          (dump-port input output size)))))
+          (sendfile output input size 0)))))
 
 (define* (copy-file/deduplicate source target
                                 #:key (store (%store-directory)))
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index 2950fbc1a3..f1845035d8 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2020-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -136,6 +136,21 @@
        (cons (apply = (map (compose stat:ino stat) identical))
              (map (compose stat:nlink stat) identical))))))
 
+(test-assert "copy-file/deduplicate, below %deduplication-minimum-size"
+  (call-with-temporary-directory
+   (lambda (store)
+     (let ((source (string-append store "/input")))
+       (call-with-output-file source
+         (lambda (port)
+           (display "Hello!\n" port)))
+       (copy-file/deduplicate source
+                              (string-append store "/a")
+                              #:store store)
+       (and (not (directory-exists? (string-append store "/.links")))
+            (file=? source (string-append store "/a"))
+            (not (= (stat:ino (stat (string-append store "/a")))
+                    (stat:ino (stat source)))))))))
+
 (test-assert "copy-file/deduplicate"
   (call-with-temporary-directory
    (lambda (store)
-- 
cgit v1.2.3