t/316_numeric_defaults.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use B;
   6 use Class::MOP;
   7
   8 my @int_defaults = (
   9     100,
  10     -2,
  11     01234,
  12     0xFF,
  13 );
  14
  15 my @num_defaults = (
  16     10.5,
  17     -20.0,
  18     1e3,
  19     1.3e-10,
  20 );
  21
  22 my @string_defaults = (
  23     'foo',
  24     '',
  25     '100',
  26     '10.5',
  27     '1e3',
  28     '0 but true',
  29     '01234',
  30     '09876',
  31     '0xFF',
  32 );
  33
  34 for my $default (@int_defaults) {
  35     my $copy = $default; # so we can print it out without modifying flags
  36     my $attr = Class::MOP::Attribute->new(
  37         foo => (default => $default, reader => 'foo'),
  38     );
  39     my $meta = Class::MOP::Class->create_anon_class(
  40         attributes => [$attr],
  41         methods    => {bar => sub { $default }},
  42     );
  43
  44     my $obj = $meta->new_object;
  45     for my $meth (qw(foo bar)) {
  46         my $val = $obj->$meth;
  47         my $b = B::svref_2object(\$val);
  48         my $flags = $b->FLAGS;
  49         ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int ($copy)");
  50         ok(!($flags & B::SVf_POK), "not a string ($copy)");
  51     }
  52
  53     $meta->make_immutable;
  54
  55     my $immutable_obj = $meta->name->new;
  56     for my $meth (qw(foo bar)) {
  57         my $val = $immutable_obj->$meth;
  58         my $b = B::svref_2object(\$val);
  59         my $flags = $b->FLAGS;
  60         ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int ($copy) (immutable)");
  61         ok(!($flags & B::SVf_POK), "not a string ($copy) (immutable)");
  62     }
  63 }
  64
  65 for my $default (@num_defaults) {
  66     my $copy = $default; # so we can print it out without modifying flags
  67     my $attr = Class::MOP::Attribute->new(
  68         foo => (default => $default, reader => 'foo'),
  69     );
  70     my $meta = Class::MOP::Class->create_anon_class(
  71         attributes => [$attr],
  72         methods    => {bar => sub { $default }},
  73     );
  74
  75     my $obj = $meta->new_object;
  76     for my $meth (qw(foo bar)) {
  77         my $val = $obj->$meth;
  78         my $b = B::svref_2object(\$val);
  79         my $flags = $b->FLAGS;
  80         ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num ($copy)");
  81         ok(!($flags & B::SVf_POK), "not a string ($copy)");
  82     }
  83
  84     $meta->make_immutable;
  85
  86     my $immutable_obj = $meta->name->new;
  87     for my $meth (qw(foo bar)) {
  88         my $val = $immutable_obj->$meth;
  89         my $b = B::svref_2object(\$val);
  90         my $flags = $b->FLAGS;
  91         ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num ($copy) (immutable)");
  92         ok(!($flags & B::SVf_POK), "not a string ($copy) (immutable)");
  93     }
  94 }
  95
  96 for my $default (@string_defaults) {
  97     my $copy = $default; # so we can print it out without modifying flags
  98     my $attr = Class::MOP::Attribute->new(
  99         foo => (default => $default, reader => 'foo'),
 100     );
 101     my $meta = Class::MOP::Class->create_anon_class(
 102         attributes => [$attr],
 103         methods    => {bar => sub { $default }},
 104     );
 105
 106     my $obj = $meta->new_object;
 107     for my $meth (qw(foo bar)) {
 108         my $val = $obj->$meth;
 109         my $b = B::svref_2object(\$val);
 110         my $flags = $b->FLAGS;
 111         ok($flags & B::SVf_POK, "it's a string ($copy)");
 112     }
 113
 114     $meta->make_immutable;
 115
 116     my $immutable_obj = $meta->name->new;
 117     for my $meth (qw(foo bar)) {
 118         my $val = $immutable_obj->$meth;
 119         my $b = B::svref_2object(\$val);
 120         my $flags = $b->FLAGS;
 121         ok($flags & B::SVf_POK, "it's a string ($copy) (immutable)");
 122     }
 123 }
 124
 125 done_testing;