Dogcows Code - chaz/p5-CGI-Ex/blob - t/1_validate_09_perl_file.t

   1 # -*- Mode: Perl; -*-
   2
   3 use strict;
   4
   5 $^W = 1;
   6
   7 ### determine number of tests
   8 seek(DATA,0,0);
   9 my $prog  = join "", <DATA>;
  10 my @tests = ($prog =~ /&print_ok\(/g);
  11 my $tests = @tests;
  12 print "1..$tests\n";
  13
  14 require CGI::Ex::Validate;
  15
  16 my ($N, $v, $e, $ok) = (0);
  17
  18 sub validate {
  19   return scalar &CGI::Ex::Validate::validate(@_);
  20 }
  21 sub print_ok {
  22   my $ok = shift;
  23   $N ++;
  24   warn "Test failed at line ".(caller)[2]."\n" if ! $ok;
  25   print "" . ($ok ? "" : "not ") . "ok $N\n";
  26 }
  27 &print_ok(1);
  28
  29 ###----------------------------------------------------------------###
  30
  31 ### where are my samples
  32 my $dir = __FILE__;
  33 $dir =~ tr|\\|/|; # should probably use File::Spec
  34 $dir =~ s|[^/]+$|samples| || die "Couldn't determine dir";
  35 $dir =~ s|^t/|./t/|; # to satisfy conf
  36
  37 ### single group
  38 $v = "$dir/perl1.pl";
  39
  40 $e = &validate({}, $v);
  41 &print_ok($e);
  42 $e = &validate({user => 1}, $v);
  43 &print_ok(! $e);
  44 $e = &validate({user => 1, bar => 1}, $v);
  45 &print_ok($e);
  46 $e = &validate({user => 1, bar => 1, foo => 1}, $v);
  47 &print_ok(! $e);
  48
  49
  50 ### three groups, some with validate_if's - using arrayref
  51 $v = "$dir/perl2.pl";
  52
  53 $e = &validate({}, $v);
  54 &print_ok($e);
  55
  56 $e = &validate({
  57   raspberry => 'tart',
  58 }, $v);
  59 &print_ok(! $e);
  60
  61 $e = &validate({
  62   foo => 1,
  63   raspberry => 'tart',
  64 }, $v);
  65 &print_ok($e);
  66
  67 $e = &validate({
  68   foo => 1,
  69   bar => 1,
  70   raspberry => 'tart',
  71 }, $v);
  72 &print_ok(! $e);
  73
  74 $e = &validate({
  75   foo => 1,
  76   bar => 1,
  77   hem => 1,
  78   raspberry => 'tart',
  79 }, $v);
  80 &print_ok($e);
  81
  82 $e = &validate({
  83   foo => 1,
  84   bar => 1,
  85   hem => 1,
  86   haw => 1,
  87   raspberry => 'tart',
  88 }, $v);
  89 &print_ok(! $e);
  90
  91 __DATA__