1 /*
2 * $Id: testb.i,v 1.2 2009-09-11 02:20:03 dhmunro Exp $
3 * A comprehensive test of the native-Yorick binary I/O functions.
4 *
5 * Also, read back PDB files created by Stewart Brown's pdtest program,
6 * and create facsimile of such files (although doesn't write PDB-style
7 * pointers).
8 */
9 /* Copyright (c) 2005, The Regents of the University of California.
10 * All rights reserved.
11 * This file is part of yorick (http://yorick.sourceforge.net).
12 * Read the accompanying LICENSE file for details.
13 */
14
testb(do_stats)15 func testb(do_stats)
16 /* DOCUMENT testb
17 or testb, 1 (prints yorick_stats)
18 Perform systematic test of all features of Yorick's binary I/O
19 package. This extends the simple test in testp.i.
20 */
21 {
22 local varCs, varCa, varSs, varSa, varIs, varIa, varLs, varLa;
23 local varFs, varFa, varDs, varDa, varZs, varZa, varSIs, varSIa;
24 local bundle;
25 local varQs, varPs, varQa, varPa, linkedList, mixed;
26
27 /* begin by writing a simple flat file */
28 write, " First test is to write flat files:";
29 tester1, "junk", write_flat, read_flat;
30
31 /* continue by writing a file with lots of indirections */
32 write, "\n Second test is to write files with pointers:";
33 tester1, "junk", write_ptrs, read_ptrs;
34
35 /* update the indirect files and write the flat stuff */
36 write, "\n Third test is to update pointered files with flat data:";
37 tester2, "junk", write_flat, read_flat, read_ptrs;
38
39 /* exhaustive test to and from all other primitive formats */
40 write, "\n Fourth test is exhaustive check of other primitive formats:";
41 now= split= array(0.0, 3);
42 timer, now;
43 tester3;
44 timer, now, split;
45 timer_print, "Time to write/test all formats", split;
46
47 /* Contents Log tests */
48 write, "\n Fifth test is check of Contents Log machinery:";
49 tester4;
50
51 /* History tests */
52 write, "\n Sixth test is flat history files (be patient):";
53 timer, now;
54 tester5;
55 timer, now, split;
56 timer_print, "Time to write history files", split;
57
58 write, "\n Seventh test is a pointered history file:";
59 tester6;
60
61 rm_hist;
62 remove, "junk.clog";
63 remove, "junk.pdb"; remove, "junk.pdbL";
64 remove, "junkd.pdb"; remove, "junkd.pdbL";
65 remove, "junkc.pdb"; remove, "junkc.pdbL";
66 remove, "junks.pdb"; remove, "junks.pdbL";
67
68 write, "\n Eighth test is vsave in-memory files:";
69 f = createb(char);
70 write_flat, f, 0;
71 b = vclose(f);
72 read_flat, openb(b), 0;
73 read_flat, openb(b), 1;
74
75 f = createb(char);
76 write_flat, f, 1;
77 b = vclose(f);
78 read_flat, openb(b), 0;
79 read_flat, openb(b), 1;
80
81 f = createb(char);
82 write_ptrs, f, 0;
83 b = vclose(f);
84 read_ptrs, openb(b), 0;
85 read_ptrs, openb(b), 1;
86
87 f = createb(char);
88 write_ptrs, f, 1;
89 b = vclose(f);
90 read_ptrs, openb(b), 0;
91 read_ptrs, openb(b), 1;
92
93 write, "\n Ninth test is vpack in-memory files:";
94 b = vpack_flat(0);
95 bb = vpack_flat(1);
96 if (numberof(b)!=numberof(bb) || anyof(b!=bb))
97 write, "vpack_flat failed write order test";
98 vunpack_flat, b, 0;
99 vunpack_flat, b, 1;
100 }
101
102 func rm_hist
103 {
104 for (i=0 ; i<22 ; i++) remove, swrite(format="junk%02ld.pdb", i);
105 for (i=0 ; i<22 ; i++) remove, swrite(format="junk%02ld.pdbL", i);
106 }
107
tester1(base,writer,reader)108 func tester1(base, writer, reader)
109 {
110 if (do_stats) "Begin1 "+print(yorick_stats())(1);
111 write, "Write using native formats"
112 f= createb(base+".pdb");
113 if (do_stats) "Created "+print(yorick_stats())(1);
114
115 writer, f, 0;
116
117 close, f;
118 if (do_stats) "Closed "+print(yorick_stats())(1);
119
120 f= openb(base+".pdb");
121 if (do_stats) "Opened "+print(yorick_stats())(1);
122
123 reader, f, 0;
124
125 write, "Write using DEC primitive formats"
126 g= createb(base+"d.pdb", dec_primitives);
127 if (do_stats) "Created "+print(yorick_stats())(1);
128
129 writer, g, 1;
130 reader, g, 0;
131
132 write, "Write using Sun primitive formats"
133 h= createb(base+"s.pdb", sun_primitives);
134 if (do_stats) "Created "+print(yorick_stats())(1);
135
136 writer, h, 0;
137 reader, h, 1;
138 close, h;
139 if (do_stats) "Closed S "+print(yorick_stats())(1);
140
141 write, "Write using Cray primitive formats"
142 h= createb(base+"c.pdb", cray_primitives);
143 if (do_stats) "Created "+print(yorick_stats())(1);
144
145 writer, h, 1;
146 reader, h, 1;
147
148 close, h;
149 if (do_stats) "Closed C "+print(yorick_stats())(1);
150 close, g;
151 if (do_stats) "Closed D "+print(yorick_stats())(1);
152 close, f;
153 if (do_stats) "Closed N "+print(yorick_stats())(1);
154 }
155
tester2(base,writer,reader,reader2)156 func tester2(base, writer, reader, reader2)
157 {
158 if (do_stats) "Begin2 "+print(yorick_stats())(1);
159 write, "Update using native formats"
160 f= updateb(base+".pdb");
161 if (do_stats) "Updating "+print(yorick_stats())(1);
162
163 writer, f, 1;
164
165 close, f;
166 if (do_stats) "Closed "+print(yorick_stats())(1);
167
168 f= updateb(base+".pdb");
169 if (do_stats) "Opened "+print(yorick_stats())(1);
170
171 reader, f, 1;
172 reader2, f, 1;
173
174 write, "Update using DEC primitive formats"
175 g= updateb(base+"d.pdb", dec_primitives);
176 if (do_stats) "Updating "+print(yorick_stats())(1);
177
178 writer, g, 0;
179 reader, g, 1;
180 reader2, g, 1;
181
182 write, "Update using Sun primitive formats"
183 h= updateb(base+"s.pdb", sun_primitives);
184 if (do_stats) "Created "+print(yorick_stats())(1);
185
186 writer, h, 1;
187 reader, h, 0;
188 reader2, h, 0;
189 close, h;
190 if (do_stats) "Closed S "+print(yorick_stats())(1);
191
192 write, "Update using Cray primitive formats"
193 h= updateb(base+"c.pdb", cray_primitives);
194 if (do_stats) "Created "+print(yorick_stats())(1);
195
196 writer, h, 0;
197 reader, h, 0;
198 reader2, h, 0;
199
200 close, h;
201 if (do_stats) "Closed C "+print(yorick_stats())(1);
202 close, g;
203 if (do_stats) "Closed D "+print(yorick_stats())(1);
204 close, f;
205 if (do_stats) "Closed N "+print(yorick_stats())(1);
206 }
207
208 func tester3
209 {
210 write, "Testing Sun format";
211 test_full, "junk", sun_primitives;
212
213 write, "Testing i86 format";
214 test_full, "junk", i86_primitives;
215
216 write, "Testing alpha format";
217 test_full, "junk", alpha_primitives;
218
219 write, "Testing sgi64 format";
220 test_full, "junk", sgi64_primitives;
221
222 write, "Testing DEC format";
223 test_full, "junk", dec_primitives;
224
225 write, "Testing Cray format";
226 test_full, "junk", cray_primitives;
227
228 write, "Testing XDR format";
229 test_full, "junk", xdr_primitives;
230
231 write, "Testing Mac format";
232 test_full, "junk", mac_primitives;
233
234 write, "Testing Mac long-double format";
235 test_full, "junk", macl_primitives;
236
237 write, "Testing IBM PC format";
238 test_full, "junk", pc_primitives;
239
240 write, "Testing VAX format";
241 test_full, "junk", vax_primitives;
242
243 write, "Testing VAX G-double format";
244 test_full, "junk", vaxg_primitives;
245
246 write, "Testing Sun-3/Sun-2 format";
247 test_full, "junk", sun3_primitives;
248
249 write, "Testing native format";
250 test_full, "junk";
251 }
252
test_full(base,primitives)253 func test_full(base, primitives)
254 {
255 write_ptrs, createb(base+".pdb", primitives), 0;
256 write_flat, updateb(base+".pdb"), 0;
257 read_flat, openb(base+".pdb"), 0;
258 read_ptrs, openb(base+".pdb"), 0;
259 }
260
261 func tester4
262 {
263 write, "Contents Log -- testing Sun format";
264 test_clog, "junk", sun_primitives;
265
266 write, "Contents Log -- testing DEC format";
267 test_clog, "junk", dec_primitives;
268
269 write, "Contents Log -- testing Cray format";
270 test_clog, "junk", cray_primitives;
271
272 write, "Contents Log -- testing VAX format";
273 test_clog, "junk", vax_primitives;
274
275 write, "Contents Log -- testing native format";
276 test_clog, "junk";
277
278 write, "Non-PDB Contents Log -- testing Sun format";
279 test_clog, "junk", sun_primitives, 1;
280
281 write, "Non-PDB Contents Log -- testing DEC format";
282 test_clog, "junk", dec_primitives, 1;
283
284 write, "Non-PDB Contents Log -- testing Cray format";
285 test_clog, "junk", cray_primitives, 1;
286
287 write, "Non-PDB Contents Log -- testing VAX format";
288 test_clog, "junk", vax_primitives, 1;
289
290 write, "Non-PDB Contents Log -- testing native format";
291 test_clog, "junk",, 1;
292 }
293
test_clog(base,primitives,nonpdb)294 func test_clog(base, primitives, nonpdb)
295 {
296 if (!nonpdb) {
297 f= createb(base+".pdb", primitives);
298 } else {
299 f= open(base+".pdb", "w+b");
300 if (is_func(primitives)) primitives, f;
301 _init_clog, f;
302 }
303 write_ptrs, f, 0;
304 write_flat, f, 0;
305 if (!nonpdb) dump_clog, f, base+".clog";
306 close, f;
307 if (!nonpdb) f= openb(base+".pdb", base+".clog");
308 else f= openb(base+".pdb");
309 read_flat, f, 0;
310 read_ptrs, f, 0;
311 }
312
313 func tester5
314 {
315 write, "History -- testing Sun format";
316 test_hist, "junk00", sun_primitives;
317 rm_hist;
318
319 write, "History -- testing DEC format";
320 test_hist, "junk00", dec_primitives;
321 rm_hist;
322
323 write, "History -- testing Cray format";
324 test_hist, "junk00", cray_primitives;
325 rm_hist;
326
327 write, "History -- testing VAX format";
328 test_hist, "junk00", vax_primitives;
329 rm_hist;
330
331 write, "History -- testing native format";
332 test_hist, "junk00";
333 rm_hist;
334 }
335
test_hist(base,primitives)336 func test_hist(base, primitives)
337 {
338 /* No non-record variables in 1st test. */
339 f= createb(base+".pdb", primitives);
340 write_hist, f;
341 close, f;
342
343 f= openb(base+".pdb");
344 read_hist, f;
345 close, f;
346 }
347
348 test_records= 100;
349 test_filesize= 8000; /* each record is about 1 kbyte long */
350
write_hist(f)351 func write_hist(f)
352 {
353 for (i=1 ; i<=test_records ; i++) {
354 time= double(i-1); ncyc= i;
355 add_record, f, time, ncyc;
356 if (i==1) set_filesize, f, test_filesize;
357 save, f, time, ncyc;
358 write_flat, f, 0;
359 }
360 }
361
read_hist(f)362 func read_hist(f)
363 {
364 n= test_records/3;
365 prime= 27;
366 if (n%prime == 0) {
367 prime= 13;
368 if (n%prime == 0) prime= 0;
369 }
370 for (i=1 ; i<=test_records/3 ; i++) {
371 if (prime) j= (i%prime) + 1;
372 else j= i;
373 jt, double(j-1);
374 if (f.time!=double(j-1) || f.ncyc!=j)
375 "time or ncyc bad at record "+print(j)(1);
376 read_flat, f, 0;
377 }
378 for (i=test_records/3+1 ; i<=2*(test_records/3) ; i++) {
379 jc, f, i;
380 if (f.time!=double(i-1) || f.ncyc!=i)
381 "time or ncyc bad at record "+print(i)(1);
382 read_flat, f, 0;
383 }
384 i= 2*(test_records/3);
385 do {
386 restore, f, time, ncyc;
387 if (f.time!=double(i-1) || f.ncyc!=i)
388 "time or ncyc bad at record "+print(i)(1);
389 read_flat, f, 0;
390 i++;
391 } while (jt(f));
392 if (ncyc<test_records) "jt found only "+print(ncyc)(1)+
393 " out of "+print(test_records)(1)+" records";
394 }
395
396 func tester6
397 {
398 for_hist_test= 1;
399
400 f= createb("junk00.pdb");
401 write_flat, f, 1;
402 for (i=1 ; i<=23 ; i++) {
403 time= double(i-1); ncyc= i;
404 if (i==1) {
405 /* records with pointers must be built before writing them */
406 add_record, f;
407 add_variable, f, -1, "varQs", string;
408 add_variable, f, -1, "varQa", string, 2, 4;
409 add_variable, f, -1, "varPs", pointer;
410 add_variable, f, -1, "varPa", pointer, 2, 3, 2;
411 add_variable, f, -1, "linkedList", pointer;
412 add_variable, f, -1, "mixed", Mixed;
413 save, f, Link;
414 }
415 add_record, f, time, ncyc;
416 if (i==1) set_filesize, f, test_filesize;
417 save, f, time, ncyc;
418 write_ptrs, f, 0;
419 }
420 close, f;
421
422 f= openb("junk00.pdb");
423 for (i=1 ; i<=23 ; i++) {
424 j= (17*i)%23 + 1;
425 jt, double(j-1);
426 if (f.time!=double(j-1) || f.ncyc!=j)
427 "time or ncyc bad at record "+print(j)(1);
428 read_ptrs, f, 1;
429 read_flat, f, 1;
430 }
431 close, f;
432
433 rm_hist;
434 }
435
write_flat(f,how)436 func write_flat(f, how)
437 {
438 extern varCs, varCa, varSs, varSa, varIs, varIa, varLs, varLa;
439 extern varFs, varFa, varDs, varDa, varZs, varZa, varSIs, varSIa;
440 extern bundle;
441
442 /* invent a bunch of garbage to be written */
443 varCs= 'A'; varSs= -37s; varIs= 76n; varLs= 144;
444 varCa= ['Z', '\370', 'a'];
445 varSa= short([[0,0,0],[0,-100,100]]);
446 varIa= int([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
447 [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]]);
448 varLa= [123456789, -987654321];
449 varFs= 1.5f; varDs= -6.022e23; varZs= 1-1i;
450 varFa= float([[0,0,0],[0,-100,100]]);
451 varDa= double([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
452 [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]]);
453 varZa= [123456789-3.5i, -987654321+0i];
454
455 varSIs= Simple(one='Q', two= -137., three= -37s);
456 varSIa= [varSIs, Simple(one='\370', two= 1.5, three= 37s)];
457
458 bundle= Flat(varCs=varCs, varSs=varSs, varIs=varIs, varLs=varLs,
459 varCa=varCa, varSa=varSa, varIa=varIa, varLa=varLa,
460 varFs=varFs, varDs=varDs, varZs=varZs, varSIs=varSIs,
461 varFa=varFa, varDa=varDa, varZa=varZa, varSIa=varSIa);
462
463 if (!how) {
464 save, f, varCs, varSs, varIs, varLs, varCa, varSa, varIa, varLa;
465 save, f, varFs, varDs, varZs, varSIs, varFa, varDa, varZa, varSIa;
466 save, f, bundle;
467 } else {
468 add_variable, f, -1, "varCs", char;
469 add_variable, f, -1, "varSs", "short";
470 add_variable, f, -1, "varIs", int;
471 add_variable, f, -1, "varLs", "long";
472 add_variable, f, -1, "varCa", "char", 3;
473 add_variable, f, -1, "varSa", short, 3, 2;
474 add_variable, f, -1, "varIa", "int", 4, [2,3,2];
475 add_variable, f, -1, "varLa", long, [1,2];
476
477 save, f, varFs, varDs;
478
479 add_variable, f, -1, "varZs", complex;
480 f.varZs.re= varZs.re;
481 f.varZs.im= varZs.im;
482
483 add_variable, f, -1, "varFa", "float", [1,3], [1,2];
484 add_variable, f, -1, "varDa", double, [2,4,3], 2;
485 add_variable, f, -1, "varZa", "complex", 2;
486
487 add_member, f, "Simple", -1, "one", char;
488 add_member, f, "Simple", -1, "two", "double";
489 add_member, f, "Simple", -1, "three", short;
490 install_struct, f, "Simple";
491
492 add_variable, f, -1, "varSIs", Simple;
493 add_variable, f, -1, "varSIa", "Simple", 2;
494 add_variable, f, -1, "bundle", Flat;
495
496 f.varCs= varCs;
497 save, f, varCa, varSs, varIs, varLs;
498 f.varSa= varSa;
499 f.varIa(::-1,,1)= varIa(::-1,,1);
500 f.varIa(,::-1,2)= varIa(,::-1,2);
501 f.varLa= varLa;
502 f.varFa([3,1,5,2,4,6])= varFa([3,1,5,2,4,6]);
503 f.varDa(,[3,1,5,2,4,6])= varDa(,[3,1,5,2,4,6]);
504 f.varZa(1).re= varZa.re(1);
505 f.varZa(1).im= varZa.im(1);
506 f.varZa.re(2)= varZa(2).re;
507 f.varZa.im(2)= varZa(2).im;
508 f.varSIs.one= varSIs.one;
509 f.varSIs.two= varSIs.two;
510 f.varSIs.three= varSIs.three;
511 f.varSIa.one= varSIa.one;
512 f.varSIa.two= varSIa.two;
513 f.varSIa(1).three= varSIa.three(1);
514 f.varSIa.three(2)= varSIa(2).three;
515 save, f, bundle;
516 }
517
518 if (do_stats) "Saved "+print(yorick_stats())(1);
519 }
520
read_flat(f,how)521 func read_flat(f, how)
522 {
523 local varCs, varCa, varSs, varSa, varIs, varIa, varLs, varLa;
524 local varFs, varFa, varDs, varDa, varZs, varZa, varSIs, varSIa;
525 local bundle;
526
527 if (!how) {
528 restore, f;
529 } else {
530 restore, f, varFs, varCa, varDs, varSa;
531 varCs= f.varCs;
532 varFa= array(float, 3, 2);
533 varFa([4,6,2,5,3,1])= f.varFa([4,6,2,5,3,1]);
534 varSs= f.varSs;
535 varDa= array(double, 4,3,2);
536 varDa(4,1:3,::-1)= f.varDa(4,,::-1);
537 varDa(3:1:-1,..)= f.varDa(3:1:-1,..);
538 restore, f, varIs, varLs, varIa, varLa;
539 varZa= array(0i, 2);
540 varZa.re= f.varZa.re;
541 varZa.im= f.varZa.im;
542 varZs= f.varZs;
543 restore, f, bundle;
544 bundle.varDa= 0.0;
545 bundle.varZa= 0.0;
546 bundle.varDa(4,1:3,::-1)= f.varDa(4,,::-1);
547 bundle.varDa(3:1:-1,..)= f.varDa(3:1:-1,..);
548 bundle.varZa(1).re= f.bundle.varZa.re(1);
549 bundle.varZa(1).im= f.bundle.varZa.im(1);
550 bundle.varZa.re(2)= f.bundle.varZa(2).re;
551 bundle.varZa.im(2)= f.bundle.varZa(2).im;
552 varSIs= f.varSIs;
553 varSIa= array(Simple, 2);
554 varSIa(1).one= f.varSIa.one(1);
555 varSIa.one(2)= f.varSIa(2).one;
556 varSIa.two= f.varSIa.two;
557 varSIa.three= f.varSIa.three;
558 }
559 if (do_stats) "Restored "+print(yorick_stats())(1);
560
561 goofs= [varCs!='A', varSs!=-37s, varIs!=76n, varLs!=144,
562 anyof(varCa!=['Z', '\370', 'a']),
563 anyof(varSa!=short([[0,0,0],[0,-100,100]])),
564 anyof(varIa!=int([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
565 [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]])),
566 anyof(varLa!=[123456789, -987654321]),
567 varFs!=1.5f, abs(varDs+6.022e23)>6.022e11, varZs!=1-1i,
568 anyof(varFa!=float([[0,0,0],[0,-100,100]])),
569 anyof(varDa!=double([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
570 [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]])),
571 anyof(varZa!=[123456789-3.5i, -987654321+0i]),
572
573 struct_neq(varSIs, Simple(one='Q', two= -137., three= -37s)),
574 struct_neq(varSIa,
575 [varSIs, Simple(one='\370', two= 1.5, three= 37s)]),
576
577 struct_neq(bundle,
578 Flat(varCs=varCs, varSs=varSs, varIs=varIs, varLs=varLs,
579 varCa=varCa, varSa=varSa, varIa=varIa, varLa=varLa,
580 varFs=varFs, varDs=varDs, varZs=varZs,
581 varFa=varFa, varDa=varDa, varZa=varZa,
582 varSIs=varSIs, varSIa=varSIa))];
583 if (anyof(goofs)) {
584 "read_flat failed -- goof flags are:";
585 goofs;
586 }
587
588 if (do_stats) "Checked "+print(yorick_stats())(1);
589 }
590
vpack_flat(how)591 func vpack_flat(how)
592 {
593 extern varCs, varCa, varSs, varSa, varIs, varIa, varLs, varLa;
594 extern varFs, varFa, varDs, varDa, varZs, varZa, varQs, varQa;
595
596 /* invent a bunch of garbage to be written */
597 varCs= 'A'; varSs= -37s; varIs= 76n; varLs= 144;
598 varCa= ['Z', '\370', 'a'];
599 varSa= short([[0,0,0],[0,-100,100]]);
600 varIa= int([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
601 [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]]);
602 varLa= [123456789, -987654321];
603 varFs= 1.5f; varDs= -6.022e23; varZs= 1-1i;
604 varFa= float([[0,0,0],[0,-100,100]]);
605 varDa= double([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
606 [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]]);
607 varZa= [123456789-3.5i, -987654321+0i];
608 varQs= "";
609 varQa= [["hello", string(0), "World", "", "!"],
610 ["a", "b", string(0), "", "e"]];
611 null = [];
612
613 if (!how) {
614 b = vpack(varCs, varSs, varIs, varLs, varCa, varSa, varIa, varLa, varQs,
615 varFs, varDs, varZs, varFa, null, varQa, varDa, varZa);
616 } else {
617 f = vopen(,1);
618 vpack, f, varCs, varSs, varIs, varLs, varCa, varSa, varIa;
619 vpack, f, varLa;
620 vpack, f, varQs, varFs, varDs;
621 vpack, f, varZs, varFa, null, varQa, varDa, varZa;
622 b = vpack(f);
623 }
624
625 if (do_stats) "Packed "+print(yorick_stats())(1);
626 return b;
627 }
628
vunpack_flat(b,how)629 func vunpack_flat(b, how)
630 {
631 local varCs, varCa, varSs, varSa, varIs, varIa, varLs, varLa;
632 local varFs, varFa, varDs, varDa, varZs, varZa, varQs, varQa;
633
634 null = 1;
635 if (!how) {
636 neof =
637 !vunpack(b, varCs, varSs, varIs, varLs, varCa, varSa, varIa, varLa,
638 varQs, varFs, varDs, varZs, varFa, null, varQa, varDa, varZa);
639 neof += 2*(!vunpack(b));
640 vunpack, b; /* test reset feature */
641 neof += 4*vunpack(b);
642 } else {
643 eof1 = vunpack(b, v1, v2);
644 bad1 = (v1!='A' || v2!=-37s);
645 vunpack, b; /* test reset feature */
646 eof2 = vunpack(b, varCs, varSs, varIs, varLs, varCa);
647 varSa = vunpack(b, -);
648 eof3 = vunpack(b, varIa, varLa, varQs, varFs, varDs);
649 varZs = vunpack(b, -);
650 eof4 = !vunpack(b, varFa, null, varQa, varDa, varZa);
651 neof = eof1 + 2*eof2 + 4*eof3 + 8*eof4 + 16*bad1;
652 }
653 if (do_stats) "Restored "+print(yorick_stats())(1);
654
655 goofs= [varCs!='A', varSs!=-37s, varIs!=76n, varLs!=144,
656 anyof(varCa!=['Z', '\370', 'a']),
657 anyof(varSa!=short([[0,0,0],[0,-100,100]])),
658 anyof(varIa!=int([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
659 [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]])),
660 anyof(varLa!=[123456789, -987654321]),
661 varFs!=1.5f, abs(varDs+6.022e23)>6.022e11, varZs!=1-1i,
662 anyof(varFa!=float([[0,0,0],[0,-100,100]])),
663 anyof(varDa!=double([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
664 [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]])),
665 anyof(varZa!=[123456789-3.5i, -987654321+0i]),
666 varQs!="", anyof(varQa != [["hello", string(0), "World", "", "!"],
667 ["a", "b", string(0), "", "e"]]),
668 !is_void(null), neof];
669 if (anyof(goofs)) {
670 "vunpack_flat failed -- goof flags are:";
671 goofs;
672 }
673
674 if (do_stats) "Checked "+print(yorick_stats())(1);
675 }
676
write_ptrs(f,how)677 func write_ptrs(f, how)
678 {
679 extern varQs, varPs, varQa, varPa, linkedList, mixed;
680
681 extern varCs, varZa, varFa, varDa; /* referenced by ptrs */
682 varCs= 'A';
683 varFa= float([[0,0,0],[0,-100,100]]);
684 varDa= double([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
685 [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]]);
686 varZa= [123456789-3.5i, -987654321+0i];
687
688 /* invent a bunch of garbage to be written */
689 varQs= "Hello, world!";
690 varPs= pointer(varQs);
691 varQa= [["a", "bc"], ["def", "ghij"], ["klmn", "op"], [string(0), ""]];
692 varPa= [[[&varCs, &varDa], [&varZa, &varDa], [&varPs, &varDa]],
693 [[&varFa, &varDa], [&varDa, &varPs], [&varQa, &varQa]]];
694
695 linkedList= &Link(name="second", index=2);
696 linkedList->next= &Link(next=linkedList, name="third", index=3);
697 linkedList->next->next= &Link(name="last", index=4);
698 linkedList= &Link(next=linkedList, name="first", index=1);
699
700 mixed= Mixed(varPs=varPs, s=-37s, varQa=varQa, varQs=varQs,
701 links=linkedList, varPa=varPa);
702
703 if (!how) {
704 /* This should produce maximum number of duped pointers. */
705 if (!for_hist_test) save, f, complex, Link;
706 save, f, varQs, varQa, varPs, varPa, linkedList, mixed;
707 } else {
708 /* Piecemeal writes result in some pointee rewrites. */
709 add_variable, f, -1, "varQs", string;
710 add_variable, f, -1, "varQa", "string", 2, 4;
711 add_variable, f, -1, "varPs", "pointer";
712 add_variable, f, -1, "varPa", pointer, [3,2,3,2];
713 save, f, complex, varQs;
714 f.varQa(,::-1)= varQa(,::-1);
715 f.varPs= varPs;
716 f.varPa(2,1:3)= varPa(2,1:3);
717 f.varPa(1,4:6)= varPa(1,4:6);
718 add_member, f, "Link", -1, "next", pointer;
719 add_member, f, "Link", -1, "name", "string";
720 add_member, f, "Link", -1, "index", "long";
721 install_struct, f, "Link";
722 add_variable, f, -1, "linkedList", "pointer";
723 save, f, mixed;
724 f.linkedList= linkedList;
725 f.varPa(2,4:6)= varPa(2,4:6);
726 f.varPa(1,1:3)= varPa(1,1:3);
727 }
728
729 if (do_stats) "Saved ps "+print(yorick_stats())(1);
730 }
731
read_ptrs(f,how)732 func read_ptrs(f, how)
733 {
734 local varQs, varPs, varQa, varPa, linkedList, mixed;
735
736 extern varCs, varZa, varFa, varDa; /* referenced by ptrs */
737
738 if (!how) {
739 /* This should produce maximum number of duped pointers. */
740 restore, f, varQs, varPs, varQa, varPa, linkedList, mixed;
741 } else {
742 /* Piecemeal reads result in some pointee rereads. */
743 varQs= f.varQs;
744 varQa= array(string, 2, 4);
745 mixed= f.mixed;
746 varQa(,::-1)= f.varQa(,::-1);
747 varPa= array(pointer, 2, 3, 2);
748 varPa(1,::-1,2)= f.varPa(1,::-1,2);
749 linkedList= f.linkedList;
750 varPa(2,,2)= f.varPa(2,,2);
751 varPs= f.varPs;
752 varPa(..,1)= f.varPa(..,1);
753 mixed.varPa= &[];
754 mixed.varPa(::-1,..)= f.mixed.varPa(::-1,..)
755 }
756 if (do_stats) "Restored "+print(yorick_stats())(1);
757
758 goofs= [varQs!="Hello, world!",
759 anyof(varQa!=[["a", "bc"], ["def", "ghij"],
760 ["klmn", "op"], [string(0), ""]]),
761 string(varPs)!="Hello, world!",
762 *varPa(1,1,1)!=varCs, anyof(*varPa(2,1,1)!=varDa),
763 anyof(*varPa(1,2,1)!=varZa), anyof(*varPa(2,2,1)!=varDa),
764 string(*varPa(1,3,1))!="Hello, world!", anyof(*varPa(2,3,1)!=varDa),
765 anyof(*varPa(1,1,2)!=varFa), anyof(*varPa(2,1,2)!=varDa),
766 anyof(*varPa(1,2,2)!=varDa), string(*varPa(2,2,2))!="Hello, world!",
767 anyof(*varPa(1,3,2)!=varQa), anyof(*varPa(2,3,2)!=varQa)];
768 if (anyof(goofs)) {
769 "read_ptrs failed on simple string or pointer -- goof flags are:";
770 goofs;
771 }
772
773 ll1= linkedList;
774 ll3= linkedList->next->next;
775 goofs= [ll1->name!="first", ll1->index!=1,
776 ll1->next->name!="second", ll1->next->index!=2,
777 ll3->name!="third", ll3->index!=3,
778 ll3->next->name!="last", ll3->next->index!=4,
779 !is_void(*ll3->next->next)];
780 if (anyof(goofs)) {
781 "read_ptrs failed on linked list -- goof flags are:";
782 goofs;
783 }
784
785 ll1= mixed.links;
786 ll3= mixed.links->next->next;
787 goofs= [ll1->name!="first", ll1->index!=1,
788 ll1->next->name!="second", ll1->next->index!=2,
789 ll3->name!="third", ll3->index!=3,
790 ll3->next->name!="last", ll3->next->index!=4,
791 !is_void(*ll3->next->next),
792 string(mixed.varPs)!="Hello, world!", mixed.s!=-37s,
793 anyof(mixed.varQa!=[["a", "bc"], ["def", "ghij"],
794 ["klmn", "op"], [string(0), ""]]),
795 mixed.varQs!="Hello, world!",
796 anyof(*mixed.varPa(1,2,1)!=varZa),
797 anyof(*mixed.varPa(2,2,1)!=varDa),
798 string(*mixed.varPa(1,3,1))!="Hello, world!",
799 anyof(*mixed.varPa(2,3,1)!=varDa),
800 anyof(*mixed.varPa(1,1,2)!=varFa),
801 anyof(*mixed.varPa(2,1,2)!=varDa),
802 anyof(*mixed.varPa(1,2,2)!=varDa),
803 string(*mixed.varPa(2,2,2))!="Hello, world!",
804 anyof(*mixed.varPa(1,3,2)!=varQa),
805 anyof(*mixed.varPa(2,3,2)!=varQa)];
806 if (anyof(goofs)) {
807 "read_ptrs failed on mixed object -- goof flags are:";
808 goofs;
809 }
810
811 if (do_stats) "Checkedp "+print(yorick_stats())(1);
812 }
813
struct_neq(x,y)814 func struct_neq(x, y)
815 {
816 members= strtok(strtok(print(structof(x))(2:-1))(2,)," (;")(1,);
817 m= numberof(members);
818 for (i=1 ; i<=m ; i++) {
819 xm= get_member(x, members(i));
820 ym= get_member(y, members(i));
821 if (typeof(xm)=="struct_instance") {
822 if (struct_neq(xm, ym)) return 1;
823 } else {
824 if (anyof(xm!=ym)) return 1;
825 }
826 }
827 return 0;
828 }
829
830 struct Simple {
831 char one;
832 double two;
833 short three;
834 }
835
836 struct Flat {
837 int varIs, varIa(4,3,2);
838 double varDs;
839 char varCs;
840 float varFs, varFa(3,2);
841 complex varZs, varZa(2);
842 short varSs, varSa(3,2);
843 double varDa(4,3,2);
844 Simple varSIs, varSIa(2);
845 long varLs, varLa(2);
846 char varCa(3);
847 }
848
849 struct Link {
850 pointer next;
851 string name;
852 long index;
853 }
854
855 struct Mixed {
856 pointer varPs;
857 short s;
858 string varQa(2,4), varQs;
859 pointer links, varPa(2,3,2);
860 }
861
pdcheck1(prefix)862 func pdcheck1(prefix)
863 {
864 write, "Testing <- native...";
865 pdtest1_check, prefix+"-nat.db1";
866 write, "Testing <- cray...";
867 pdtest1_check, prefix+"-cray.db1";
868 write, "Testing <- dos...";
869 pdtest1_check, prefix+"-dos.db1";
870 write, "Testing <- mac...";
871 pdtest1_check, prefix+"-mac.db1";
872 write, "Testing <- mips...";
873 pdtest1_check, prefix+"-mips.db1";
874 write, "Testing <- sun3...";
875 pdtest1_check, prefix+"-sun3.db1";
876 write, "Testing <- sun4...";
877 pdtest1_check, prefix+"-sun4.db1";
878 write, "Testing <- vax...";
879 pdtest1_check, prefix+"-vax.db1";
880 }
881
882 func pdcheck2
883 {
884 write, "Testing sun_primitives db1 write...";
885 pdtest1_write,"junk.pdb", sun_primitives;
886 pdtest1_check,"junk.pdb";
887 write, "Testing dec_primitives db1 write...";
888 pdtest1_write,"junk.pdb", dec_primitives;
889 pdtest1_check,"junk.pdb";
890 write, "Testing cray_primitives db1 write...";
891 pdtest1_write,"junk.pdb", cray_primitives;
892 pdtest1_check,"junk.pdb";
893 write, "Testing mac_primitives db1 write...";
894 pdtest1_write,"junk.pdb", mac_primitives;
895 pdtest1_check,"junk.pdb";
896 write, "Testing macl_primitives db1 write...";
897 pdtest1_write,"junk.pdb", macl_primitives;
898 pdtest1_check,"junk.pdb";
899 write, "Testing pc_primitives db1 write...";
900 pdtest1_write,"junk.pdb", pc_primitives;
901 pdtest1_check,"junk.pdb";
902 write, "Testing sun3_primitives db1 write...";
903 pdtest1_write,"junk.pdb", sun3_primitives;
904 pdtest1_check,"junk.pdb";
905 write, "Testing vax_primitives db1 write...";
906 pdtest1_write,"junk.pdb", vax_primitives;
907 pdtest1_check,"junk.pdb";
908 write, "Testing vaxg_primitives db1 write...";
909 pdtest1_write,"junk.pdb", vaxg_primitives;
910 pdtest1_check,"junk.pdb";
911 write, "Testing xdr_primitives db1 write...";
912 pdtest1_write,"junk.pdb", xdr_primitives;
913 pdtest1_check,"junk.pdb";
914 write, "Testing sun_primitives db1 write w/PDB-style pointers...";
915 pdtest1_write,"junk.pdb", sun_primitives, 1;
916 pdtest1_check,"junk.pdb";
917 write, "Testing dec_primitives db1 write w/PDB-style pointers...";
918 pdtest1_write,"junk.pdb", dec_primitives, 1;
919 pdtest1_check,"junk.pdb";
920 write, "Testing cray_primitives db1 write w/PDB-style pointers...";
921 pdtest1_write,"junk.pdb", cray_primitives, 1;
922 pdtest1_check,"junk.pdb";
923 write, "Testing native db1 write...";
924 pdtest1_write,"junk.pdb";
925 pdtest1_check,"junk.pdb";
926 }
927
pdtest1_check(filename)928 func pdtest1_check(filename)
929 {
930 f= openb(filename);
931 vars= *get_vars(f)(1);
932 if (numberof(vars)!=15) write, "Should be 15 variables in "+filename;
933
934 local cs, ss, is, fs, ds, ca, sa, ia, fa2, da, cap, fa2_app, fs_app;
935 local view, graph;
936 restore, f;
937
938 if (typeof(cs)!="char" || dimsof(cs)(1)!=0 || cs!='Q' /* 0x51 */)
939 write, "variable cs bad in "+filename;
940 if (typeof(ss)!="short" || dimsof(ss)(1)!=0 || ss!=-514)
941 write, "variable ss bad in "+filename;
942 if (typeof(is)!="int" || dimsof(is)(1)!=0 || is!=10)
943 write, "variable is bad in "+filename;
944 if (typeof(fs)!="float" || dimsof(fs)(1)!=0 || float_neq(fs,3.14159))
945 write, "variable fs bad in "+filename;
946 if (typeof(ds)!="double" || dimsof(ds)(1)!=0 || double_neq(ds,exp(1)))
947 write, "variable ds bad in "+filename;
948
949 if (typeof(ca)!="char" || dimsof(ca)(1)!=1 || dimsof(ca)(2)!=10 ||
950 string(&ca)!="Hi there!")
951 write, "variable ca bad in "+filename;
952 if (typeof(sa)!="short" || dimsof(sa)(1)!=1 || dimsof(sa)(2)!=5 ||
953 anyof(sa!=[2,1,0,-1,-2]))
954 write, "variable sa bad in "+filename;
955 if (typeof(ia)!="int" || dimsof(ia)(1)!=1 || dimsof(ia)(2)!=5 ||
956 anyof(ia!=[-2,-1,0,1,2]))
957 write, "variable ia bad in "+filename;
958 if (typeof(fa2)!="float" || dimsof(fa2)(1)!=2 ||
959 anyof(dimsof(fa2)!=[2,3,4]) ||
960 anyof(float_neq(fa2, [[1,1,1],[2,4,8],[3,9,27],[4,16,64]])))
961 write, "variable fa2 bad in "+filename;
962 if (typeof(da)!="double" || dimsof(da)(1)!=1 || dimsof(da)(2)!=4 ||
963 anyof(double_neq(da, exp([1,2,3,4]))))
964 write, "variable da bad in "+filename;
965
966 if (typeof(cap)!="pointer" || dimsof(cap)(1)!=1 || dimsof(cap)(2)!=3 ||
967 typeof(*cap(1))!="char" || string(cap(1))!="lev1" ||
968 typeof(*cap(2))!="char" || string(cap(2))!="lev2" ||
969 typeof(*cap(3))!="char" || string(cap(3))!="tar fu blat")
970 write, "variable cap bad in "+filename;
971
972 if (typeof(fs_app)!="float" || dimsof(fs_app)(1)!=0 ||
973 float_neq(fs_app,-3.14159))
974 write, "variable fs_app bad in "+filename;
975 if (typeof(fa2_app)!="float" || dimsof(fa2_app)(1)!=2 ||
976 anyof(dimsof(fa2_app)!=[2,3,4]) ||
977 anyof(float_neq(fa2_app, [[1,2,3],[1,4,9],[1,8,27],[1,16,81]])))
978 write, "variable fa2_app bad in "+filename;
979
980 if (nameof(structof(view))!="l_frame" || dimsof(view)(1)!=0 ||
981 float_neq(view.x_min,0.1) || float_neq(view.x_max,1.0) ||
982 float_neq(view.y_min,-0.5) || float_neq(view.y_max,0.5))
983 write, "variable view bad in "+filename;
984
985 if (nameof(structof(graph))!="plot" || dimsof(graph)(1)!=0 ||
986 anyof(float_neq(graph.x_axis,[0,.1,.2,.3,.4,.5,.6,.7,.8,.9])) ||
987 anyof(float_neq(graph.y_axis,[.5,.4,.3,.2,.1,0,-.1,-.2,-.3,-.4])) ||
988 float_neq(graph.view.x_min,0.1) || float_neq(graph.view.x_max,1.0) ||
989 float_neq(graph.view.y_min,-0.5) || float_neq(graph.view.y_max,0.5) ||
990 graph.npts!=10 || string(graph.label)!="test graph")
991 write, "variable graph bad in "+filename;
992 }
993
float_neq(a,b)994 func float_neq(a, b)
995 {
996 return abs(a-b)/(abs(a)+abs(b)+1.e-99) > 1.e-6;
997 }
998
double_neq(a,b)999 func double_neq(a, b)
1000 {
1001 return abs(a-b)/(abs(a)+abs(b)+1.e-99) > 1.e-12;
1002 }
1003
1004 struct l_frame {
1005 float x_min, x_max, y_min, y_max;
1006 }
1007
1008 struct plot {
1009 float x_axis(10), y_axis(10);
1010 int npts;
1011 pointer label;
1012 l_frame view;
1013 }
1014
pdtest1_write(filename,primitives,pdbptrs)1015 func pdtest1_write(filename, primitives, pdbptrs)
1016 {
1017 cs= 'Q';
1018 ss= -514s;
1019 is= 10n;
1020 fs= 3.14159;
1021 ds= exp(1);
1022
1023 ca= *pointer("Hi there!");
1024 sa= [2s,1s,0s,-1s,-2s];
1025 ia= [-2n,-1n,0n,1n,2n];
1026 fa2= [[1.f,1.f,1.f],[2.f,4.f,8.f],[3.f,9.f,27.f],[4.f,16.f,64.f]];
1027 da= exp([1,2,3,4]);
1028
1029 cap= [pointer("lev1"), pointer("lev2"), pointer("tar fu blat")];
1030
1031 fs= 3.14159f;
1032
1033 view= l_frame(x_min=0.1,x_max=1.0,y_min=-0.5,y_max=0.5);
1034 graph= plot(x_axis=[0,.1,.2,.3,.4,.5,.6,.7,.8,.9],
1035 y_axis=[.5,.4,.3,.2,.1,0,-.1,-.2,-.3,-.4],
1036 npts=10, label=pointer("test graph"),
1037 view=view);
1038
1039 fa2_app= float([[1,2,3],[1,4,9],[1,8,27],[1,16,81]]);
1040 fs_app= -3.14159f;
1041
1042 if (!pdbptrs) {
1043 save, createb(filename, primitives),\
1044 cs,ss,is,fs,ds, ca,sa,ia,fa2,da, cap, view,graph;
1045 } else {
1046 f= createb(filename, primitives);
1047 save, f, l_frame;
1048 add_member, f, "plot", -1, "x_axis", float, 10;
1049 add_member, f, "plot", -1, "y_axis", float, 10;
1050 add_member, f, "plot", -1, "npts", int;
1051 add_member, f, "plot", -1, "label", "char *";
1052 add_member, f, "plot", -1, "view", l_frame;
1053 install_struct, f, "plot";
1054 save, f, cs,ss,is,fs,ds, ca,sa,ia,fa2,da;
1055 add_variable, f, -1, "cap", "char*", 3;
1056 save, f, cap, view,graph;
1057 close, f;
1058 }
1059 save, updateb(filename), fa2_app,fs_app;
1060 }
1061