Commit | Line | Data |
5f05dabc |
1 | print "1..15\n"; |
2 | |
3 | require VMS::DCLsym or die "failed 1\n"; |
4 | print "ok 1\n"; |
5 | |
6 | tie %syms, VMS::DCLsym or die "failed 2\n"; |
7 | print "ok 2\n"; |
8 | |
9 | $name = 'FOO_'.time(); |
10 | $syms{$name} = 'Perl_test'; |
11 | print +($! ? "(\$! = $!) not " : ''),"ok 3\n"; |
12 | |
13 | print +($syms{$name} eq 'Perl_test' ? '' : 'not '),"ok 4\n"; |
14 | |
15 | ($val) = `Show Symbol $name` =~ /(\w+)"$/; |
16 | print +($val eq 'Perl_test' ? '' : 'not '),"ok 5\n"; |
17 | |
18 | while (($sym,$val) = each %syms) { |
19 | last if $sym eq $name && $val eq 'Perl_test'; |
20 | } |
21 | print +($sym ? '' : 'not '),"ok 6\n"; |
22 | |
23 | delete $syms{$name}; |
24 | print +($! ? "(\$! = $!) not " : ''),"ok 7\n"; |
25 | |
26 | print +(defined($syms{$name}) ? 'not ' : ''),"ok 8\n"; |
27 | undef %syms; |
28 | |
29 | $obj = new VMS::DCLsym 'GLOBAL'; |
30 | print +($obj ? '' : 'not '),"ok 9\n"; |
31 | |
32 | print +($obj->clearcache(0) ? '' : 'not '),"ok 10\n"; |
33 | print +($obj->clearcache(1) ? 'not ' : ''),"ok 11\n"; |
34 | |
35 | print +($obj->setsym($name,'Another_test') ? '' : 'not '),"ok 12\n"; |
36 | |
37 | ($val,$tab) = $obj->getsym($name); |
38 | print +($val eq 'Another_test' && $tab eq 'GLOBAL' ? '' : 'not '),"ok 13\n"; |
39 | |
40 | print +($obj->delsym($name,'LOCAL') ? 'not ' : ''),"ok 14\n"; |
41 | print +($obj->delsym($name,'GLOBAL') ? '' : 'not '),"ok 15\n"; |