# $Id: 20-options.t,v 1.1 2005/10/19 13:53:47 mike Exp $ # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 20-options.t' use strict; use warnings; use Test::More tests => 51; BEGIN { use_ok('ZOOM') }; my $val1 = "foo"; my $val2 = "$val1\0bar"; my $o1 = new ZOOM::Options(); $o1->option(surname => "Taylor"); $o1->option(firstname => "Mike"); ok($o1->option("surname") eq "Taylor", "get 1"); ok($o1->option("firstname") eq "Mike", "get 2"); my $val; $o1->option(xyz => $val2); $val = $o1->option_binary("xyz"); ok($val eq $val1, "set/getl treats values as NUL-terminated, val='$val'"); $o1->option_binary(xyz => $val2); $val = $o1->option("xyz"); ok($val eq $val1, "setl/get treats values as NUL-terminated, val='$val'"); $o1->option_binary(xyz => $val2); $val = $o1->option_binary("xyz"); ok($val eq $val2, "setl/getl treats values as opaque, val='$val'"); my $o2 = new ZOOM::Options($o1); ok($o2->option("surname") eq "Taylor", "get via parent 1"); ok($o2->option("firstname") eq "Mike", "get via parent 2"); $o1->option(surname => "Parrish"); ok($o2->option("surname") eq "Parrish", "get via parent after replacement"); $o2->option(surname => "Taylor"); ok($o2->option("surname") eq "Taylor", "get via parent after overwrite"); ok($o1->option("surname") eq "Parrish", "get from parent after child overwrite"); my $o3 = new ZOOM::Options(); $o3->option(firstname => "Fiona"); my $o4 = new ZOOM::Options($o3, $o2); $val = $o4->option("firstname"); ok($val eq "Fiona", "get via first parent overrides second '$val'"); ok($o4->option("surname") eq "Taylor", "get via first parent"); $o1->option(initial => "P"); ok($o4->option("initial") eq "P", "get via grandparent"); $o1->destroy(); ok(1, "grandparent destroyed"); $val = $o4->option("initial"); ok($val eq "P", "referenced object survived destruction"); $o4->destroy(); ok(1, "grandchild destroyed"); $o3->destroy(); ok(1, "first parent destroyed"); $o2->destroy(); ok(1, "second parent destroyed"); $o1 = new ZOOM::Options(); # Strange but true: only "T" and "1" are considered true. check_bool($o1, y => 0); check_bool($o1, Y => 0); check_bool($o1, t => 0); check_bool($o1, T => 1); check_bool($o1, n => 0); check_bool($o1, N => 0); check_bool($o1, 0 => 0); check_bool($o1, 1 => 1); check_bool($o1, 2 => 0); check_bool($o1, 3 => 0); check_bool($o1, yes => 0); check_bool($o1, YES => 0); check_bool($o1, true => 0); check_bool($o1, TRUE => 0); ok($o1->bool("undefined", 1), "bool() defaulted to true"); ok(!$o1->bool("undefined", 0), "bool() defaulted to false"); sub check_bool { my($o, $val, $truep) = @_; $o->option(x => $val); ok($o->bool("x", 1) eq $truep, "bool() considers $val to be " . ($truep ? "true" : "false")); } check_int($o1, 0 => 0); check_int($o1, 1 => 1); check_int($o1, 2 => 2); check_int($o1, 3 => 3); check_int($o1, -17 => -17); check_int($o1, "012" => 12); check_int($o1, "0000003" => 3); check_int($o1, " 3" => 3); check_int($o1, " 34" => 34); check_int($o1, " 3 4" => 3); check_int($o1, " 3,456" => 3); ok($o1->int("undefined", 42) == 42, "int() defaulted to 42"); sub check_int { my($o, $val, $expected) = @_; $o->option(x => $val); my $nval = $o->int("x", 1); ok($nval == $expected, "int() considers $val to be $nval, expected $expected"); } check_set_int($o1, 0 => 0); check_set_int($o1, 3 => 3); check_set_int($o1, -17 => -17); check_set_int($o1, " 34" => 34); sub check_set_int { my($o, $val, $expected) = @_; $o->set_int(x => $val); my $nval = $o->int("x", 1); ok($nval == $expected, "int() considers $val to be $nval, expected $expected"); }