Dogcows Code - chaz/p5-CGI-Ex/blob - t/1_validate_06_groups.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 ### three groups, some with validate_if's
  32 $v = [{
  33   'group validate_if' => 'foo',
  34   bar => {required => 1},
  35 },
  36 {
  37   'group validate_if' => 'hem',
  38   haw => {required => 1},
  39 },
  40 {
  41   raspberry => {required => 1},
  42 }];
  43
  44 $e = &validate({}, $v);
  45 &print_ok($e);
  46
  47 $e = &validate({
  48   raspberry => 'tart',
  49 }, $v);
  50 &print_ok(! $e);
  51
  52 $e = &validate({
  53   foo => 1,
  54   raspberry => 'tart',
  55 }, $v);
  56 &print_ok($e);
  57
  58 $e = &validate({
  59   foo => 1,
  60   bar => 1,
  61   raspberry => 'tart',
  62 }, $v);
  63 &print_ok(! $e);
  64
  65 $e = &validate({
  66   foo => 1,
  67   bar => 1,
  68   hem => 1,
  69   raspberry => 'tart',
  70 }, $v);
  71 &print_ok($e);
  72
  73 $e = &validate({
  74   foo => 1,
  75   bar => 1,
  76   hem => 1,
  77   haw => 1,
  78   raspberry => 'tart',
  79 }, $v);
  80 &print_ok(! $e);
  81
  82 __DATA__