t/20-options.t

   1 # Before `make install' is performed this script should be runnable with
   2 # `make test'. After `make install' it should work as `perl 20-options.t'
   3
   4 use strict;
   5 use warnings;
   6 use Test::More tests => 51;
   7 BEGIN { use_ok('ZOOM') };
   8
   9 my $val1 = "foo";
  10 my $val2 = "$val1\0bar";
  11
  12 my $o1 = new ZOOM::Options();
  13 $o1->option(surname => "Taylor");
  14 $o1->option(firstname => "Mike");
  15 ok($o1->option("surname") eq "Taylor", "get 1");
  16 ok($o1->option("firstname") eq "Mike", "get 2");
  17
  18 my $val;
  19
  20 $o1->option(xyz => $val2);
  21 $val = $o1->option_binary("xyz");
  22 ok($val eq $val1,
  23    "set/getl treats values as NUL-terminated, val='$val'");
  24
  25 $o1->option_binary(xyz => $val2);
  26 $val = $o1->option("xyz");
  27 ok($val eq $val1,
  28    "setl/get treats values as NUL-terminated, val='$val'");
  29
  30 $o1->option_binary(xyz => $val2);
  31 $val = $o1->option_binary("xyz");
  32 ok($val eq $val2,
  33    "setl/getl treats values as opaque, val='$val'");
  34
  35 my $o2 = new ZOOM::Options($o1);
  36 ok($o2->option("surname") eq "Taylor",
  37    "get via parent 1");
  38 ok($o2->option("firstname") eq "Mike",
  39    "get via parent 2");
  40
  41 $o1->option(surname => "Parrish");
  42 ok($o2->option("surname") eq "Parrish",
  43    "get via parent after replacement");
  44 $o2->option(surname => "Taylor");
  45 ok($o2->option("surname") eq "Taylor",
  46    "get via parent after overwrite");
  47 ok($o1->option("surname") eq "Parrish",
  48    "get from parent after child overwrite");
  49
  50 my $o3 = new ZOOM::Options();
  51 $o3->option(firstname => "Fiona");
  52
  53 my $o4 = new ZOOM::Options($o3, $o2);
  54 $val = $o4->option("firstname");
  55 ok($val eq "Fiona",
  56    "get via first parent overrides second '$val'");
  57 ok($o4->option("surname") eq "Taylor",
  58    "get via first parent");
  59 $o1->option(initial => "P");
  60 ok($o4->option("initial") eq "P",
  61    "get via grandparent");
  62
  63 $o1->destroy();
  64 ok(1, "grandparent destroyed");
  65 $val = $o4->option("initial");
  66 ok($val eq "P", "referenced object survived destruction");
  67
  68 $o4->destroy();
  69 ok(1, "grandchild destroyed");
  70 $o3->destroy();
  71 ok(1, "first parent destroyed");
  72 $o2->destroy();
  73 ok(1, "second parent destroyed");
  74
  75 $o1 = new ZOOM::Options();
  76 # Strange but true: only "T" and "1" are considered true.
  77 check_bool($o1, y => 0);
  78 check_bool($o1, Y => 0);
  79 check_bool($o1, t => 0);
  80 check_bool($o1, T => 1);
  81 check_bool($o1, n => 0);
  82 check_bool($o1, N => 0);
  83 check_bool($o1, 0 => 0);
  84 check_bool($o1, 1 => 1);
  85 check_bool($o1, 2 => 0);
  86 check_bool($o1, 3 => 0);
  87 check_bool($o1, yes => 0);
  88 check_bool($o1, YES => 0);
  89 check_bool($o1, true => 0);
  90 check_bool($o1, TRUE => 0);
  91 ok($o1->bool("undefined", 1),
  92    "bool() defaulted to true");
  93 ok(!$o1->bool("undefined", 0),
  94    "bool() defaulted to false");
  95
  96 sub check_bool {
  97     my($o, $val, $truep) = @_;
  98     $o->option(x => $val);
  99     ok($o->bool("x", 1) eq $truep,
 100        "bool() considers $val to be " . ($truep ? "true" : "false"));
 101 }
 102
 103 check_int($o1, 0 => 0);
 104 check_int($o1, 1 => 1);
 105 check_int($o1, 2 => 2);
 106 check_int($o1, 3 => 3);
 107 check_int($o1, -17 => -17);
 108 check_int($o1, "012" => 12);
 109 check_int($o1, "0000003" => 3);
 110 check_int($o1, "    3" => 3);
 111 check_int($o1, "     34" => 34);
 112 check_int($o1, "      3 4" => 3);
 113 check_int($o1, "      3,456" => 3);
 114 ok($o1->int("undefined", 42) == 42,
 115    "int() defaulted to 42");
 116
 117 sub check_int {
 118     my($o, $val, $expected) = @_;
 119     $o->option(x => $val);
 120     my $nval = $o->int("x", 1);
 121     ok($nval == $expected,
 122        "int() considers $val to be $nval, expected $expected");
 123 }
 124
 125 check_set_int($o1, 0 => 0);
 126 check_set_int($o1, 3 => 3);
 127 check_set_int($o1, -17 => -17);
 128 check_set_int($o1, "     34" => 34);
 129
 130 sub check_set_int {
 131     my($o, $val, $expected) = @_;
 132     $o->set_int(x => $val);
 133     my $nval = $o->int("x", 1);
 134     ok($nval == $expected,
 135        "int() considers $val to be $nval, expected $expected");
 136 }
 137