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'
6 use Test::More tests => 51;
7 BEGIN { use_ok('ZOOM') };
10 my $val2 = "$val1\0bar";
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");
20 $o1->option(xyz => $val2);
21 $val = $o1->option_binary("xyz");
23 "set/getl treats values as NUL-terminated, val='$val'");
25 $o1->option_binary(xyz => $val2);
26 $val = $o1->option("xyz");
28 "setl/get treats values as NUL-terminated, val='$val'");
30 $o1->option_binary(xyz => $val2);
31 $val = $o1->option_binary("xyz");
33 "setl/getl treats values as opaque, val='$val'");
35 my $o2 = new ZOOM::Options($o1);
36 ok($o2->option("surname") eq "Taylor",
38 ok($o2->option("firstname") eq "Mike",
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");
50 my $o3 = new ZOOM::Options();
51 $o3->option(firstname => "Fiona");
53 my $o4 = new ZOOM::Options($o3, $o2);
54 $val = $o4->option("firstname");
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");
64 ok(1, "grandparent destroyed");
65 $val = $o4->option("initial");
66 ok($val eq "P", "referenced object survived destruction");
69 ok(1, "grandchild destroyed");
71 ok(1, "first parent destroyed");
73 ok(1, "second parent destroyed");
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");
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"));
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");
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");
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);
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");