dist/bignum/t/overrides.t

   1 #!perl -w
   2
   3 # Test behaviour of hex and oct overrides in detail, and also how the three
   4 # modules interact.
   5
   6 use Test::More tests => 35;
   7
   8 # For testing that existing CORE::GLOBAL overrides are not clobbered
   9 BEGIN
  10   {
  11   if ($] > 5.009004)
  12     {
  13     no warnings 'syntax';
  14     *CORE::GLOBAL::hex = sub(_) { ++$hex_called; CORE::hex(@_?$_[0]:$_) };
  15     *CORE::GLOBAL::oct = sub(_) { ++$oct_called; CORE::oct(@_?$_[0]:$_) };
  16     }
  17   else
  18     {
  19     *CORE::GLOBAL::hex = sub(;$) { ++$hex_called; CORE::hex(@_?$_[0]:$_) };
  20     *CORE::GLOBAL::oct = sub(;$) { ++$oct_called; CORE::oct(@_?$_[0]:$_) };
  21     }
  22   }
  23
  24 {
  25   use bigint;
  26   $_ = "20";
  27   is hex, "32", 'bigint hex override without arguments infers $_';
  28   is oct, "16", 'bigint oct override without arguments infers $_';
  29   @_ = 1..20;
  30   is hex(@_), "32", 'bigint hex override provides scalar context';
  31   is oct(@_), "16", 'bigint oct override provides scalar context';
  32   is ref hex(1), 'Math::BigInt',
  33     'bigint hex() works when bignum and bigrat are loaded';
  34   is ref oct(1), 'Math::BigInt',
  35     'bigint oct() works when bignum and bigrat are loaded';
  36 }
  37 {
  38   use bignum;
  39   $_ = "20";
  40   is hex, "32", 'bignum hex override without arguments infers $_';
  41   is oct, "16", 'bignum oct override without arguments infers $_';
  42   @_ = 1..20;
  43   is hex(@_), "32", 'bignum hex override provides scalar context';
  44   is oct(@_), "16", 'bignum oct override provides scalar context';
  45   is ref hex(1), 'Math::BigInt',
  46     'bignum hex() works when bigint and bigrat are loaded';
  47   is ref oct(1), 'Math::BigInt',
  48     'bignum oct() works when bigint and bigrat are loaded';
  49 }
  50 {
  51   use bigrat;
  52   $_ = "20";
  53   is hex, "32", 'bigrat hex override without arguments infers $_';
  54   is oct, "16", 'bigrat oct override without arguments infers $_';
  55   @_ = 1..20;
  56   is hex(@_), "32", 'bigrat hex override provides scalar context';
  57   is oct(@_), "16", 'bigrat oct override provides scalar context';
  58   is ref hex(1), 'Math::BigInt',
  59     'bigrat hex() works when bignum and bigint are loaded';
  60   is ref oct(1), 'Math::BigInt',
  61     'bigrat oct() works when bignum and bigint are loaded';
  62 }
  63
  64 $hex_called = 0;
  65 () = hex 0;
  66 is $hex_called, 1, 'existing hex overrides are called';
  67 $oct_called = 0;
  68 () = oct 0;
  69 is $oct_called, 1, 'existing oct overrides are called';
  70
  71 {
  72   package _importer;
  73   {
  74     use bigint 'hex', 'oct';
  75     ::is \&hex, \&bigint::hex, 'exported hex function';
  76     ::is \&oct, \&bigint::oct, 'exported oct function';
  77   }
  78   ::ok ref hex(), 'exported hex function returns ref outside pragma scope';
  79   ::ok ref oct(), 'exported oct function returns ref outside pragma scope';
  80   ::is oct("20"), "16", 'exported oct function works with "decimal"';
  81     # (used to return 20 because it thought it was decimal)
  82 }
  83 {
  84   package _importer2;
  85   use bignum 'hex', 'oct';
  86   ::is \&hex, \&bignum::hex, 'bignum exports hex';
  87   ::is \&oct, \&bignum::oct, 'bignum exports oct';
  88   ::is \&hex, \&bigint::hex, 'bignum exports same hex as bigint';
  89   ::is \&oct, \&bigint::oct, 'bignum exports same oct as bigint';
  90 }
  91 {
  92   package _importer3;
  93   use bigrat 'hex', 'oct';
  94   ::is \&hex, \&bigrat::hex, 'bigrat exports hex';
  95   ::is \&oct, \&bigrat::oct, 'bigrat exports oct';
  96   ::is \&hex, \&bigint::hex, 'bigrat exports same hex as bigint';
  97   ::is \&oct, \&bigint::oct, 'bigrat exports same oct as bigint';
  98 }
  99 is ref hex 0, "", 'hex export is not global';
 100 is ref oct 0, "", 'oct export is not global';