# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..151\n"; }
END {print "not ok 1\n" unless $loaded;}
use Scalar::Properties;
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

our $testcount = 1;    # compensate for 'ok' above

sub true {
	my $ok = shift;
	our $testcount;
	$testcount++;
	print 'not ' unless $ok;
	print "ok $testcount ".($_[0]?$_[0]:'')."\n";
}

sub false { true(!$_[0]) }

my $pkg = 'Scalar::Properties';

{  # test added by DCANTRELL to tickle the binary-op operand re-ordering bug
        true(time - 300 > 0, "binary-op operand re-ordering bug");
}

{  # test added by DCANTRELL to test for rt.cpan.org bug 4312
    my $test = 0;
    true($test."\$test"."\\$test"."\\\$test"."\\\\$test" eq
        '0$test\0\$test\\\\0', "variable interpolation bug");
}

# die;

false(0);
true(1);

false(0->is_true );
true (0->is_false);
false(1->is_false);
true (1->is_true );


{
	my $foo = 0->true;
	true($foo->value == 0->{_value});
	true($foo);

	$foo += 7;
	true(ref $foo eq $pkg);
	true($foo);
	true($foo == 7);
	true($foo->{_value} == 7);
}

{
	my $bar = 42->times(3);
	true($bar == 126);
	true($bar);
	$bar->false;
	false($bar);
	true($bar == 126);

	true($bar->times(4) == 504);

	# set a property; note that the '1' itself becomes overloaded.
	$bar->approximate(1);
	true($bar->approximate);
	true($bar->is_approximate);
	true($bar->has_approximate);
	$bar->approximate(0);
	false($bar->approximate);
	false($bar->is_approximate);
	false($bar->has_approximate);
}

{
	my $val = 0->true;
	true($val && $val == 0);
}

{
	my $quux = 37->prime(1);
	true($quux);
	true($quux == 37);
	true($quux->is_prime);
}

{
	my $baza = 42->value;
	my $bazb = 42;
	true(ref $baza eq '');
	true($baza == $bazb);
}

{
	my $h = 'hello world';
	true($h);
	true($h eq 'hello world');
	$h->greeting(1);
	true($h->is_greeting);

	my @blah;
	push @blah => $h;
	push @blah => 'forget it';
	push @blah => 'hi there'->greeting(1);
	my @greets = grep { $_->is_greeting } @blah;
	true(@greets == 2);
	true($greets[0] eq 'hello world');
	true($greets[1] eq 'hi there');
}

{
	false('');
	true(''->true);
	false(''->false);

	true('x');
	true('x'->true);
	false('x'->false);
}

{
	my $len = 'hello world'->length;
	true(ref $len eq $pkg);
	true($len == 11);

	my $rev = 'hello world'->reverse;
	true(ref $rev eq $pkg);
	true($rev eq 'dlrow olleh');

	true(1234->length  == 4);
	true(1234->size    == 1234->length);
	true(1234->reverse == 4321);
}

{
	my $t = 'hello cruel world';
	my @s;
	@s = $t->split;
	true(@s == 3);
	true($s[0] eq 'hello');
	true($s[1] eq 'cruel');
	true($s[2] eq 'world');

	@s = $t->split(qr/ll/);
	true(@s == 2);
	true($s[0] eq 'he');
	true($s[1] eq 'o cruel world');

	@s = $t->split(qr/\s+/, 2);
	true(@s == 2);
	true($s[0] eq 'hello');
	true($s[1] eq 'cruel world');

	# There was a bug with split(), so we try it again to be
	# sure it works
	@s = $t->split(qr/ll/);
	true(@s == 2);
	true($s[0] eq 'he');
	true($s[1] eq 'o cruel world');
}

{
	true('hello world'->uc      eq 'HELLO WORLD');
	true('hello world'->ucfirst eq 'Hello world');
	true('HELLO WORLD'->lc      eq 'hello world');
	true('HELLO WORLD'->lcfirst eq 'hELLO WORLD');

	my $s = 'hello world';
	true(ref $s->uc eq $pkg);
	true(ref $s->ucfirst eq $pkg);
	true(ref $s->lc eq $pkg);
	true(ref $s->lcfirst eq $pkg);
}

