# $Id: Scalar.pm,v 1.7 2002/10/23 18:54:38 comdog Exp $
package Test::Data::Scalar;
use strict;

use base qw(Exporter);
use vars qw(@EXPORT $VERSION);

use Scalar::Util;
use Test::Builder;

@EXPORT = qw(
	blessed_ok defined_ok dualvar_ok greater_than length_ok 
	less_than maxlength_ok minlength_ok number_ok 
	readonly_ok ref_ok ref_type_ok strong_ok tainted_ok 
	untainted_ok weak_ok undef_ok number_between_ok
	string_between_ok
	);
$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ m/ (\d+) \. (\d+) /g;

my $Test = Test::Builder->new();

=head1 NAME

Test::Data::Scalar -- test functions for scalar variables

=head1 SYNOPSIS

	use Test::Data qw(Scalar);

=head1 DESCRIPTION

This modules provides a collection of test utilities for
scalar variables.  Load the module through Test::Data.

=head2 Functions

=over 4

=item blessed_ok( SCALAR )

Ok if the SCALAR is a blessed reference.

=cut

sub blessed_ok ($;$)
	{
	my $ref  = ref $_[0];
	my $ok   = Scalar::Util::blessed($_[0]);
	my $name = $_[1] || 'Scalar is blessed';
	
	$Test->ok( $ok );

	$Test->diag("Expected a blessed value, but didn't get it\n\t" .
		qq|Reference type is "$ref"\n| ) unless $ok;
	}

=item defined_ok( SCALAR )

Ok if the SCALAR is defined.

=cut

sub defined_ok ($;$)
	{
	my $ok   = defined $_[0];
	my $name = $_[1] || 'Scalar is defined';

	$Test->ok( $ok );

	$Test->diag("Expected a defined value, got an undefined one\n")
		unless $ok;
	}

=item undef_ok( SCALAR )

Ok if the SCALAR is undefined.

=cut

sub undef_ok ($;$)
	{
	if( @_ > 0 )
		{
		my $ok   = not defined $_[0];
	    my $name = $_[1] || 'Scalar is undefined';

		$Test->ok( $ok );

		$Test->diag("Expected an undefined value, got a defined one\n")
			unless $ok;
		}
	else
		{
		$Test->ok( 0 );

		$Test->diag("Expected an undefined value, but got no arguments\n");
		}		
	}

=item dualvar_ok( SCALAR )

Ok if the scalar is a dualvar.

=cut

sub dualvar_ok ($;$)
	{
	my $ok   = dualvar $_[0];
	my $name = $_[1] || 'Scalar is a dualvar';

	$Test->ok( $ok );

	$Test->diag("Expected a dualvar, didn't get it\n")
		unless $ok;
	}
	
=item greater_than( SCALAR, BOUND )

Ok if the SCALAR is numerically greater than BOUND.

=cut

sub greater_than ($$;$)
	{
	my $value = shift;
	my $bound = shift;
	my $name  = shift || 'Scalar is greater than bound';
	
	my $ok = $value > $bound;
	
	$Test->ok( $ok );
	
	$Test->diag("Number is less than the bound.\n\t" .
		"Expected a number greater than [$bound]\n\t" .
		"Got [$value]\n") unless $ok; 
	}
	
=item length_ok( SCALAR, LENGTH )

Ok if the length of SCALAR is LENGTH.

=cut

sub length_ok ($$;$)
	{
	my $string = shift;
	my $length = shift;
	my $name   = shift || 'Scalar has right length';
	
	my $actual = length $string;
	my $ok = $length == $actual;
	
	$Test->ok( $ok );
		
	$Test->diag("Length of value not within bounds\n\t" .
		"Expected length=[$length]\n\t" .
		"Got [$actual]\n") unless $ok;
	}
	
=item less_than( SCALAR, BOUND )

Ok if the SCALAR is numerically less than BOUND.

=cut

