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