t/op/gv.t

   1 #!./perl
   2
   3 #
   4 # various typeglob tests
   5 #
   6
   7 BEGIN {
   8     chdir 't' if -d 't';
   9     @INC = '../lib';
  10     require './test.pl';
  11 }
  12
  13 use warnings;
  14
  15 plan( tests => 238 );
  16
  17 # type coercion on assignment
  18 $foo = 'foo';
  19 $bar = *main::foo;
  20 $bar = $foo;
  21 is(ref(\$bar), 'SCALAR');
  22 $foo = *main::bar;
  23
  24 # type coercion (not) on misc ops
  25
  26 ok($foo);
  27 is(ref(\$foo), 'GLOB');
  28
  29 unlike ($foo, qr/abcd/);
  30 is(ref(\$foo), 'GLOB');
  31
  32 is($foo, '*main::bar');
  33 is(ref(\$foo), 'GLOB');
  34
  35 {
  36  no warnings;
  37  ${\*$foo} = undef;
  38  is(ref(\$foo), 'GLOB', 'no type coercion when assigning to *{} retval');
  39  $::{phake} = *bar;
  40  is(
  41    \$::{phake}, \*{"phake"},
  42    'symbolic *{} returns symtab entry when FAKE'
  43  );
  44  ${\*{"phake"}} = undef;
  45  is(
  46    ref(\$::{phake}), 'GLOB',
  47   'no type coercion when assigning to retval of symbolic *{}'
  48  );
  49  $::{phaque} = *bar;
  50  eval '
  51    is(
  52      \$::{phaque}, \*phaque,
  53      "compile-time *{} returns symtab entry when FAKE"
  54    );
  55    ${\*phaque} = undef;
  56  ';
  57  is(
  58    ref(\$::{phaque}), 'GLOB',
  59   'no type coercion when assigning to retval of compile-time *{}'
  60  );
  61 }
  62
  63 # type coercion on substitutions that match
  64 $a = *main::foo;
  65 $b = $a;
  66 $a =~ s/^X//;
  67 is(ref(\$a), 'GLOB');
  68 $a =~ s/^\*//;
  69 is($a, 'main::foo');
  70 is(ref(\$b), 'GLOB');
  71
  72 # typeglobs as lvalues
  73 substr($foo, 0, 1) = "XXX";
  74 is(ref(\$foo), 'SCALAR');
  75 is($foo, 'XXXmain::bar');
  76
  77 # returning glob values
  78 sub foo {
  79   local($bar) = *main::foo;
  80   $foo = *main::bar;
  81   return ($foo, $bar);
  82 }
  83
  84 ($fuu, $baa) = foo();
  85 ok(defined $fuu);
  86 is(ref(\$fuu), 'GLOB');
  87
  88
  89 ok(defined $baa);
  90 is(ref(\$baa), 'GLOB');