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