1print "1..30\n"; 2 3require VMS::DCLsym or die "not ok 1\n"; 4print "ok 1\n"; 5 6tie %syms, VMS::DCLsym or die "not ok 2\n"; 7print "ok 2\n"; 8 9$name = 'FOO_'.time(); 10$syms{$name} = 'Perl_test'; 11print +($! ? "#(\$! = $!)\nnot " : ''),"ok 3\n"; 12 13print +($syms{$name} eq 'Perl_test' ? '' : 'not '),"ok 4\n"; 14 15($val) = `Show Symbol $name` =~ /(\w+)"$/; 16print +($val eq 'Perl_test' ? '' : 'not '),"ok 5\n"; 17 18while (($sym,$val) = each %syms) { 19 last if $sym eq $name && $val eq 'Perl_test'; 20} 21print +($sym ? '' : 'not '),"ok 6\n"; 22 23delete $syms{$name}; 24print +($! ? "#(\$! = $!)\nnot " : ''),"ok 7\n"; 25 26print +(defined($syms{$name}) ? 'not ' : ''),"ok 8\n"; 27 28$obj = new VMS::DCLsym 'GLOBAL'; 29print +($obj ? '' : 'not '),"ok 9\n"; 30 31print +($obj->clearcache(0) ? '' : 'not '),"ok 10\n"; 32print +($obj->clearcache(1) ? 'not ' : ''),"ok 11\n"; 33 34print +($obj->setsym($name,'Another_test') ? '' : 'not '),"ok 12\n"; 35 36($val,$tab) = $obj->getsym($name); 37print +($val eq 'Another_test' && $tab eq 'GLOBAL' ? '' : 'not '),"ok 13\n"; 38 39print +($obj->delsym($name,'LOCAL') ? 'not ' : ''),"ok 14\n"; 40print +($obj->delsym($name,'GLOBAL') ? '' : 'not '),"ok 15\n"; 41 42($val,$tab) = $obj->getsym($name); 43print +(defined($val) || defined($tab) ? 'not ' : ''),"ok 16\n"; 44 45($val) = `Show Symbol/Global $name` =~ /==\s+"(\w+)"$/; 46print +(defined($val) ? 'not ' : ''),"ok 17\n"; 47 48tie %gsyms, VMS::DCLsym, 'GLOBAL' or die "not ok 18\n"; 49print "ok 18\n"; 50 51print +(tied(%gsyms) =~ /^VMS::DCLsym/ ? '' : 'not '),"ok 19\n"; 52print +(exists $gsyms{$name} ? 'not ' : ''),"ok 20\n"; 53 54$gsyms{$name} = 'Perl_test'; 55print +($! ? "#(\$! = $!)\nnot " : ''),"ok 21\n"; 56 57print +($gsyms{$name} eq 'Perl_test' ? '' : 'not '),"ok 22\n"; 58 59($val) = `Show Symbol/Global $name` =~ /==\s+"(\w+)"$/; 60print +($val eq 'Perl_test' ? '' : 'not '),"ok 23\n"; 61 62delete $gsyms{$name}; 63print +($! ? "#(\$! = $!)\nnot " : ''),"ok 24\n"; 64 65($val,$tab) = $obj->getsym($name); 66print +(defined($val) || defined($tab) ? 'not ' : ''),"ok 25\n"; 67 68($val) = `Show Symbol/Global $name` =~ /==\s+"(\w+)"$/; 69print +($val eq 'Perl_test' ? 'not ' : ''),"ok 26\n"; 70 71print +($syms{':LOCAL'} ? '' : 'not '),"ok 27\n"; 72print +($syms{':GLOBAL'} ? 'not ' : ''),"ok 28\n"; 73 74print +($gsyms{':LOCAL'} ? 'not ' : ''),"ok 29\n"; 75print +($gsyms{':GLOBAL'} ? '' : 'not '),"ok 30\n"; 76