--- trunk/t/3-normalize-set.t	2006/05/12 21:46:19	464
+++ trunk/t/3-normalize-set.t	2006/05/14 12:35:20	490
@@ -2,21 +2,21 @@
 
 use strict;
 
-use Test::More tests => 25;
+use Test::More tests => 64;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
 use File::Slurp;
 
 use Data::Dumper;
-my $debug = 0;
+my $debug = shift @ARGV;
 
 BEGIN {
 	use_ok( 'WebPAC::Normalize::Set' );
 }
 
 ok(my $abs_path = abs_path($0), "abs_path");
-$abs_path =~ s#/[^/]*$#/../#;
+$abs_path =~ s#/[^/]*$#/#;
 diag "abs_path: $abs_path" if ($debug);
 
 #throws_ok { new WebPAC::Normalize::XML( lookup_regex => 'foo' ) } qr/pair/, "lookup_regex without lookup";
@@ -113,27 +113,51 @@
 	ok( defined(@_) );
 }
 
+# how much of string evaled to display?
+my $max_eval_output = 170;
+
+sub dump_error {
+	my ($msg,$code) = @_;
+
+	my @l = split(/[\n\r]/, $code);
+	my $out = "$msg\n";
+
+	foreach my $i ( 0 .. $#l ) {
+		$out .= sprintf("%2d: %s\n", $i, $l[$i]);
+	}
+
+	return $out;
+}
+
 sub test_s {
 	my $t = shift || die;
-	$t =~ s/[\n\r\s]+/ /gs;
-	ok(my $v = eval "$t", "eval: $t");
-	ok(! $@, $@ ? "error: $@" : "no error");
+
+	my $eval_t = $t;
+	$eval_t =~ s/[\n\r\s]+/ /gs;
+	$eval_t = substr($eval_t,0,$max_eval_output) . '...' if (length($eval_t) > $max_eval_output);
+
+	eval "$t";
+	ok(! $@, $@ ? dump_error($@, $t) : "eval: $eval_t");
 }
 
 {
 	no strict 'subs';
 	use WebPAC::Normalize::Set;
 
+	ok(! set_lookup( undef ), "set_lookup(undef)");
+
 	set_rec( $rec1 );
 
-	cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2' );
-	cmp_ok( join(",", rec2('200','a'), rec2('200','b') ), 'eq', '200a,200a*2,200b' );
-	cmp_ok( join(" * ", sort(rec1('200'), rec1('201') )), 'eq', '200a * 200a*2 * 200b * 200c * 200d * 200d*2 * 201x * 201y' );
+	cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2', 'join rec2' );
+	cmp_ok( join(",", rec2('200','a'), rec2('200','b') ), 'eq', '200a,200a*2,200b', 'join rec2 rec2' );
+	cmp_ok( join(" * ", sort(rec1('200'), rec1('201') )), 'eq', '200a * 200a*2 * 200b * 200c * 200d * 200d*2 * 201x * 201y', 'join sort rec1 rec1' );
+	diag "is_deeply checks\n";
 	is_deeply( \[ rec1('200') ], \[ qw/200a 200b 200c 200d 200a*2 200d*2/ ] );
 	is_deeply( \[ regex( 's/0/o/g', rec1('200') ) ],  \[ qw/2ooa 2oob 2ooc 2ood 2ooa*2 2ood*2/ ]);
 	is_deeply( \[ grep { /\*/ } regex( 's/0/o/g', rec1('200') ) ], \[ qw/2ooa*2 2ood*2/ ]);
 	is_deeply( \[ rec('902') ], \[ '900' ] );
-	cmp_ok( rec('902'), 'eq', rec('902','z') );
+
+	cmp_ok( rec('902'), 'eq', rec('902','z'), 'rec sf' );
 
 	set_lookup( $lookup1 );
 	
@@ -145,13 +169,55 @@
 				)
 			) 
 		),
