blob: 2f21e60671fe986defd3e761e9ebc67a12a3d9fb (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
use strict;
use lib -e 't' ? 't' : 'test';
use TestYAML tests => 3;
package Foo::Bar;
sub new {
my ($class) = @_;
my $ref = globref();
my $self = bless $ref, $class;
return $self;
}
my $globnum = 0;
sub globref {
my $symbolname = "Foo::Glob::glob$globnum";
$globnum ++;
no strict 'refs';
return \*{ $symbolname };
}
package main;
is(Test::YAML::Dump({ globref => Foo::Bar::globref() }), <<EYAM, "dump glob-in-hash");
---
globref: !!perl/ref
=: !!perl/glob:
PACKAGE: Foo::Glob
NAME: glob0
EYAM
is(Test::YAML::Dump({ blessglob => Foo::Bar->new }), <<EYAM, "dump blessed glob");
---
blessglob: !!perl/glob:Foo::Bar
PACKAGE: Foo::Glob
NAME: glob1
EYAM
# A glob tricked out with everything
my $val = Foo::Bar->new;
${ *$val } = 'wag';
%{ *$val } = qw( key value hash pairs );
@{ *$val } = qw( a b c );
open *$val, '>&', \*STDERR or die "Can't dup STDERR: $!";
*{$val} = sub { 2 + 2 };
my $dump_tricks = Test::YAML::Dump({ blessglob => $val });
# Redact some highly variable stuff from the IO
my $changekeys = join '|',
qw( fileno device inode mode links uid gid rdev size atime mtime ),
qw( ctime blksize blocks tell );
$dump_tricks =~ s{($changekeys): \S+$}{$1: redact}mg;
is($dump_tricks, <<EYAM, "dump blessed glob");
---
blessglob: !!perl/glob:Foo::Bar
PACKAGE: Foo::Glob
NAME: glob2
SCALAR: wag
ARRAY:
- a
- b
- c
HASH:
hash: pairs
key: value
CODE: !!perl/code '{ "DUMMY" }'
IO:
fileno: redact
stat:
device: redact
inode: redact
mode: redact
links: redact
uid: redact
gid: redact
rdev: redact
size: redact
atime: redact
mtime: redact
ctime: redact
blksize: redact
blocks: redact
tell: redact
EYAM
|