#!perl -w

# Test behaviour of hex and oct overrides in detail, and also how the three
# modules interact.

use Test::More tests => 35;

# For testing that existing CORE::GLOBAL overrides are not clobbered
BEGIN
  {
  if ($] > 5.009004)
    {
    no warnings 'syntax';
    *CORE::GLOBAL::hex = sub(_) { ++$hex_called; CORE::hex(@_?$_[0]:$_) };
    *CORE::GLOBAL::oct = sub(_) { ++$oct_called; CORE::oct(@_?$_[0]:$_) };
    }
  else
    {
    *CORE::GLOBAL::hex = sub(;$) { ++$hex_called; CORE::hex(@_?$_[0]:$_) };
    *CORE::GLOBAL::oct = sub(;$) { ++$oct_called; CORE::oct(@_?$_[0]:$_) };
    }
  }

{
  use bigint;
  $_ = "20";
  is hex, "32", 'bigint hex override without arguments infers $_';
  is oct, "16", 'bigint oct override without arguments infers $_';
  @_ = 1..20;
  is hex(@_), "32", 'bigint hex override provides scalar context';
  is oct(@_), "16", 'bigint oct override provides scalar context';
  SKIP:
    {
    skip "no lexical hex/oct", 2 unless $] > do { no bigint; 5.009004};
    is ref hex(1), 'Math::BigInt',
      'bigint hex() works when bignum and bigrat are loaded';
    is ref oct(1), 'Math::BigInt',
      'bigint oct() works when bignum and bigrat are loaded';
    }
}
{
  use bignum;
  $_ = "20";
  is hex, "32", 'bignum hex override without arguments infers $_';
  is oct, "16", 'bignum oct override without arguments infers $_';
  @_ = 1..20;
  is hex(@_), "32", 'bignum hex override provides scalar context';
  is oct(@_), "16", 'bignum oct override provides scalar context';
  SKIP:
    {
    skip "no lexical hex/oct", 2 unless $] > 5.009004;
    is ref hex(1), 'Math::BigInt',
      'bignum hex() works when bigint and bigrat are loaded';
    is ref oct(1), 'Math::BigInt',
      'bignum oct() works when bigint and bigrat are loaded';
    }
}
{
  use bigrat;
  $_ = "20";
  is hex, "32", 'bigrat hex override without arguments infers $_';
  is oct, "16", 'bigrat oct override without arguments infers $_';
  @_ = 1..20;
  is hex(@_), "32", 'bigrat hex override provides scalar context';
  is oct(@_), "16", 'bigrat oct override provides scalar context';
  SKIP:
    {
    skip "no lexical hex/oct", 2 unless $] > 5.009004;
    is ref hex(1), 'Math::BigInt',
      'bigrat hex() works when bignum and bigint are loaded';
    is ref oct(1), 'Math::BigInt',
      'bigrat oct() works when bignum and bigint are loaded';
    }
}

$hex_called = 0;
() = hex 0;
is $hex_called, 1, 'existing hex overrides are called';
$oct_called = 0;
() = oct 0;
is $oct_called, 1, 'existing oct overrides are called';

{
  package _importer;
  {
    use bigint 'hex', 'oct';
    ::is \&hex, \&bigint::hex, 'exported hex function';
    ::is \&oct, \&bigint::oct, 'exported oct function';
  }
  ::ok ref hex(), 'exported hex function returns ref outside pragma scope';
  ::ok ref oct(), 'exported oct function returns ref outside pragma scope';
  ::is oct("20"), "16", 'exported oct function works with "decimal"';
    # (used to return 20 because it thought it was decimal)
}
{
  package _importer2;
  use bignum 'hex', 'oct';
  ::is \&hex, \&bignum::hex, 'bignum exports hex';
  ::is \&oct, \&bignum::oct, 'bignum exports oct';
  ::is \&hex, \&bigint::hex, 'bignum exports same hex as bigint';
  ::is \&oct, \&bigint::oct, 'bignum exports same oct as bigint';
}
{
  package _importer3;
  use bigrat 'hex', 'oct';
  ::is \&hex, \&bigrat::hex, 'bigrat exports hex';
  ::is \&oct, \&bigrat::oct, 'bigrat exports oct';
  ::is \&hex, \&bigint::hex, 'bigrat exports same hex as bigint';
  ::is \&oct, \&bigint::oct, 'bigrat exports same oct as bigint';
}
is ref(hex 0), "", 'hex export is not global';
is ref(oct 0), "", 'oct export is not global';