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