From 970cd314defc28a78e3ddb7a1e58c6a183b2849c Mon Sep 17 00:00:00 2001
From: Joe Thornber <ejt@redhat.com>
Date: Fri, 25 Aug 2017 11:26:45 +0100
Subject: [PATCH] [functional-tests/temp-file] temp-file-sized

---
 functional-tests/temp-file.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/functional-tests/temp-file.scm b/functional-tests/temp-file.scm
index c313180..407e5a6 100644
--- a/functional-tests/temp-file.scm
+++ b/functional-tests/temp-file.scm
@@ -7,8 +7,10 @@
     with-dir
     with-temp-file-thunk
     with-temp-file-containing-thunk
+    with-temp-file-sized-thunk
     with-temp-file
     with-temp-file-containing
+    with-temp-file-sized
     disable-unlink)
 
   (import (chezscheme)
@@ -87,6 +89,26 @@
                 (with-temp-file-containing (rest ...)
                                            b1 b2 ...))))))
 
+   (define (with-temp-file-sized-thunk size fn)
+     (with-temp-file-thunk
+       (lambda (path)
+         (let ((cmd (fmt #f (dsp "fallocate -l ") (wrt size) (dsp " ") (dsp path))))
+          (system cmd)
+          (fn path)))))
+
+   (define-syntax with-temp-file-sized
+     (syntax-rules ()
+       ((_ ((v size)) b1 b2 ...)
+        (with-temp-file-sized-thunk
+          size
+          (lambda (v)
+            b1 b2 ...)))
+
+       ((_ ((v size) rest ...) b1 b2 ...)
+        (with-temp-file-sized-thunk
+          size (lambda (v)
+                 (with-temp-file-sized (rest ...) b1 b2 ...))))))
+
    ;;-------------------------
 
    (define should-unlink #t)