lib/dumpvar.t

   1 #!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use strict;
   9
  10 $|=1;
  11
  12 my @prgs;
  13 {
  14     local $/;
  15     @prgs = split "########\n", <DATA>;
  16     close DATA;
  17 }
  18
  19 use Test::More;
  20
  21 plan tests => scalar @prgs;
  22
  23 require "dumpvar.pl";
  24
  25 sub unctrl    { print dumpvar::unctrl($_[0]), "\n" }
  26 sub uniescape { print dumpvar::uniescape($_[0]), "\n" }
  27 sub stringify { print dumpvar::stringify($_[0]), "\n" }
  28
  29 package Foo;
  30
  31 sub new { my $class = shift; bless [ @_ ], $class }
  32
  33 package Bar;
  34
  35 sub new { my $class = shift; bless [ @_ ], $class }
  36
  37 use overload '""' => sub { "Bar<@{$_[0]}>" };
  38
  39 package main;
  40
  41 my $foo = Foo->new(1..5);
  42 my $bar = Bar->new(1..5);
  43
  44 for (@prgs) {
  45     my($prog, $expected) = split(/\nEXPECT\n?/, $_);
  46     # TODO: dumpvar::stringify() is controlled by a pile of package
  47     # dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify,
  48     # and so forth.  We need to test with various settings of those.
  49     my $out = tie *STDOUT, 'TieOut';
  50     eval $prog;
  51     my $ERR = $@;
  52     untie $out;
  53     if ($ERR) {
  54         ok(0, "$prog - $ERR");
  55     } else {
  56         if ($expected =~ m:^/:) {
  57             like($$out, $expected, $prog);
  58         } else {
  59             is($$out, $expected, $prog);
  60         }
  61     }
  62 }
  63
  64 package TieOut;
  65
  66 sub TIEHANDLE {
  67     bless( \(my $self), $_[0] );
  68 }
  69
  70 sub PRINT {
  71     my $self = shift;
  72     $$self .= join('', @_);
  73 }
  74
  75 sub read {
  76     my $self = shift;
  77     substr( $$self, 0, length($$self), '' );
  78 }
  79
  80 __END__
  81 unctrl("A");
  82 EXPECT
  83 A
  84 ########
  85 unctrl("\cA");
  86 EXPECT
  87 ^A
  88 ########
  89 uniescape("A");
  90 EXPECT
  91 A
  92 ########
  93 uniescape("\x{100}");
  94 EXPECT
  95 \x{0100}
  96 ########
  97 stringify(undef);
  98 EXPECT
  99 undef
 100 ########
 101 stringify("foo");
 102 EXPECT
 103 'foo'
 104 ########
 105 stringify("\cA");
 106 EXPECT
 107 "\cA"
 108 ########
 109 stringify(*a);
 110 EXPECT
 111 *main::a
 112 ########
 113 stringify(\undef);
 114 EXPECT
 115 /^'SCALAR\(0x[0-9a-f]+\)'$/i
 116 ########
 117 stringify([]);
 118 EXPECT
 119 /^'ARRAY\(0x[0-9a-f]+\)'$/i
 120 ########
 121 stringify({});
 122 EXPECT
 123 /^'HASH\(0x[0-9a-f]+\)'$/i
 124 ########
 125 stringify(sub{});
 126 EXPECT
 127 /^'CODE\(0x[0-9a-f]+\)'$/i
 128 ########
 129 stringify(\*a);
 130 EXPECT
 131 /^'GLOB\(0x[0-9a-f]+\)'$/i
 132 ########
 133 stringify($foo);
 134 EXPECT
 135 /^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i
 136 ########
 137 stringify($bar);
 138 EXPECT
 139 /^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i
 140 ########
 141 dumpValue(undef);
 142 EXPECT
 143 undef
 144 ########
 145 dumpValue(1);
 146 EXPECT
 147 1
 148 ########
 149 dumpValue("\cA");
 150 EXPECT
 151 "\cA"
 152 ########
 153 dumpValue("\x{100}");
 154 EXPECT
 155 '\x{0100}'
 156 ########
 157 dumpValue("1\n2\n3");
 158 EXPECT
 159 '1
 160 2
 161 3'
 162 ########
 163 dumpValue([1..3],1);
 164 EXPECT
 165 0  1
 166 1  2
 167 2  3
 168 ########
 169 dumpValue({1..4},1);
 170 EXPECT
 171 1 => 2
 172 3 => 4
 173 ########
 174 dumpValue($foo,1);
 175 EXPECT
 176 0  1
 177 1  2
 178 2  3
 179 3  4
 180 4  5
 181 ########
 182 dumpValue($bar,1);
 183 EXPECT
 184 0  1
 185 1  2
 186 2  3
 187 3  4
 188 4  5
 189 ########