1#line 1
2# $Id$
3package Test::Data::Scalar;
4use strict;
5
6use base qw(Exporter);
7use vars qw(@EXPORT $VERSION);
8
9@EXPORT = qw(
10	blessed_ok defined_ok dualvar_ok greater_than length_ok
11	less_than maxlength_ok minlength_ok number_ok
12	readonly_ok ref_ok ref_type_ok strong_ok tainted_ok
13	untainted_ok weak_ok undef_ok number_between_ok
14	string_between_ok
15	);
16
17$VERSION = '1.22';
18
19use Scalar::Util;
20use Test::Builder;
21
22my $Test = Test::Builder->new();
23
24#line 44
25
26sub blessed_ok ($;$)
27	{
28	my $ref  = ref $_[0];
29	my $ok   = Scalar::Util::blessed($_[0]);
30	my $name = $_[1] || 'Scalar is blessed';
31
32	$Test->diag("Expected a blessed value, but didn't get it\n\t" .
33		qq|Reference type is "$ref"\n| ) unless $ok;
34
35	$Test->ok( $ok, $name );
36	}
37
38#line 62
39
40sub defined_ok ($;$)
41	{
42	my $ok   = defined $_[0];
43	my $name = $_[1] || 'Scalar is defined';
44
45	$Test->diag("Expected a defined value, got an undefined one\n", $name )
46		unless $ok;
47
48	$Test->ok( $ok, $name );
49	}
50
51#line 79
52
53sub undef_ok ($;$)
54	{
55	my $name = $_[1] || 'Scalar is undefined';
56
57	if( @_ > 0 )
58		{
59		my $ok   = not defined $_[0];
60
61		$Test->diag("Expected an undefined value, got a defined one\n")
62			unless $ok;
63
64		$Test->ok( $ok, $name );
65		}
66	else
67		{
68		$Test->diag("Expected an undefined value, but got no arguments\n");
69
70		$Test->ok( 0, $name );
71		}
72	}
73
74#line 119
75
76#line 125
77
78sub greater_than ($$;$)
79	{
80	my $value = shift;
81	my $bound = shift;
82	my $name  = shift || 'Scalar is greater than bound';
83
84	my $ok = $value > $bound;
85
86	$Test->diag("Number is less than the bound.\n\t" .
87		"Expected a number greater than [$bound]\n\t" .
88		"Got [$value]\n") unless $ok;
89
90	$Test->ok( $ok, $name );
91	}
92
93#line 146
94
95sub length_ok ($$;$)
96	{
97	my $string = shift;
98	my $length = shift;
99	my $name   = shift || 'Scalar has right length';
100
101	my $actual = length $string;
102	my $ok = $length == $actual;
103
104	$Test->diag("Length of value not within bounds\n\t" .
105		"Expected length=[$length]\n\t" .
106		"Got [$actual]\n") unless $ok;
107
108	$Test->ok( $ok, $name );
109	}
110
111#line 168
112
113sub less_than ($$;$)
114	{
115	my $value = shift;
116	my $bound = shift;
117	my $name  = shift || 'Scalar is less than bound';
118
119	my $ok = $value < $bound;
120
121	$Test->diag("Number is greater than the bound.\n\t" .
122		"Expected a number less than [$bound]\n\t" .
123		"Got [$value]\n") unless $ok;
124
125	$Test->ok( $ok, $name );
126	}
127
128#line 189
129
130sub maxlength_ok($$;$)
131	{
132	my $string = shift;
133	my $length = shift;
134	my $name   = shift || 'Scalar length is less than bound';
135
136	my $actual = length $string;
137	my $ok = $actual <= $length;
138
139	$Test->diag("Length of value longer than expected\n\t" .
140		"Expected max=[$length]\n\tGot [$actual]\n") unless $ok;
141
142	$Test->ok( $ok, $name );
143	}
144
145#line 210
146
147sub minlength_ok($$;$)
148	{
149	my $string = shift;
150	my $length = shift;
151	my $name   = shift || 'Scalar length is greater than bound';
152
153	my $actual = length $string;
154	my $ok = $actual >= $length;
155
156	$Test->diag("Length of value shorter than expected\n\t" .
157		"Expected min=[$length]\n\tGot [$actual]\n") unless $ok;
158
159	$Test->ok( $ok, $name );
160	}
161
162#line 235
163
164sub number_ok($;$)
165	{
166	my $number = shift;
167	my $name   = shift || 'Scalar is a number';
168
169	$number =~ /\D/ ? $Test->ok( 0, $name ) : $Test->ok( 1, $name );
170	}
171
172#line 254
173
174sub number_between_ok($$$;$)
175	{
176	my $number = shift;
177	my $lower  = shift;
178	my $upper  = shift;
179	my $name   = shift || 'Scalar is in numerical range';
180
181	unless( defined $lower and defined $upper )
182		{
183		$Test->diag("You need to define LOWER and UPPER bounds " .
184			"to use number_between_ok" );
185		$Test->ok( 0, $name );
186		}
187	elsif( $upper < $lower )
188		{
189		$Test->diag(
190			"Upper bound [$upper] is lower than lower bound [$lower]" );
191		$Test->ok( 0, $name );
192		}
193	elsif( $number >= $lower and $number <= $upper )
194		{
195		$Test->ok( 1, $name );
196		}
197	else
198		{
199		$Test->diag( "Number [$number] was not within bounds\n",
200			"\tExpected lower bound [$lower]\n",
201			"\tExpected upper bound [$upper]\n" );
202		$Test->ok( 0, $name );
203		}
204	}
205
206#line 293
207
208sub string_between_ok($$$;$)
209	{
210	my $string = shift;
211	my $lower  = shift;
212	my $upper  = shift;
213	my $name   = shift || 'Scalar is in string range';
214
215	unless( defined $lower and defined $upper )
216		{
217		$Test->diag("You need to define LOWER and UPPER bounds " .
218			"to use string_between_ok" );
219		$Test->ok( 0, $name );
220		}
221	elsif( $upper lt $lower )
222		{
223		$Test->diag(
224			"Upper bound [$upper] is lower than lower bound [$lower]" );
225		$Test->ok( 0, $name );
226		}
227	elsif( $string ge $lower and $string le $upper )
228		{
229		$Test->ok( 1, $name );
230		}
231	else
232		{
233		$Test->diag( "String [$string] was not within bounds\n",
234			"\tExpected lower bound [$lower]\n",
235			"\tExpected upper bound [$upper]\n" );
236		$Test->ok( 0, $name );
237		}
238
239	}
240
241#line 332
242
243sub readonly_ok($;$)
244	{
245	my $ok   = not Scalar::Util::readonly( $_[0] );
246	my $name = $_[1] || 'Scalar is read-only';
247
248	$Test->diag("Expected readonly reference, got writeable one\n")
249		unless $ok;
250
251	$Test->ok( $ok, $name );
252	}
253
254#line 349
255
256sub ref_ok($;$)
257	{
258	my $ok   = ref $_[0];
259	my $name = $_[1] || 'Scalar is a reference';
260
261	$Test->diag("Expected reference, didn't get it\n")
262		unless $ok;
263
264	$Test->ok( $ok, $name );
265	}
266
267#line 366
268
269sub ref_type_ok($$;$)
270	{
271	my $ref1 = ref $_[0];
272	my $ref2 = ref $_[1];
273	my $ok = $ref1 eq $ref2;
274	my $name = $_[2] || 'Scalar is right reference type';
275
276	$Test->diag("Expected references to match\n\tGot $ref1\n\t" .
277		"Expected $ref2\n")	unless $ok;
278
279	ref $_[0] eq ref $_[1] ? $Test->ok( 1, $name ) : $Test->ok( 0, $name );
280	}
281
282#line 385
283
284sub strong_ok($;$)
285	{
286	my $ok   = not Scalar::Util::isweak( $_[0] );
287	my $name = $_[1] || 'Scalar is not a weak reference';
288
289	$Test->diag("Expected strong reference, got weak one\n")
290		unless $ok;
291
292	$Test->ok( $ok, $name );
293	}
294
295#line 406
296
297sub tainted_ok($;$)
298	{
299	my $ok   = Scalar::Util::tainted( $_[0] );
300	my $name = $_[1] || 'Scalar is tainted';
301
302	$Test->diag("Expected tainted data, got untainted data\n")
303		unless $ok;
304
305	$Test->ok( $ok, $name );
306	}
307
308#line 423
309
310sub untainted_ok($;$)
311	{
312	my $ok = not Scalar::Util::tainted( $_[0] );
313	my $name = $_[1] || 'Scalar is not tainted';
314
315	$Test->diag("Expected untainted data, got tainted data\n")
316		unless $ok;
317
318	$Test->ok( $ok, $name );
319	}
320
321#line 440
322
323sub weak_ok($;$)
324	{
325	my $ok = Scalar::Util::isweak( $_[0] );
326	my $name = $_[1] || 'Scalar is a weak reference';
327
328	$Test->diag("Expected weak reference, got stronge one\n")
329		unless $ok;
330
331	$Test->ok( $ok, $name );
332	}
333
334#line 488
335
336
337"The quick brown fox jumped over the lazy dog";
338