{
	true('0xAf'->hex == 175);
	true('aF'  ->hex == 175);
	true(123   ->hex == 291);

	true( 777->oct == 511);
	true( 123->oct ==  83);

	my $h = '0xffffff';
	true(ref $h->hex eq $pkg);
	true(ref $h->oct eq $pkg);
}

{
	true('hello'->concat(' world') eq 'hello world');
	true(ref 'hello'->concat(' world') eq $pkg);
	true(ref 'hello'->append(' world') eq $pkg);
}

{
	my $s = 'Hello World';
	true($s->swapcase, 'hELLO wORLD');
}

{
	my $s1 = 'aaa';
	my $s2 = 'bbb';

	true($s1 eq $s1);
	true($s1->eq($s1));

	true($s1 ne $s2);
	true($s1->ne($s2));

	true($s1 lt $s2);
	true($s1->lt($s2));

	true($s2 gt $s1);
	true($s2->gt($s1));

	true($s1 le $s1);
	true($s1 le $s2);
	true($s1->le($s1));
	true($s1->le($s2));

	true($s2 ge $s1);
	true($s2 ge $s2);
	true($s2->ge($s1));
	true($s2->ge($s2));

	true(ref $s1->eq($s1) eq $pkg);
	true(ref $s1->ne($s1) eq $pkg);
	true(ref $s1->lt($s1) eq $pkg);
	true(ref $s1->gt($s1) eq $pkg);
	true(ref $s1->le($s1) eq $pkg);
	true(ref $s1->ge($s1) eq $pkg);
}

{
	my $s1 = 'aaa';
	my $s2 = 'BBB';

	true($s1->eqi($s1));
	true($s1->nei($s2));
	true($s1->lti($s2));
	true($s2->gti($s1));
	true($s1->lei($s1));
	true($s1->lei($s2));
	true($s2->gei($s1));
	true($s2->gei($s2));

	true(ref $s1->eqi($s1) eq $pkg);
	true(ref $s1->nei($s1) eq $pkg);
	true(ref $s1->lti($s1) eq $pkg);
	true(ref $s1->gti($s1) eq $pkg);
	true(ref $s1->lei($s1) eq $pkg);
	true(ref $s1->gei($s1) eq $pkg);
}

{
	my $out;
	3->times_do(sub { $out .= 'Hello' });
	true($out eq 'HelloHelloHello');

	$out = '';
	5->times_do(sub { $out .= shift });
	true($out == 12345);

	my $sub = sub { $out .= "$_[0].. " };

	$out = '';
	1->do_upto(5 => $sub);
	true($out eq '1.. 2.. 3.. 4.. 5.. ');

	$out = '';
	1->do_upto_step(5, 2, $sub);
	true($out eq '1.. 3.. 5.. ');

	$out = '';
	5->do_upto(1 => $sub);
	true($out eq '');

	$out = '';
	5->do_downto(3 => $sub);
	true($out eq '5.. 4.. 3.. ');

	$out = '';
	5->do_downto_step(2, 2, $sub);
	true($out eq '5.. 3.. ');

	$out = '';
	3->do_downto(5 => $sub);
	true($out eq '');
}

{
	true((-1942)->abs() == 1942);
	true(    0->abs ==    0);
	true(  773->abs ==  773);

	true(0->zero);
	false(1->zero);
	my $foo = 27;
	false($foo->zero);
	$foo -= 27;
	true($foo->zero);
}

{
	pass_on('approximate');
	true(get_pass_on == 1);
	true(passed_on('approximate'));
}

{
	my $foo = 1;
	$foo->history(1);
	my $pi = 3->approximate(1);
	my $bar = $foo + $pi;
	true($bar->is_approximate);
	false($bar->has_history);
}

{
	my $h1 = 'hi world'->approximate(1);
	my $h2 = $h1->uc;
	my @h3 = $h1->split;
	true($_->approximate) for $h1, $h2, @h3;
}

{
	my $ship = 1701->class('galaxy');
	$ship->quadrant('alpha');
	$ship->crew(1017);

	my @props = $ship->get_props;
	true(@props == 3);
	true(grep /^$_$/ => @props) for qw/class quadrant crew/;

	$ship->crew(0);
	true($ship->get_props == 3);

	$ship->del_prop('crew');
	@props = $ship->get_props;
	true(@props == 2);
	true(grep /^$_$/ => @props) for qw/class quadrant/;

	$ship->del_all_props;
	@props = $ship->get_props;
	true(@props == 0);

}