1#!perl
2
3# This is a sandbox for experiments with referencing and dereferencing.
4# It is not part of a test suite, not even an "author" test suite.
5
6use strict;
7use warnings;
8
9use Scalar::Util qw(reftype weaken);
10use Data::Dumper;
11use Carp;
12use English qw( -no_match_vars );
13use Fatal qw(open);
14
15sub try_dumper {
16    my $probe_ref = shift;
17
18    my @warnings = ();
19    local $SIG{__WARN__} = sub { push @warnings, $_[0]; };
20    printf {*STDERR} 'Dumper: %s', Data::Dumper::Dumper( ${$probe_ref} )
21        or Carp::croak("Cannot print to STDERR: $ERRNO");
22    for my $warning (@warnings) {
23        print {*STDERR} "Dumper warning: $warning"
24            or Carp::croak("Cannot print to STDERR: $ERRNO");
25    }
26    return scalar @warnings;
27}
28
29my $array_ref = \@{ [qw(42)] };
30my $hash_ref   = { a => 1, b => 2 };
31my $scalar_ref = \42;
32my $ref_ref    = \$scalar_ref;
33my $regexp_ref = qr/./xms;
34
35## no critic (Subroutines::ProhibitCallsToUndeclaredSubs)
36my $vstring_ref = \(v1.2.3.4);
37## use critic
38
39my $code_ref = \&try_dumper;
40
41## no critic (Miscellanea::ProhibitFormats,References::ProhibitDoubleSigils,Subroutines::ProhibitCallsToUndeclaredSubs)
42format fmt =
43@<<<<<<<<<<<<<<<
44$_
45.
46## use critic
47
48## no critic (Subroutines::ProhibitCallsToUndeclaredSubs)
49my $format_ref = *fmt{FORMAT};
50my $glob_ref   = *STDOUT{GLOB};
51my $io_ref     = *STDOUT{IO};
52my $fh_ref     = do {
53    no warnings qw(deprecated);
54    *STDOUT{FILEHANDLE};
55};
56## use critic
57
58## no critic (InputOutput::RequireBriefOpen)
59open my $autoviv_ref, q{>&STDERR};
60## use critic
61
62my $string     = 'abc' x 40;
63my $lvalue_ref = \( pos $string );
64${$lvalue_ref} = 7;
65
66my %data = (
67    'scalar'  => $scalar_ref,
68    'array'   => $array_ref,
69    'hash'    => $hash_ref,
70    'ref'     => $ref_ref,
71    'code'    => $code_ref,
72    'regexp'  => $regexp_ref,
73    'vstring' => $vstring_ref,
74    'format'  => $format_ref,
75    'glob'    => $glob_ref,
76    'io'      => $io_ref,
77    'fh'      => $fh_ref,
78    'autoviv' => $autoviv_ref,
79    'lvalue'  => $lvalue_ref,
80);
81
82REF:
83while ( my ( $name, $ref ) = each %data ) {
84    printf {*STDERR} "==== $name, %s, %s ====\n", ( ref $ref ),
85        ( reftype $ref)
86        or Carp::croak("Cannot print to STDERR: $ERRNO");
87    try_dumper( \$ref );
88}
89
90REF:
91for my $data_name (qw(scalar vstring regexp ref )) {
92    my $ref = $data{$data_name};
93    printf {*STDERR} "=== Deref test $data_name, %s, %s ===\n", ( ref $ref ),
94        ( reftype $ref )
95        or Carp::croak("Cannot print to STDERR: $ERRNO");
96    my $old_probe = \$ref;
97    try_dumper($old_probe);
98    my $new_probe = \${ ${$old_probe} };
99    try_dumper($new_probe);
100}
101
102REF: for my $ref ($format_ref) {
103    my $probe = \$ref;
104    print {*STDERR} 'Trying to deref ', ( ref $probe ), q{ }, ( ref $ref ),
105        "\n"
106        or Carp::croak("Cannot print to STDERR: $ERRNO");
107    try_dumper($probe);
108
109    # How to dereference ?
110}
111
112REF: for my $ref ($lvalue_ref) {
113    my $probe = \$ref;
114    print {*STDERR} 'Trying to deref ', ( ref $probe ), q{ }, ( ref $ref ),
115        "\n"
116        or Carp::croak("Cannot print to STDERR: $ERRNO");
117    try_dumper($probe);
118    my $new_probe = \${ ${$probe} };
119    printf {*STDERR} "pos is %d\n", ${$lvalue_ref};
120    ${$lvalue_ref} = 11;
121    printf {*STDERR} "pos is %d\n", ${$lvalue_ref};
122}
123
124REF: for my $ref ($io_ref) {
125    my $probe = \$ref;
126    print {*STDERR} 'Trying to deref ', ( ref $probe ), q{ }, ( ref $ref ),
127        "\n"
128        or Carp::croak("Cannot print to STDERR: $ERRNO");
129    try_dumper($probe);
130    my $new_probe = \*{ ${$probe} };
131    print { ${$new_probe} } "Printing via IO ref\n"
132        or Carp::croak("Cannot print via IO ref: $ERRNO");
133}
134
135REF: for my $ref ($fh_ref) {
136    my $probe = \$ref;
137    print {*STDERR} 'Trying to deref ', ( ref $probe ), q{ }, ( ref $ref ),
138        "\n"
139        or Carp::croak("Cannot print to STDERR: $ERRNO");
140    try_dumper($probe);
141    my $new_probe = \*{ ${$probe} };
142    print { ${$new_probe} } "Printing via FH ref\n"
143        or Carp::croak("Cannot print via FH ref: $ERRNO");
144}
145
146REF: for my $ref ($glob_ref) {
147    my $probe = \$ref;
148    print 'Trying to deref ', ( ref $probe ), q{ }, ( ref $ref ), "\n"
149        or Carp::croak("Cannot print to STDERR: $ERRNO");
150    try_dumper($probe);
151    my $new_probe = \*{ ${$probe} };
152    print { ${$new_probe} } "Printing via GLOB ref\n"
153        or Carp::croak("Cannot print via GLOB ref: $ERRNO");
154}
155
156REF:
157for my $data_name (qw( glob autoviv )) {
158    my $ref = $data{$data_name};
159    printf {*STDERR} "=== Deref test $data_name, %s, %s ===\n", ( ref $ref ),
160        ( reftype $ref )
161        or Carp::croak("Cannot print to STDERR: $ERRNO");
162    my $old_probe = \$ref;
163    try_dumper($old_probe);
164    my $new_probe = \*{ ${$old_probe} };
165    print { ${$new_probe} } "Printing via $data_name ref\n"
166        or Carp::croak("Cannot print via $data_name ref: $ERRNO");
167    try_dumper($new_probe);
168}
169
170REF:
171while ( my ( $name, $ref ) = each %data ) {
172    my $ref_value     = ref $ref;
173    my $reftype_value = reftype $ref;
174    printf
175        "==== scalar ref test of $name, ref=$ref_value, reftype=$reftype_value\n"
176        or Carp::croak("Cannot print to STDERR: $ERRNO");
177    my $eval_result = eval { my $deref = ${$ref}; 1 };
178    if ( defined $eval_result ) {
179        print "scalar deref of $reftype_value ok\n"
180            or Carp::croak("Cannot print to STDOUT: $ERRNO");
181    }
182    else {
183        print "scalar deref of $reftype_value failed: $EVAL_ERROR"
184            or Carp::croak("Cannot print to STDOUT: $ERRNO");
185    }
186} ## end while ( my ( $name, $ref ) = each %data )
187