[perl5.git] / lib / overloading.t

#./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
}

BEGIN {
    require "./test.pl";
    plan(tests => 22);
}

use Scalar::Util qw(refaddr);

{
    package Stringifies;

    use overload (
	fallback => 1,
	'""' => sub { "foo" },
	'0+' => sub { 42 },
    );

    sub new { bless {}, shift };
}

my $x = Stringifies->new;

is( "$x", "foo", "stringifies" );
is( 0 + $x, 42, "numifies" );

{
    no overloading;
    is( "$x", overload::StrVal($x), "no stringification" );
    is( 0 + $x, refaddr($x), "no numification" );

    {
	no overloading '""';
	is( "$x", overload::StrVal($x), "no stringification" );
	is( 0 + $x, refaddr($x), "no numification" );
    }
}

{
    no overloading '""';

    is( "$x", overload::StrVal($x), "no stringification" );
    is( 0 + $x, 42, "numifies" );

    {
	no overloading;
	is( "$x", overload::StrVal($x), "no stringification" );
	is( 0 + $x, refaddr($x), "no numification" );
    }

    use overloading '""';

    is( "$x", "foo", "stringifies" );
    is( 0 + $x, 42, "numifies" );

    no overloading '0+';
    is( "$x", "foo", "stringifies" );
    is( 0 + $x, refaddr($x), "no numification" );

    {
	no overloading '""';
	is( "$x", overload::StrVal($x), "no stringification" );
	is( 0 + $x, refaddr($x), "no numification" );

	{
	    use overloading;
	    is( "$x", "foo", "stringifies" );
	    is( 0 + $x, 42, "numifies" );
	}
    }

    is( "$x", "foo", "stringifies" );
    is( 0 + $x, refaddr($x), "no numification" );


    BEGIN { ok(exists($^H{overloading}), "overloading hint present") }

    use overloading;

    BEGIN { ok(!exists($^H{overloading}), "overloading hint removed") }
}
Commit	Line	Data
e46c382e YK	1	#./perl
	2
	3	BEGIN {
	4	chdir 't' if -d 't';
	5	@INC = '../lib';
	6	}
	7
	8	BEGIN {
	9	require "./test.pl";
	10	plan(tests => 22);
	11	}
	12
	13	use Scalar::Util qw(refaddr);
	14
	15	{
	16	package Stringifies;
	17
	18	use overload (
	19	fallback => 1,
	20	'""' => sub { "foo" },
	21	'0+' => sub { 42 },
	22	);
	23
	24	sub new { bless {}, shift };
	25	}
	26
	27	my $x = Stringifies->new;
	28
	29	is( "$x", "foo", "stringifies" );
	30	is( 0 + $x, 42, "numifies" );
	31
	32	{
	33	no overloading;
	34	is( "$x", overload::StrVal($x), "no stringification" );
	35	is( 0 + $x, refaddr($x), "no numification" );
	36
	37	{
	38	no overloading '""';
	39	is( "$x", overload::StrVal($x), "no stringification" );
	40	is( 0 + $x, refaddr($x), "no numification" );
	41	}
	42	}
	43
	44	{
	45	no overloading '""';
	46
	47	is( "$x", overload::StrVal($x), "no stringification" );
	48	is( 0 + $x, 42, "numifies" );
	49
	50	{
	51	no overloading;
	52	is( "$x", overload::StrVal($x), "no stringification" );
	53	is( 0 + $x, refaddr($x), "no numification" );
	54	}
	55
	56	use overloading '""';
	57
	58	is( "$x", "foo", "stringifies" );
	59	is( 0 + $x, 42, "numifies" );
	60
	61	no overloading '0+';
	62	is( "$x", "foo", "stringifies" );
	63	is( 0 + $x, refaddr($x), "no numification" );
	64
65	{
66	no overloading '""';
67	is( "$x", overload::StrVal($x), "no stringification" );
68	is( 0 + $x, refaddr($x), "no numification" );
69
70	{
71	use overloading;
72	is( "$x", "foo", "stringifies" );
73	is( 0 + $x, 42, "numifies" );
74	}
75	}
76
77	is( "$x", "foo", "stringifies" );
78	is( 0 + $x, refaddr($x), "no numification" );
79
80
81	BEGIN { ok(exists($^H{overloading}), "overloading hint present") }
82
83	use overloading;
84
85	BEGIN { ok(!exists($^H{overloading}), "overloading hint removed") }
86	}