Test output buffering

Rakudo impl: rakudo/rakudo@f9c10c2145

S32-io/buffering.t

@@ -0,0 +1,83 @@
+use lib <t/spec/packages>;
+use Test;
+use Test::Util;
+
+plan 3;
+
+sub test-out-buffer (
+    Str:D $desc, &test, UInt:D :$buffer = 1000, UInt :$exp-bytes, Capture :$open-args = \(:w)
+) {
+    state $path = make-temp-file;
+    # print an empty string after open. It's allowed for implementation to pass the first print
+    # unbuffed, to test if the handle is writable
+    subtest "out-buffer for $desc" => {
+        plan 1;
+        $path.open(:w).close; # clear out the file
+        (my $fh := $path.open: :out-buffer($buffer), |$open-args).print: '';
+        test $fh;
+        cmp-ok $path.slurp(:bin).elems, '==', $exp-bytes,
+            'file contains expected number of bytes';
+        # note: it's expected for .close to be AFTER the file size check; the assumption is
+        # the user of the routine is checking file content before all buffers are flushed
+        $fh.close;
+    }
+}
+
+for \(:w), \(:rw), \(:a) -> $open-args {
+    subtest ".open: $open-args.perl()" => {
+        plan 10;
+        test-out-buffer :10buffer, :15exp-bytes, :$open-args, '1 x over', { .print: 'x' x 15 };
+        test-out-buffer :10buffer, :15exp-bytes, :$open-args, '1 x over + 1 x under', {
+            .print: 'x' x 15; .print: 'x' x 4;
+        };
+
+        test-out-buffer :10buffer, :19exp-bytes, :$open-args, '1 x over + 1 x under + .flush', {
+            .print: 'x' x 15; .print: 'x' x 4; .flush;
+        };
+
+        test-out-buffer :10buffer, :19exp-bytes, :$open-args, '1 x over + 1 x under + .close', {
+            .print: 'x' x 15; .print: 'x' x 4; .close;
+        };
+
+        test-out-buffer :10buffer, :38exp-bytes, :$open-args, '[1 x over + 1 x under + .flush]x2', {
+            .print: 'x' x 15; .print: 'x' x 4; .flush; .print: 'x' x 15; .print: 'x' x 4; .flush;
+        };
+
+        test-out-buffer :10buffer, :38exp-bytes, :$open-args,
+            '[1 x over + 1 x under + *] X [.flush, .close]', {
+            .print: 'x' x 15; .print: 'x' x 4; .flush; .print: 'x' x 15; .print: 'x' x 4; .close;
+        };
+
+        test-out-buffer :10buffer, :8exp-bytes, :$open-args,
+            '1 x under + buffer resize too small to hold original print', {
+            .print: 'x' x 8;
+            .out-buffer = 5; # expecting buffer resize to flush
+        };
+
+        test-out-buffer :10buffer, :8exp-bytes, :$open-args,
+            '1 x under + large buffer', {
+            .print: 'x' x 8;
+            .out-buffer = 1000; # expecting buffer resize to flush
+            .print: 'x' x 100;
+            .print: 'x' x 100;
+            .print: 'x' x 100;
+        };
+
+        test-out-buffer :10buffer, :508exp-bytes, :$open-args,
+            '1 x under + large buffer + over', {
+            .print: 'x' x 8;
+            .out-buffer = 1000; # expecting buffer resize to flush
+            .print: 'x' x 500;
+            .print: 'x' x 600;
+        };
+
+        test-out-buffer :10buffer, :1108exp-bytes, :$open-args,
+            '1 x under + large buffer + over + close', {
+            .print: 'x' x 8;
+            .out-buffer = 1000; # expecting buffer resize to flush
+            .print: 'x' x 500;
+            .print: 'x' x 600;
+            .flush;
+        };
+    }
+}