t/15-info.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 5 + 2 + 3 + 2;
   7
   8 use Scope::Context;
   9
  10 {
  11  package Scope::Context::TestA;
  12  {
  13   my $line = __LINE__;
  14   package Scope::Context::TestB;
  15   my $cxt  = Scope::Context->new;
  16   package Scope::Context::TestC;
  17   ::is $cxt->package,   'Scope::Context::TestA';
  18   ::is $cxt->file,      __FILE__;
  19   ::is $cxt->line,      $line;
  20   ::is $cxt->sub_name,  undef;
  21   ::is $cxt->eval_text, undef;
  22  }
  23 }
  24
  25 sub flurbz {
  26  my $cxt = Scope::Context->new;
  27  [ $cxt->sub_name, $cxt->sub_has_args ]
  28 }
  29
  30 {
  31  my $info = flurbz();
  32  is($info->[0], 'main::flurbz');
  33  is($info->[1], !!1);
  34 }
  35
  36 {
  37  {
  38   is(Scope::Context->new->gimme, undef, 'gimme in void context');
  39  }
  40  my $s = do {
  41   is(Scope::Context->new->gimme, !!'', 'gimme in scalar context');
  42  };
  43  my @a = do {
  44   is(Scope::Context->new->gimme, !!1, 'gimme in list context');
  45  }
  46 }
  47
  48 {
  49  my $src  = <<' SRC';
  50   my $cxt = Scope::Context->new;
  51   [ $cxt->eval_text, $cxt->is_require ];
  52  SRC
  53  my $info = do {
  54   local $@;
  55   eval $src;
  56  };
  57  my $eval_text = $info->[0];
  58  s/[\s;]*$//g for $eval_text, $src;
  59  is $eval_text, $src, 'eval_text in eval';
  60  is $info->[1], !!'', 'is_require in eval';
  61 }