Ticket #1119: gen_sprintf2.pl.patch

File gen_sprintf2.pl.patch, 2.2 KB (added by mgrimes, 5 years ago)
  • tools/dev/gen_sprintf2.pl

     
     1#!perl 
     2# Copyright (C) 2001-2009, Parrot Foundation. 
     3# $Id: sprintf2.t 36833 2009-02-17 20:09:26Z allison $ 
     4 
     5use strict; 
     6use warnings; 
     7use lib qw( . lib ../lib ../../lib ); 
     8 
     9=head1 NAME 
     10 
     11t/op/sprintf2.t - Auxilliary tests for the sprintf opcode 
     12 
     13=head1 SYNOPSIS 
     14 
     15    % prove t/op/sprintf2.t 
     16 
     17=head1 DESCRIPTION 
     18 
     19Executes sprintf tests that sprintf.t can't handle yet. 
     20 
     21=cut 
     22 
     23# [ 'format', [arguments], "expected output", 'description' ] 
     24my @tests = ( 
     25    [ '<%*d>',  [ 4,  12 ], "<  12>", 'positive length' ], 
     26    [ '<%*d>',  [ -4, 12 ], "<12  >", 'negative length' ], 
     27    [ '<%-*d>', [ 4,  12 ], "<12  >", 'minus option, positive length' ], 
     28    [ 
     29        '|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|', 
     30        [ 65, 65, 65, 65, 65, 65, 3, 65, -4, 65 ], 
     31        "|A|A|A|A|A     |     A|  A|A   |", 
     32        'misc w/ minus option' 
     33    ], 
     34    [ '<%*s>',  [ 4,  '"hi"' ], "<  hi>", 'string, positive length' ], 
     35    [ '<%*s>',  [ -4, '"hi"' ], "<hi  >", 'string, negative length' ], 
     36    [ '<%-*s>', [ 4,  '"hi"' ], "<hi  >", 'string, minus flag' ], 
     37    [ '<%*.*f>', [ 7,  2, 123.456 ], "< 123.46>", 'float length&prec' ], 
     38    [ '<%*.*f>', [ -7, 2, 123.456 ], "<123.46 >", 'float -length&prec' ], 
     39); 
     40 
     41my $test_count = scalar @tests; 
     42 
     43my $code; 
     44my $calls; 
     45foreach my $test (@tests) { 
     46    my $sub_name = $$test[3]; 
     47    $sub_name =~ s/ +/_/g; 
     48    $sub_name =~ s/-/neg_/g; 
     49    $sub_name =~ s/&/_and_/g; 
     50    $sub_name =~ s![,/]!_!g; 
     51    $calls .= "    $sub_name()\n"; 
     52 
     53    $code .= ".sub $sub_name\n" . "  \$P0 = new 'ResizablePMCArray'\n"; 
     54    foreach my $arg ( @{ $$test[1] } ) { 
     55        $code .= "  push \$P0,$arg\n"; 
     56    } 
     57    $code .= 
     58        "  \$S0 = sprintf '$$test[0]', \$P0\n" 
     59      . "  is( \$S0, '$$test[2]', '$$test[3]' )\n" 
     60      . ".end\n\n"; 
     61} 
     62 
     63print <<"TEMPLATE"; 
     64.sub main :main 
     65    .include 'test_more.pir' 
     66 
     67    plan($test_count) 
     68 
     69    $calls 
     70.end 
     71 
     72$code 
     73TEMPLATE 
     74 
     75# Local Variables: 
     76#   mode: perl 
     77#   cperl-indent-level: 4 
     78#   fill-column: 100 
     79# End: 
     80# vim: expandtab shiftwidth=4 ft=perl: