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