#!/usr/bin/perl -T

use perl5i::latest;

use lib 't/lib';
use Test::More;
use Test::perl5i;

use Scalar::Util qw(tainted);

# Check an already tainted global
{
    note "Already tainted global";

    ok $^X->mo->is_tainted;

    $^X->mo->untaint;
    ok !$^X->mo->is_tainted;
    ok !tainted($^X);

    $^X->mo->taint;
    ok $^X->mo->is_tainted;
    ok tainted($^X);
}

# Check 2.0 compat
{
    note "2.0 compat";

    ok $^X->is_tainted;

    $^X->untaint;
    ok !$^X->is_tainted;

    $^X->taint;
    ok $^X->is_tainted;
}


# Check a scalar
{
    note "simple scalar";

    my $foo = "foo";
    ok !$foo->mo->is_tainted;

    $foo->mo->taint;
    ok $foo->mo->is_tainted;
    ok tainted($foo);  # just to be sure.

    $foo->mo->untaint;
    ok !$foo->mo->is_tainted;
    ok !tainted($foo);  # just to be sure.
}


# What about a scalar ref?
# Would be nice if we could un/taint the contents, but that's not
# possible due to how Taint::Util works and its not worth fixing.
{
    note "scalar ref";

    my $foo = \42;
    ok !$foo->mo->is_tainted;

    $foo->mo->untaint;  # does nothing
    ok !$foo->mo->is_tainted;
    ok !tainted(\$foo);  # just to be sure.

    throws_ok { $foo->mo->taint; } qr/^Only scalars can normally be made tainted/;
    ok !$foo->mo->is_tainted;
    ok !tainted(\$foo);  # just to be sure.
}


# A regular hash cannot be tainted
{
    note "hash";

    my %foo;
    ok !%foo->mo->is_tainted;

    %foo->mo->untaint;  # does nothing
    ok !%foo->mo->is_tainted;
    ok !tainted(\%foo);  # just to be sure.

    throws_ok { %foo->mo->taint; } qr/^Only scalars can normally be made tainted/;
    ok !%foo->mo->is_tainted;
    ok !tainted(\%foo);  # just to be sure.
}


# A blessed hash ref object cannot be tainted
{
    note "blessed hash ref";

    my $obj = bless {}, "Foo";
    ok !$obj->mo->is_tainted;

    $obj->mo->untaint;  # does nothing
    ok !$obj->mo->is_tainted;

    throws_ok { $obj->mo->taint; } qr/^Only scalars can normally be made tainted/;
    ok !$obj->mo->is_tainted;
    ok !tainted($obj);  # just to be sure.
}


# A blessed scalar ref object cannot be untainted... though we could.
{
    note "blessed scalar ref";

    my $thing = 42;
    my $obj = bless \$thing, "Foo";
    ok !$obj->mo->is_tainted;

    $obj->mo->untaint;  # does nothing
    ok !$obj->mo->is_tainted;

    throws_ok { $obj->mo->taint; } qr/^Only scalars can normally be made tainted/;
    ok !$obj->mo->is_tainted;
    ok !tainted($obj);  # just to be sure.
}


# How about a string overloaded object?
# Since its stringified value is what's important to tainting,
# we should check that.  But there's no way to reliably taint or untaint it.
{
    note "string overloaded object";

    package Bar;
    use Test::More;
    use Test::perl5i;

    use overload q[""] => sub { return ${$_[0]} }, fallback => 1;

    # Try it when its overloaded and tainted
    {
        my $thing = $^X;
        my $obj = bless \$thing, "Bar";
        is $obj, $^X;

        ok $obj->mo->is_tainted;
        ok ::tainted("$obj");

        throws_ok { $obj->mo->untaint; } qr/^Tainted overloaded objects cannot normally be untainted/;
        ok $obj->mo->taint;  # this is cool, its already tainted.
    }

    # Overloaded and not tainted
    {
        my $thing = "wibble";
        my $obj = bless \$thing, "Bar";
        is $obj, $thing;

        ok !$obj->mo->is_tainted;
        ok !::tainted("$obj");

        ok $obj->mo->untaint;  # this is cool, its already untainted.
        throws_ok { $obj->mo->taint; } qr/^Untainted overloaded objects cannot normally be made tainted/;
    }
}


# DateTime is notoriously picky about its overloading
# In particular $date+0, the usual way to numify, will die.
{
    note "DateTime";

    require DateTime;
    my $date = DateTime->now;

    ok !$date->mo->is_tainted;
}

done_testing();