t/op/mydef.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 print "1..56\n";
   9
  10 my $test = 0;
  11 sub ok ($$) {
  12     my ($ok, $name) = @_;
  13     ++$test;
  14     print $ok ? "ok $test - $name\n" : "not ok $test - $name\n";
  15 }
  16
  17 $_ = 'global';
  18 ok( $_ eq 'global', '$_ initial value' );
  19 s/oba/abo/;
  20 ok( $_ eq 'glabol', 's/// on global $_' );
  21
  22 {
  23     my $_ = 'local';
  24     ok( $_ eq 'local', 'my $_ initial value' );
  25     s/oca/aco/;
  26     ok( $_ eq 'lacol', 's/// on my $_' );
  27     /(..)/;
  28     ok( $1 eq 'la', '// on my $_' );
  29     ok( tr/c/d/ == 1, 'tr/// on my $_ counts correctly' );
  30     ok( $_ eq 'ladol', 'tr/// on my $_' );
  31     {
  32         my $_ = 'nested';
  33         ok( $_ eq 'nested', 'my $_ nested' );
  34         chop;
  35         ok( $_ eq 'neste', 'chop on my $_' );
  36     }
  37     {
  38         our $_;
  39         ok( $_ eq 'glabol', 'gains access to our global $_' );
  40     }
  41     ok( $_ eq 'ladol', 'my $_ restored' );
  42 }
  43 ok( $_ eq 'glabol', 'global $_ restored' );
  44 s/abo/oba/;
  45 ok( $_ eq 'global', 's/// on global $_ again' );
  46 {
  47     my $_ = 11;
  48     our $_ = 22;
  49     ok( $_ eq 22, 'our $_ is seen explicitly' );
  50     chop;
  51     ok( $_ eq 2, '...default chop chops our $_' );
  52     /(.)/;
  53     ok( $1 eq 2, '...default match sees our $_' );
  54 }
  55
  56 $_ = "global";
  57 {
  58     my $_ = 'local';
  59     for my $_ ("foo") {
  60         ok( $_ eq "foo", 'for my $_' );
  61         /(.)/;
  62         ok( $1 eq "f", '...m// in for my $_' );
  63         ok( our $_ eq 'global', '...our $_ inside for my $_' );
  64     }
  65     ok( $_ eq 'local', '...my $_ restored outside for my $_' );
  66     ok( our $_ eq 'global', '...our $_ restored outside for my $_' );
  67 }
  68 {
  69     for our $_ ("bar") {
  70         ok( $_ eq "bar", 'for our $_' );
  71         /(.)/;
  72         ok( $1 eq "b", '...m// in for our $_' );
  73     }
  74     ok( $_ eq 'global', '...our $_ restored outside for our $_' );
  75 }
  76
  77 {
  78     my $buf = '';
  79     sub tmap1 { /(.)/; $buf .= $1 } # uses our $_
  80     my $_ = 'x';
  81     sub tmap2 { /(.)/; $buf .= $1 } # uses my $_
  82     map {
  83         tmap1();
  84         tmap2();
  85         ok( /^[67]\z/, 'local lexical $_ is seen in map' );
  86         { ok( our $_ eq 'global', 'our $_ still visible' ); }
  87         ok( $_ == 6 || $_ == 7, 'local lexical $_ is still seen in map' );
  88         { my $_ ; ok( !defined, 'nested my $_ is undefined' ); }
  89     } 6, 7;
  90     ok( $buf eq 'gxgx', q/...map doesn't modify outer lexical $_/ );
  91     ok( $_ eq 'x', '...my $_ restored outside map' );
  92     ok( our $_ eq 'global', '...our $_ restored outside map' );
  93     map { my $_; ok( !defined, 'redeclaring $_ in map block undefs it' ); } 1;
  94 }
  95 { map { my $_; ok( !defined, 'declaring $_ in map block undefs it' ); } 1; }
  96 {
  97     sub tmap3 () { return $_ };
  98     my $_ = 'local';
  99     sub tmap4 () { return $_ };
 100     my $x = join '-', map $_.tmap3.tmap4, 1 .. 2;
 101     ok( $x eq '1globallocal-2globallocal', 'map without {}' );
 102 }
 103 {
 104     my $buf = '';
 105     sub tgrep1 { /(.)/; $buf .= $1 }
 106     my $_ = 'y';
 107     sub tgrep2 { /(.)/; $buf .= $1 }
 108     grep {
 109         tgrep1();
 110         tgrep2();
 111         ok( /^[89]\z/, 'local lexical $_ is seen in grep' );
 112         { ok( our $_ eq 'global', 'our $_ still visible' ); }
 113         ok( $_ == 8 || $_ == 9, 'local lexical $_ is still seen in grep' );
 114     } 8, 9;
 115     ok( $buf eq 'gygy', q/...grep doesn't modify outer lexical $_/ );
 116     ok( $_ eq 'y', '...my $_ restored outside grep' );
 117     ok( our $_ eq 'global', '...our $_ restored outside grep' );
 118 }
 119 {
 120     sub tgrep3 () { return $_ };
 121     my $_ = 'local';
 122     sub tgrep4 () { return $_ };
 123     my $x = join '-', grep $_=$_.tgrep3.tgrep4, 1 .. 2;
 124     ok( $x eq '1globallocal-2globallocal', 'grep without {} with side-effect' );
 125     ok( $_ eq 'local', '...but without extraneous side-effects' );
 126 }
 127 {
 128     my $s = "toto";
 129     my $_ = "titi";
 130     $s =~ /to(?{ ok( $_ eq 'toto', 'my $_ in code-match # TODO' ) })to/
 131         or ok( 0, "\$s=$s should match!" );
 132     ok( our $_ eq 'global', '...our $_ restored outside code-match' );
 133 }
 134
 135 {
 136     my $_ = "abc";
 137     my $x = reverse;
 138     ok( $x eq "cba", 'reverse without arguments picks up $_ # TODO' );
 139 }
 140
 141 {
 142     package notmain;
 143     our $_ = 'notmain';
 144     ::ok( $::_ eq 'notmain', 'our $_ forced into main::' );
 145     /(.*)/;
 146     ::ok( $1 eq 'notmain', '...m// defaults to our $_ in main::' );
 147 }
 148
 149 my $file = 'dolbar1.tmp';
 150 END { unlink $file; }
 151 {
 152     open my $_, '>', $file or die "Can't open $file: $!";
 153     print $_ "hello\n";
 154     close $_;
 155     ok( -s $file, 'writing to filehandle $_ works' );
 156 }
 157 {
 158     open my $_, $file or die "Can't open $file: $!";
 159     my $x = <$_>;
 160     ok( $x eq "hello\n", 'reading from <$_> works' );
 161     close $_;
 162 }