sub less_than ($$;$)
	{
	my $value = shift;
	my $bound = shift;
	my $name  = shift || 'Scalar is less than bound';

	my $ok = $value < $bound;

	$Test->ok( $ok );

	$Test->diag("Number is greater than the bound.\n\t" .
		"Expected a number less than [$bound]\n\t" .
		"Got [$value]\n") unless $ok; 
	}
	
=item maxlength_ok( SCALAR, LENGTH )

Ok is the length of SCALAR is less than or equal to LENGTH.

=cut

sub maxlength_ok($$;$)
	{
	my $string = shift;
	my $length = shift;
	my $name   = shift || 'Scalar length is less than bound';
	
	my $actual = length $string;
	my $ok = $actual <= $length;
	
	$Test->ok( $ok );

	$Test->diag("Length of value longer than expected\n\t" .
		"Expected max=[$length]\n\tGot [$actual]\n") unless $ok;
	}

=item minlength_ok( SCALAR, LENGTH )

Ok is the length of SCALAR is greater than or equal to LENGTH.

=cut

sub minlength_ok($$;$)
	{
	my $string = shift;
	my $length = shift;
	my $name   = shift || 'Scalar length is greater than bound';
	
	my $actual = length $string;
	my $ok = $actual >= $length;

	$Test->ok( $ok );

	$Test->diag("Length of value shorter than expected\n\t" .
		"Expected min=[$length]\n\tGot [$actual]\n") unless $ok;
	}
	
=item number_ok( SCALAR )

Ok if the SCALAR is a number ( or a string that represents a
number ).

At the moment, a number is just a string of digits.  This needs
work.

=cut

sub number_ok($;$)
	{
	my $number = shift;
	my $name   = shift || 'Scalar is a number';
	
	$number =~ /\D/ ? $Test->ok(0) : $Test->ok(1);
	}

=item number_between_ok( SCALAR, LOWER, UPPER )

Ok if the number in SCALAR sorts between the number
in LOWER and the number in UPPER, numerically.

If you put something that isn't a number into UPPER or
LOWER, Perl will try to make it into a number and you 
may get unexpected results.

=cut

sub number_between_ok($$$;$)
	{
	my $number = shift;
	my $lower  = shift;
	my $upper  = shift;
	my $name   = shift || 'Scalar is in numerical range';
	
	unless( defined $lower and defined $upper )
		{
		$Test->ok(0);
		$Test->diag("You need to define LOWER and UPPER bounds " .
			"to use number_between_ok" );
		}
	elsif( $upper < $lower )
		{
		$Test->ok(0);
		$Test->diag( 
			"Upper bound [$upper] is lower than lower bound [$lower]" );
		}
	elsif( $number >= $lower and $number <= $upper )
		{
		$Test->ok(1);
		}
	else
		{
		$Test->ok(0);
		$Test->diag( "Number [$number] was not within bounds\n",
			"\tExpected lower bound [$lower]\n",
			"\tExpected upper bound [$upper]\n" );
		}
	}

=item string_between_ok( SCALAR, LOWER, UPPER )

Ok if the string in SCALAR sorts between the string
in LOWER and the string in UPPER, ASCII-betically.

=cut

sub string_between_ok($$$;$)
	{
	my $string = shift;
	my $lower  = shift;
	my $upper  = shift;
	my $name   = shift || 'Scalar is in string range';
	
	unless( defined $lower and defined $upper )
		{
		$Test->ok(0);
		$Test->diag("You need to define LOWER and UPPER bounds " .
			"to use string_between_ok" );
		}
	elsif( $upper lt $lower )
		{
		$Test->ok(0);
		$Test->diag( 
			"Upper bound [$upper] is lower than lower bound [$lower]" );
		}
	elsif( $string ge $lower and $string le $upper )
		{
		$Test->ok(1);
		}
	else
		{
		$Test->ok(0);
		$Test->diag( "String [$string] was not within bounds\n",
			"\tExpected lower bound [$lower]\n",
			"\tExpected upper bound [$upper]\n" );
		}
	
	}
	
