1#!/usr/bin/perl -ws
2
3use strict;
4
5# command line parameters - see perlrun (-s switch)
6use vars qw($debug);
7
8use Test::More tests => 110;
9
10use lib "t/springfield";
11
12use Springfield qw(%id stdpop leaked @kids @opinions);
13
14my $tests = {(
15	      "IntrArray" => [ 1, "ia_children", "NaturalPerson", ],
16	      "Array"     => [ 0, "children",    "NaturalPerson", ],
17	      "Hash"      => [ 0, "h_opinions",  "Opinion",       ],
18	      "IntrHash"  => [ 1, "ih_opinions", "Opinion",       ],
19	      "Set"       => [ 0, "s_children",  "NaturalPerson", ],
20	      "IntrSet"   => [ 1, "is_children", "NaturalPerson", ],
21	      "DiffIntrArray" => [ 1, "ia_opinions", "Opinion", ],
22	      "DiffArray" => [ 0, "a_opinions", "Opinion", ],
23	      "DiffIntrSet" => [ 1, "is_opinions", "Opinion", ],
24	      "DiffSet" => [ 0, "s_opinions", "Opinion", ],
25	     )};
26while (my ($test_name, $data) = each %$tests) {
27    my ($intrusive, $children, $class) = @{ $data };
28    #diag("Running test $test_name");
29    test_prefetch($test_name, $intrusive, $children, $class);
30}
31
32sub test_prefetch {
33    my ($test_name, $intrusive, $children, $class) = (@_);
34
35    stdpop($children);
36
37    for my $do_prefetch (0..1) {
38
39	# Check that the test is valid:
40	{
41	    my $storage = Springfield::connect;
42
43	    #local($Tangram::TRACE) = \*STDOUT;
44	    my $Homer = $storage->load( $id{Homer} );
45
46	    my ($r_parent, $r_child) = $storage->remote( "NaturalPerson",
47							 $class );
48
49	    my $filter = ($r_parent == $Homer);
50	    my $filter2 = ($filter &
51			   $r_parent->{$children}->includes($r_child)
52			  );
53
54	    my @parents  = $storage->select( $r_parent, $filter2 );
55	    my @children = $storage->select( $r_child,  $filter2 );
56
57	    my @k = ($children =~ m/children/ ? @kids : @opinions);
58	    @children = sort {
59		my $ix_a;
60		my $ix_b;
61		my $count = 0;
62		for (@k) {
63		    $ix_a = $count
64			if ( (exists $a->{firstName} &&
65			      $a->{firstName} eq $_) ||
66			     (exists $a->{statement} &&
67			      $a->{statement} eq $_) );
68		    $ix_b = $count
69			if ( (exists $b->{firstName} &&
70			      $b->{firstName} eq $_) ||
71			     (exists $b->{statement} &&
72			      $b->{statement} eq $_) );
73		    $count++;
74		}
75		$ix_a <=> $ix_b;
76	    } @children if ($children =~ /children|a_/);
77	    ok(@children, "$test_name - Got some children back");
78
79	    {
80		#local($Tangram::TRACE);
81		#if ($test_name =~ /IntrArray/) {
82		    #$Tangram::TRACE = \*STDERR;
83		#}
84		$storage->prefetch( $r_parent,
85				    $children,
86				    $filter ) if $do_prefetch;
87	    }
88
89	    $storage->{db}->disconnect(); # hyuk yuk yuk
90
91	    local($SIG{__WARN__}) = sub { };
92	    my @new_children;
93	    my $sort = sub {
94		(exists $a->{firstName} ?
95		 ( $a->{firstName} cmp $b->{firstName} )
96		 : ( $a->{statement} cmp $b->{statement} ) );
97	    };
98	    eval {
99		if ($children =~ m/s_/) {
100		    @new_children = sort { $sort->() }
101			$Homer->{$children}->members;
102		    @children = sort { $sort->() } @children;
103
104		} elsif ($children =~ m/children|a_/) {
105		    @new_children = @{ $Homer->{$children} };
106		} else {
107		    @new_children = sort { $sort->() }
108					 values %{ $Homer->{$children} };
109		    @children = sort { $sort->() } @children;
110		}
111	    };
112
113	    if ($do_prefetch) {
114
115		is($@, "", "$test_name - Didn't raise an exception w/prefetch");
116		#local ($,)=" ";
117		#print map { ref $_ ? $_->{firstName} : $_ }
118		    #"Sent:", @children,
119		    #"\nGot: ", @new_children, "\n";
120		is_deeply(\@new_children, \@children, "$test_name - got back what we put in");
121	    } else {
122		isnt($@, "",
123		     "$test_name - Raises an exception w/o prefetch");
124		isnt(@new_children, @children,
125		     "$test_name - didn't get back what we put in");
126	    }
127
128	    $storage->disconnect();
129	}
130	is(leaked, 0, "Leaktest");
131    }
132}
133
134$a = $b = "globals";
135