1: # Before `make install' is performed this script should be runnable with
2: # `make test'. After `make install' it should work as `perl test.pl'
3: use strict;
4: use warnings;
5: use Test;
6: my $loaded;
7: BEGIN {
8: $| = 1; $^W = 1; $loaded = 0;
9: ######################################################################
10: plan tests =>13, todo => [10,12], onfail => sub { warn "not ok!\n"; };
11: # test 12: Grove driver sgml identity test
12: # SGML Grove doesn't have comments or attribute defaulting
13: # test 10: SGMLS driver xml identity test
14: # this test favors the Grove's (less complete) output
15: ######################################################################
16:
18: }
19: END {ok(0) unless $loaded; 1;}
20: use SGML::ElementMap;
21: use Hash::Layered;
23: ### test: modules load
24: $loaded = 1;
25: ok(1); # test 1
27: ######################### End of black magic.
29: # pre-test verify
30: if (diff('Makefile.PL','Makefile.PL')) {
31: die "Unknown problem with test.pl diff call. Tests aborted.\n";
32: }
34: # some constants
35: my @driver_list = (
36: 'SGML::ElementMap::Driver::Grove',
37: 'SGML::ElementMap::Driver::SGMLS',
38: 'SGML::ElementMap::Driver::XMLParser',
39: #'SGML::ElementMap::Driver::SAXParser',
40: );
42: my ($do_core_test,$do_null_test,$do_identity_test,$do_calc_test) = (1,1,1,1);
45: ######################################################################
46: ## Test Basic Mechanisms
48: if ($do_core_test) {
49: ok(test_split_envspec()); # test 2
50: }
53: if ($do_null_test) {
54: my $testf = './examples/identity/test-x1.xml';
55: #my $testf = './test-xml-bom.xml';
56: #my $testf = '/home/xethair/SGML/cvsdev/xmlschema/triv.xsd';
57: foreach my $driver ('default',@driver_list) {
58: warn "# NEXT null:$driver:$testf\n";
59: my $r = eval {
60: my $obj = new SGML::ElementMap;
61: $obj->element('','process');
62: $obj->sdata('','suppress');
63: $obj->cdata('','suppress');
64: $obj->pi('','suppress');
65: $obj->comment('','suppress');
66: if ($driver ne 'default') {
67: $obj->driver($driver);
68: }
69: $obj->process_xml_file($testf);
70: };
71: warn $@ if (!defined $r);
72: ok(defined $r); #test 3,4,5
73: }
74: }
76: ######################################################################
77: ## Calculator Tests
79: if ($do_calc_test) {
80: harness('./examples/calculator',
81: 'SGML::ElementMap::Example::Calculator','calc.pm','calc',1);
82: #harness('./examples/calculator', # chokes from case sensitivity
83: # 'SGML::ElementMap::Example::Calculator','calc.pm','calc',0);
84: }
86: ######################################################################
87: ## Identity Tests
89: if ($do_identity_test) {
90: harness('./examples/identity', 'SGML::ElementMap::Example::Identity',
91: 'identity.pm', 'xml', 0);
92: harness('./examples/identity', 'SGML::ElementMap::Example::Identity',
93: 'identity.pm', 'sgml', 1);
94: }
97: exit 0;
100: sub diff {
101: my ($af,$bf) = @_;
102: my ($a,$b,$found);
103: open AF,"<".$af;
104: open BF,"<".$bf;
105: $found = 0;
106: while (!$found) {
107: last if eof(AF) || eof(BF);
108: $a = <AF>; $b = <BF>;
109: chomp $a; chomp $b; # because system line endings might differ (?)
110: $found = 1 if ($a ne $b);
111: }
112: $found = $found || !(eof(AF) && eof(BF));
113: close AF;
114: close BF;
115: return $found;
117: }
119: # test harness for modules
120: # module must have ::Initialize and should look at ::is_sgml
121: sub harness {
122: my ($path,$module,$mod_file,$ext,$is_sgml) = @_;
123:
124: open REAL_OUT,">&STDOUT";
125: open REAL_ERR,">&STDERR";
126:
127: my $val = eval {
128: require $path."/".$mod_file;
129:
130: opendir TD,$path;
131: foreach my $testf (readdir TD) {
132: next unless ($testf =~ /^(test-.*)\.$ext$/i);
133: my $source = $path.'/'.$testf;
134: my $target = $path.'/'.$1.'.out';
135: my $resultbase = $path.'/'.$1.'.test-out';
136: my $match = 0;
137: my $mark_type = ($is_sgml ? 'SGML' : 'XML');
138: # make samples if they aren't there?
139: my $pass = 0;
140: foreach my $driver (@driver_list) {
141: $pass += 1;
142: warn join ('',"# NEXT ",$testf," ",
143: ($module =~ m/::([^:]+)$/)[0],
144: ' ',$pass,": using ",
145: ($driver =~ m/::([^:]+)$/)[0],
146: "\n");
147: my $result = $resultbase.'-'.$pass;
148: open STDERR,">".$result;
149: open STDOUT,">&STDERR";
150: my $r = eval {
151: my $engine = new SGML::ElementMap;
152: my $driver_obj;
153: $driver_obj = eval qq{ # begin DOUBLE-QUOTE EVAL
154: use $driver ();
155: \$driver_obj = new $driver();
156: if (defined \$driver_obj) {
157: if (defined(\$driver_obj->markup('$mark_type'))) {
158: \$driver_obj;
159: } else {
160: 0;
161: }
162: } else {
163: undef;
164: };
165: }; # end DOUBLE-QUOTE EVAL
166: #$driver_obj->
167: if (! defined $driver_obj) {
168: die "failed to instantiate ".$driver;
169: return 0;
170: } elsif (! $driver_obj) {
171: warn $driver." refuses markup type ".$mark_type."\n";
172: return -1;
173: }
174: my $init_ref = eval "\$".$module."::is_sgml=".$is_sgml.';'.
175: ' \&'.$module.'::Initialize;';
176: die "no init ref" unless ref $init_ref;
177: &$init_ref($engine);
178: $engine->driver($driver_obj);
179: if ($is_sgml) {
180: $engine->process_sgml_file($source);
181: } else {
182: $engine->process_xml_file($source);
183: }
184: };
185: warn $@ if (!defined $r);
186: open STDOUT,">&REAL_OUT";
187: open STDERR,">&REAL_ERR";
188: warn $@ if (!defined $r);
190: # cases
191: # $r negative: markup not supported
192: # $r not defined: failure by exception
193: # $r false: reported failure
194: # $r positive: successful exit
195:
196: if (!$r) {
197: # failure
198: $match = 0;
199: } elsif ($r < 0) {
200: # no support
201: $match = -1;
202: } else {
203: # successful exit
204: $match = ((!-f $result) || diff($target, $result)) ? 0 : 1;
205: }
206: unlink $result unless ! $match;
207: if ($match < 0) {
208: warn "#skip\n";
209: next; # if $match < 0;
210: }
211: ok($match);
212: if (0) {
213: $match = (defined($r) && $r) || '';
214: if ($match && $r > 0) {
215: $match = -f $result;
216: if ($match) {
217: if (diff($target,$result)) {
218: $match = 0;
219: } else {
220: unlink $result;
221: }
222: }
223: }
224: ok($match) unless defined ($match) && $match < 0; # test #?
225: }
226: }
227: }
228: closedir TD;
229: 1;
230: };
231: warn $@ unless defined $val;
233: open STDOUT,">&REAL_OUT";
234: open STDERR,">&REAL_ERR";
235: close REAL_OUT;
236: close REAL_ERR;
238: return $val;
239: }
241: ######################################################################
242: # Test Runners
244: sub test_split_envspec {
245: my ($failed,$spec,$k,$p,$rl,$v,$r,$ti);
246: my @test_envs = ('/A','/B/A',
247: '/C/A', '/C/B/A','/C/A/D','/C/B/D/A','/B/D/A');
248: my %test_specs =
249: ('' => [1,1,1,1,1,1,1],
250: 'A' => [1,1,1,1,0,1,1], # same as //A
251: '/A' => [1,0,0,0,0,0,0],
252: '/B/A' => [0,1,0,0,0,0,0],
253: 'B/A' => [0,1,0,1,0,0,0],
254: '/B//A' => [0,1,0,0,0,0,1],
255: 'B//A' => [0,1,0,1,0,1,1],
256: '//A' => [1,1,1,1,0,1,1],
257: 'A//' => [0,0,0,0,1,0,0],
258: '/B/' => [0,1,0,0,0,0,0],
259: '/C//' => [0,0,1,1,1,1,0],
260: );
261: $failed = 0;
262: foreach $spec (keys %test_specs) {
263: ($k,$p) = SGML::ElementMap::split_envspec($spec);
264: $rl = $test_specs{$spec};
265: for ($ti=0; $ti<@test_envs; $ti+=1) {
266: $r = $rl->[$ti];
267: $v = ( ($p eq '') || ($test_envs[$ti] =~ m/^$p$/) );
268: if ( ($v && !$r) || ($r && !$v) ) {
269: $failed = 1;
270: warn "# fail: " . ($r? 'expected' : 'unexpected') . ' match ' .
271: ($v? 'succeeded' : 'failed') .
272: ': SPEC[' . $spec . '] ENV['. $test_envs[$ti] .
273: "] PAT{".$p."}\n";
274: }
275: }
277: }
278: return $failed ? 0 : 1;
279: }
283: 1;