=item readonly_ok( SCALAR )

Ok is the SCALAR is read-only.

=cut

sub readonly_ok($;$)
	{
	my $ok   = not readonly $_[0];
	my $name = $_[1] || 'Scalar is read-only';

	$Test->ok( $ok );

	$Test->diag("Expected readonly reference, got writeable one\n")
		unless $ok;
	}
	
=item ref_ok( SCALAR )

Ok if the SCALAR is a reference.

=cut

sub ref_ok($;$)
	{
	my $ok   = ref $_[0];
	my $name = $_[1] || 'Scalar is a reference';

	$Test->ok( $ok );

	$Test->diag("Expected reference, didn't get it\n")
		unless $ok;
	}

=item ref_type_ok( REF1, REF2 )

Ok if REF1 is the same reference type as REF2.

=cut

sub ref_type_ok($$;$)
	{
	my $ref1 = ref $_[0];
	my $ref2 = ref $_[1];
	my $ok = $ref1 eq $ref2;
	my $name = $_[2] || 'Scalar is right reference type';
	
	$Test->ok( $ok );
	
	$Test->diag("Expected references to match\n\tGot $ref1\n\t" .
		"Expected $ref2\n")	unless $ok;

	ref $_[0] eq ref $_[1] ? $Test->ok(1) : $Test->ok(0);
	}
	
=item strong_ok( SCALAR )

Ok is the SCALAR is not a weak reference.

=cut

sub strong_ok($;$)
	{
	my $ok   = not Scalar::Util::isweak( $_[0] );
	my $name = $_[1] || 'Scalar is not a weak reference';

	$Test->ok( $ok );

	$Test->diag("Expected strong reference, got weak one\n")
		unless $ok;
	}

=item tainted_ok( SCALAR )

Ok is the SCALAR is tainted.

(Tainted values may seem like a not-Ok thing, but remember, when
you use taint checking, you want Perl to taint data, so you 
should have a test to make sure it happens.)

=cut

sub tainted_ok($;$)
	{
	my $ok   = tainted $_[0];
	my $name = $_[1] || 'Scalar is tainted';

	$Test->ok( $ok );

	$Test->diag("Expected tainted data, got untainted data\n")
		unless $ok;
	}

=item untainted_ok( SCALAR )

Ok if the SCALAR is not tainted.

=cut

sub untainted_ok($;$)
	{
	my $ok = not tainted $_[0];
	my $name = $_[1] || 'Scalar is not tainted';

	$Test->ok( $ok );

	$Test->diag("Expected untainted data, got tainted data\n")
		unless $ok;
	}
	
=item weak_ok( SCALAR )

Ok if the SCALAR is a weak reference.

=cut

sub weak_ok($;$)
	{
	my $ok = Scalar::Util::isweak( $_[0] );
	my $name = $_[1] || 'Scalar is a weak reference';

	$Test->ok( $ok );

	$Test->diag("Expected weak reference, got stronge one\n")
		unless $ok;
	}

=back

=head1 TO DO

* add is_a_filehandle test

* add is_vstring test

=head1 SEE ALSO

L<Scalar::Util>,
L<Test::Data>,
L<Test::Data::Array>,
L<Test::Data::Function>,
L<Test::Data::Hash>, 
L<Test::Builder>

=head1 SOURCE AVAILABILITY

This source is part of a SourceForge project which always has the
latest sources in CVS, as well as all of the previous releases.

	https://sourceforge.net/projects/brian-d-foy/
	
If, for some reason, I disappear from the world, one of the other
members of the project can shepherd this module appropriately.

=head1 AUTHOR

brian d foy, E<lt>bdfoy@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright 2002, brian d foy, All Rights Reserved

You may use, modify, and distribute this under the same terms
as Perl itself.

=cut

"The quick brown fox jumped over the lazy dog";