Ticket #1119: gen_sprintf2.pl.patch

tools/dev/gen_sprintf2.pl

@@ +1 @@
+#!perl
+# Copyright (C) 2001-2009, Parrot Foundation.
+# $Id: sprintf2.t 36833 2009-02-17 20:09:26Z allison $
+
+use strict;
+use warnings;
+use lib qw( . lib ../lib ../../lib );
+
+=head1 NAME
+
+t/op/sprintf2.t - Auxilliary tests for the sprintf opcode
+
+=head1 SYNOPSIS
+
+    % prove t/op/sprintf2.t
+
+=head1 DESCRIPTION
+
+Executes sprintf tests that sprintf.t can't handle yet.
+
+=cut
+
+# [ 'format', [arguments], "expected output", 'description' ]
+my @tests = (
+    [ '<%*d>',  [ 4,  12 ], "<  12>", 'positive length' ],
+    [ '<%*d>',  [ -4, 12 ], "<12  >", 'negative length' ],
+    [ '<%-*d>', [ 4,  12 ], "<12  >", 'minus option, positive length' ],
+    [
+        '|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|',
+        [ 65, 65, 65, 65, 65, 65, 3, 65, -4, 65 ],
+        "|A|A|A|A|A     |     A|  A|A   |",
+        'misc w/ minus option'
+    ],
+    [ '<%*s>',  [ 4,  '"hi"' ], "<  hi>", 'string, positive length' ],
+    [ '<%*s>',  [ -4, '"hi"' ], "<hi  >", 'string, negative length' ],
+    [ '<%-*s>', [ 4,  '"hi"' ], "<hi  >", 'string, minus flag' ],
+    [ '<%*.*f>', [ 7,  2, 123.456 ], "< 123.46>", 'float length&prec' ],
+    [ '<%*.*f>', [ -7, 2, 123.456 ], "<123.46 >", 'float -length&prec' ],
+);
+
+my $test_count = scalar @tests;
+
+my $code;
+my $calls;
+foreach my $test (@tests) {
+    my $sub_name = $$test[3];
+    $sub_name =~ s/ +/_/g;
+    $sub_name =~ s/-/neg_/g;
+    $sub_name =~ s/&/_and_/g;
+    $sub_name =~ s![,/]!_!g;
+    $calls .= "    $sub_name()\n";
+
+    $code .= ".sub $sub_name\n" . "  \$P0 = new 'ResizablePMCArray'\n";
+    foreach my $arg ( @{ $$test[1] } ) {
+        $code .= "  push \$P0,$arg\n";
+    }
+    $code .=
+        "  \$S0 = sprintf '$$test[0]', \$P0\n"
+      . "  is( \$S0, '$$test[2]', '$$test[3]' )\n"
+      . ".end\n\n";
+}
+
+print <<"TEMPLATE";
+.sub main :main
+    .include 'test_more.pir'
+
+    plan($test_count)
+
+    $calls
+.end
+
+$code
+TEMPLATE
+
+# Local Variables:
+#   mode: perl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=perl: