t/attributes/numeric_defaults.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Moose;
   6 use B;
   7
   8 {
   9     package Foo;
  10     use Moose;
  11
  12     has foo => (is => 'ro', default => 100);
  13
  14     sub bar { 100 }
  15 }
  16
  17 with_immutable {
  18     my $foo = Foo->new;
  19     for my $meth (qw(foo bar)) {
  20         my $val = $foo->$meth;
  21         my $b = B::svref_2object(\$val);
  22         my $flags = $b->FLAGS;
  23         ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int");
  24         ok(!($flags & B::SVf_POK), "not a string");
  25     }
  26 } 'Foo';
  27
  28 {
  29     package Bar;
  30     use Moose;
  31
  32     has foo => (is => 'ro', lazy => 1, default => 100);
  33
  34     sub bar { 100 }
  35 }
  36
  37 with_immutable {
  38     my $bar = Bar->new;
  39     for my $meth (qw(foo bar)) {
  40         my $val = $bar->$meth;
  41         my $b = B::svref_2object(\$val);
  42         my $flags = $b->FLAGS;
  43         ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int");
  44         ok(!($flags & B::SVf_POK), "not a string");
  45     }
  46 } 'Bar';
  47
  48 {
  49     package Baz;
  50     use Moose;
  51
  52     has foo => (is => 'ro', isa => 'Int', lazy => 1, default => 100);
  53
  54     sub bar { 100 }
  55 }
  56
  57 with_immutable {
  58     my $baz = Baz->new;
  59     for my $meth (qw(foo bar)) {
  60         my $val = $baz->$meth;
  61         my $b = B::svref_2object(\$val);
  62         my $flags = $b->FLAGS;
  63         ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int");
  64         ok(!($flags & B::SVf_POK), "not a string");
  65     }
  66 } 'Baz';
  67
  68 {
  69     package Foo2;
  70     use Moose;
  71
  72     has foo => (is => 'ro', default => 10.5);
  73
  74     sub bar { 10.5 }
  75 }
  76
  77 with_immutable {
  78     my $foo2 = Foo2->new;
  79     for my $meth (qw(foo bar)) {
  80         my $val = $foo2->$meth;
  81         my $b = B::svref_2object(\$val);
  82         my $flags = $b->FLAGS;
  83         ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num");
  84         ok(!($flags & B::SVf_POK), "not a string");
  85     }
  86 } 'Foo2';
  87
  88 {
  89     package Bar2;
  90     use Moose;
  91
  92     has foo => (is => 'ro', lazy => 1, default => 10.5);
  93
  94     sub bar { 10.5 }
  95 }
  96
  97 with_immutable {
  98     my $bar2 = Bar2->new;
  99     for my $meth (qw(foo bar)) {
 100         my $val = $bar2->$meth;
 101         my $b = B::svref_2object(\$val);
 102         my $flags = $b->FLAGS;
 103         ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num");
 104         ok(!($flags & B::SVf_POK), "not a string");
 105     }
 106 } 'Bar2';
 107
 108 {
 109     package Baz2;
 110     use Moose;
 111
 112     has foo => (is => 'ro', isa => 'Num', lazy => 1, default => 10.5);
 113
 114     sub bar { 10.5 }
 115 }
 116
 117 with_immutable {
 118     my $baz2 = Baz2->new;
 119     for my $meth (qw(foo bar)) {
 120         my $val = $baz2->$meth;
 121         my $b = B::svref_2object(\$val);
 122         my $flags = $b->FLAGS;
 123         ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num");
 124         ok(!($flags & B::SVf_POK), "not a string");
 125     }
 126 } 'Baz2';
 127
 128 done_testing;