From: mike <mike>
Date: Tue, 18 Oct 2005 17:01:55 +0000 (+0000)
Subject: New
X-Git-Tag: cpan_1_22~440
X-Git-Url: http://lists.indexdata.com/cgi-bin?a=commitdiff_plain;h=1bcfe93d44c7b7c7d21d5fcd6d994792809407f5;p=ZOOM-Perl-moved-to-github.git

New
---

diff --git a/t/10-options.t b/t/10-options.t
new file mode 100644
index 0000000..9a86349
--- /dev/null
+++ b/t/10-options.t
@@ -0,0 +1,139 @@
+# $Id: 10-options.t,v 1.1 2005-10-18 17:01:55 mike Exp $
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl 10-options.t'
+
+use strict;
+use warnings;
+use Test::More tests => 51;
+BEGIN { use_ok('Net::Z3950::ZOOM') };
+
+my $val1 = "foo";
+my $val2 = "$val1\0bar";
+
+my $o1 = Net::Z3950::ZOOM::options_create();
+Net::Z3950::ZOOM::options_set($o1, surname => "Taylor");
+Net::Z3950::ZOOM::options_set($o1, firstname => "Mike");
+ok(Net::Z3950::ZOOM::options_get($o1, "surname") eq "Taylor", "get 1");
+ok(Net::Z3950::ZOOM::options_get($o1, "firstname") eq "Mike", "get 2");
+
+my ($len, $val) = (29168);
+
+Net::Z3950::ZOOM::options_set($o1, xyz => $val2);
+$val = Net::Z3950::ZOOM::options_getl($o1, "xyz", $len);
+ok($val eq $val1,
+   "set/getl treats values as NUL-terminated, val='$val' len=$len");
+
+Net::Z3950::ZOOM::options_setl($o1, xyz => $val2, length($val2));
+$val = Net::Z3950::ZOOM::options_get($o1, "xyz");
+ok($val eq $val1,
+   "setl/get treats values as NUL-terminated, val='$val'");
+
+Net::Z3950::ZOOM::options_setl($o1, xyz => $val2, length($val2));
+$val = Net::Z3950::ZOOM::options_getl($o1, "xyz", $len);
+ok($val eq $val2,
+   "setl/getl treats values as opaque, val='$val' len=$len");
+
+my $o2 = Net::Z3950::ZOOM::options_create_with_parent($o1);
+ok(Net::Z3950::ZOOM::options_get($o2, "surname") eq "Taylor",
+   "get via parent 1");
+ok(Net::Z3950::ZOOM::options_get($o2, "firstname") eq "Mike",
+   "get via parent 2");
+
+Net::Z3950::ZOOM::options_set($o1, surname => "Parrish");
+ok(Net::Z3950::ZOOM::options_get($o2, "surname") eq "Parrish",
+   "get via parent after replacement");
+Net::Z3950::ZOOM::options_set($o2, surname => "Taylor");
+ok(Net::Z3950::ZOOM::options_get($o2, "surname") eq "Taylor",
+   "get via parent after overwrite");
+ok(Net::Z3950::ZOOM::options_get($o1, "surname") eq "Parrish",
+   "get from parent after child overwrite");
+
+my $o3 = Net::Z3950::ZOOM::options_create();
+Net::Z3950::ZOOM::options_set($o3, firstname => "Fiona");
+
+my $o4 = Net::Z3950::ZOOM::options_create_with_parent2($o3, $o2);
+$val = Net::Z3950::ZOOM::options_get($o4, "firstname");
+ok($val eq "Fiona",
+   "get via first parent overrides second '$val'");
+ok(Net::Z3950::ZOOM::options_get($o4, "surname") eq "Taylor",
+   "get via first parent");
+Net::Z3950::ZOOM::options_set($o1, initial => "P");
+ok(Net::Z3950::ZOOM::options_get($o4, "initial") eq "P",
+   "get via grandparent");
+
+Net::Z3950::ZOOM::options_destroy($o1);
+ok(1, "grandparent destroyed");
+$val = Net::Z3950::ZOOM::options_get($o4, "initial");
+ok($val eq "P", "referenced object survived destruction");
+
+Net::Z3950::ZOOM::options_destroy($o4);
+ok(1, "grandchild destroyed");
+Net::Z3950::ZOOM::options_destroy($o3);
+ok(1, "first parent destroyed");
+Net::Z3950::ZOOM::options_destroy($o2);
+ok(1, "second parent destroyed");
+
+$o1 = Net::Z3950::ZOOM::options_create();
+# 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(Net::Z3950::ZOOM::options_get_bool($o1, "undefined", 1),
+   "get_bool() defaulted to true");
+ok(!Net::Z3950::ZOOM::options_get_bool($o1, "undefined", 0),
+   "get_bool() defaulted to false");
+
+sub check_bool {
+    my($o, $val, $truep) = @_;
+    Net::Z3950::ZOOM::options_set($o, x => $val);
+    ok(Net::Z3950::ZOOM::options_get_bool($o, "x", 1) eq $truep,
+       "get_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(Net::Z3950::ZOOM::options_get_int($o1, "undefined", 42) == 42,
+   "get_int() defaulted to 42");
+
+sub check_int {
+    my($o, $val, $expected) = @_;
+    Net::Z3950::ZOOM::options_set($o, x => $val);
+    my $nval = Net::Z3950::ZOOM::options_get_int($o, "x", 1);
+    ok($nval == $expected,
+       "get_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) = @_;
+    Net::Z3950::ZOOM::options_set_int($o, x => $val);
+    my $nval = Net::Z3950::ZOOM::options_get_int($o, "x", 1);
+    ok($nval == $expected,
+       "get_int() considers $val to be $nval, expected $expected");
+}
+
diff --git a/t/11-option-callback.t b/t/11-option-callback.t
new file mode 100644
index 0000000..fd1fff1
--- /dev/null
+++ b/t/11-option-callback.t
@@ -0,0 +1,59 @@
+# $Id: 11-option-callback.t,v 1.1 2005-10-18 17:01:55 mike Exp $
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl 10-options.t'
+
+use strict;
+use warnings;
+use Test::More tests => 19;
+BEGIN { use_ok('Net::Z3950::ZOOM') };
+
+# This callback function provides values only options whose names
+# begin with consonants, in which case the value is the option name
+# concatenated with a hyphen and the the value of the user-data that
+# was lodged along with the callback.
+#
+sub f_option {
+    my($udata, $name) = @_;
+
+    return undef if $name =~ /^[aeiou]/;
+    return "$name-$udata";
+}
+
+my $o1 = Net::Z3950::ZOOM::options_create();
+Net::Z3950::ZOOM::options_set_callback($o1, "f_option", "xyz");
+Net::Z3950::ZOOM::options_set($o1, isisaurus => "was titanosaurus");
+
+check($o1, "apatosaurus", undef);
+check($o1, "brachiosaurus", "brachiosaurus-xyz");
+check($o1, "camarasaurus", "camarasaurus-xyz");
+check($o1, "diplodocus", "diplodocus-xyz");
+check($o1, "euhelopus", undef);
+check($o1, "futalognkosaurus", "futalognkosaurus-xyz");
+check($o1, "gigantosaurus", "gigantosaurus-xyz");
+check($o1, "haplocanthosaurus", "haplocanthosaurus-xyz");
+check($o1, "isisaurus", "was titanosaurus");
+check($o1, "janenschia", "janenschia-xyz");
+
+my $o2 = Net::Z3950::ZOOM::options_create();
+Net::Z3950::ZOOM::options_set_callback($o2, "f_option", "abc");
+check($o2, "apatosaurus", undef);
+check($o2, "brachiosaurus", "brachiosaurus-abc");
+check($o2, "kxxxxxxxxxxxxx", "kxxxxxxxxxxxxx-abc");
+check($o2, "limaysaurus", "limaysaurus-abc");
+check($o2, "mamenchisaurus", "mamenchisaurus-abc");
+check($o2, "nurosaurus", "nurosaurus-abc");
+check($o2, "omeisaurus", undef);
+check($o2, "patagosaurus", "patagosaurus-abc");
+
+sub check {
+    my($opts, $key, $expected) = @_;
+
+    my $val = Net::Z3950::ZOOM::options_get($opts, $key);
+    #print "$opts($key) ", (defined $val ? "= '$val'" : "undefined"), "\n";
+    if (defined $expected) {
+	ok ($val eq $expected, "value for '$key' is '$val'");
+    } else {
+	ok (!defined $val, "no value for '$key'");
+    }
+}