-	'eq', 'lookup 1 i lookup 2');
+	'eq', 'lookup 1 i lookup 2', 'join lookup regex rec2');
+
+	# check join_with operations
+
+	sub test_join_with_2 {
+		my ($a,$b,$e) = @_;
+
+		cmp_ok(
+			join_with(" <1> ",
+				rec('201',$a),
+				rec('201',$b),
+			), 
+		'eq', $e, "join_with $a <1> $b = $e");
+	}
+
+	test_join_with_2('_','_','');
+	test_join_with_2('x','_','201x');
+	test_join_with_2('_','x','201x');
+	test_join_with_2('x','y','201x <1> 201y');
+
+	sub test_join_with_3 {
+		my ($a,$b,$c,$e) = @_;
+
+		cmp_ok(
+			join_with(" <1> ", rec('201',$a),
+				join_with(" <2> ", rec('201',$b),
+					rec('201',$c),
+				)
+			), 
+		'eq', $e, "join_with $a <1> $b <2> $c = $e");
+	};
+
+	test_join_with_3('_','_','_','');
+	test_join_with_3('x','_','_','201x');
+	test_join_with_3('_','x','_','201x');
+	test_join_with_3('_','_','x','201x');
+	test_join_with_3('x','y','_','201x <1> 201y');
+	test_join_with_3('x','_','y','201x <1> 201y');
+	test_join_with_3('_','x','y','201x <2> 201y');
+	test_join_with_3('x','_','y','201x <1> 201y');
+	test_join_with_3('x','y','x','201x <1> 201y <2> 201x');
+
+	# test lookups
 
 	set_lookup( $lookup2 );
 
-	is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ] );
+	is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ], 'lookup prefix' );
 
-	ok(! lookup('non-existent') );
+	ok(! lookup('non-existent'), 'lookup non-existant' );
 
 	set_rec( $rec2 );
 
@@ -186,14 +252,88 @@
 	ok(my $ds = get_ds(), "get_ds");
 	diag "ds = ", Dumper($ds) if ($debug);
 
+
+	sub test_check_ds {
+
+		my $t = shift;
+
+		ok($ds = get_ds(), 'get_ds');
+		diag Dumper( $ds ) if ($debug);
+
+		ok( $ds && $ds->{something}, 'get_ds->something exists' );
+		ok( $ds && $ds->{something}->{$t}, 'get_ds->something->'.$t.' exists') if ($t);
+		ok( $ds && !$ds->{empty}, 'get_ds->empty doesn\'t' );
+
+		return $ds;
+	}
+
+	clean_ds();
+	test_s(qq{ search('something', '42'); });
+	test_s(qq{ search('empty', ''); });
+	test_check_ds('search');
+
 	clean_ds();
+	test_s(qq{ display('something', '42'); });
+	test_s(qq{ display('empty', ''); });
+	test_check_ds('display');
 
-	my $n = read_file( "$abs_path/conf/normalize/isis_ffzg.pl" );
+	clean_ds();
+	test_s(qq{ tag('something', '42'); });
+	test_s(qq{ tag('empty', ''); });
+	test_check_ds('search');
+	test_check_ds('display');
+
+	clean_ds();
+	my $n = read_file( "$abs_path/data/normalize.pl" );
 	$n .= "\n1;\n";
 	#diag "normalize code:\n$n\n";
 	test_s( $n );
 
 	ok($ds = get_ds(), "get_ds");
 	diag "ds = ", Dumper($ds) if ($debug);
+
+	my $rec = {
+		'200' => [{
+			'a' => '200a',
+			'b' => '200b',
+		}],
+	};
+	my $rules = qq{ search('mixed', rec('200') ) };
+	
+	clean_ds();
+	set_rec( $rec );
+	test_s( $rules );
+	ok($ds = get_ds(), "get_ds");
+	is_deeply( $ds, {
+		'mixed' => {
+			'search' => [ '200a', '200b' ],
+			'tag' => 'mixed'
+		}
+	}, 'correct get_ds');
+
+	ok(my $ds2 = WebPAC::Normalize::Set::data_structure(
+		row => $rec,
+		rules => $rules,
+	), 'data_structure');
+	is_deeply( $ds, $ds2, 'data_structure(s) same');
+
+	# wird and non-valid structure which is supported anyway
+	clean_ds();
+	set_rec({
+		'200' => [{
+			'a' => '200a',
+		},
+			'200-solo'
+		]
+	});
+	test_s(qq{ search('mixed', rec('200') ) });
+	ok($ds = get_ds(), "get_ds");
+	is_deeply( $ds, {
+		'mixed' => {
+			'search' => [ '200a', '200-solo' ],
+			'tag' => 'mixed'
+		}
+	}, 'correct get_ds');
+
 }