home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / op / lex_assign.t < prev    next >
Text File  |  2000-02-15  |  7KB  |  325 lines
  1. #!./perl
  2.  
  3. BEGIN {
  4.     chdir 't' if -d 't';
  5.     unshift @INC, '../lib';
  6. }
  7. $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; 
  8.  
  9. umask 0;
  10. $xref = \ "";
  11. $runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X;
  12. @a = (1..5);
  13. %h = (1..6);
  14. $aref = \@a;
  15. $href = \%h;
  16. open OP, qq{$runme -le "print 'aaa Ok ok' for 1..100"|};
  17. $chopit = 'aaaaaa';
  18. @chopar = (113 .. 119);
  19. $posstr = '123456';
  20. $cstr = 'aBcD.eF';
  21. pos $posstr = 3;
  22. $nn = $n = 2;
  23. sub subb {"in s"}
  24.  
  25. @INPUT = <DATA>;
  26. @simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
  27. print "1..", (10 + @INPUT + @simple_input), "\n";
  28. $ord = 0;
  29.  
  30. sub wrn {"@_"}
  31.  
  32. # Check correct optimization of ucfirst etc
  33. $ord++;
  34. my $a = "AB";
  35. my $b = "\u\L$a";
  36. print "not " unless $b eq 'Ab';
  37. print "ok $ord\n";
  38.  
  39. # Check correct destruction of objects:
  40. my $dc = 0;
  41. sub A::DESTROY {$dc += 1}
  42. $a=8;
  43. my $b;
  44. { my $c = 6; $b = bless \$c, "A"}
  45.  
  46. $ord++;
  47. print "not " unless $dc == 0;
  48. print "ok $ord\n";
  49.  
  50. $b = $a+5;
  51.  
  52. $ord++;
  53. print "not " unless $dc == 1;
  54. print "ok $ord\n";
  55.  
  56. $ord++;
  57. my $xxx = 'b';
  58. $xxx = 'c' . ($xxx || 'e');
  59. print "not " unless $xxx eq 'cb';
  60. print "ok $ord\n";
  61.  
  62. {                # Check calling STORE
  63.   my $sc = 0;
  64.   sub B::TIESCALAR {bless [11], 'B'}
  65.   sub B::FETCH { -(shift->[0]) }
  66.   sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift }
  67.  
  68.   my $m;
  69.   tie $m, 'B';
  70.   $m = 100;
  71.  
  72.   $ord++;
  73.   print "not " unless $sc == 1;
  74.   print "ok $ord\n";
  75.  
  76.   my $t = 11;
  77.   $m = $t + 89;
  78.   
  79.   $ord++;
  80.   print "not " unless $sc == 2;
  81.   print "ok $ord\n";
  82.  
  83.   $ord++;
  84.   print "# $m\nnot " unless $m == -117;
  85.   print "ok $ord\n";
  86.  
  87.   $m += $t;
  88.  
  89.   $ord++;
  90.   print "not " unless $sc == 3;
  91.   print "ok $ord\n";
  92.  
  93.   $ord++;
  94.   print "# $m\nnot " unless $m == 89;
  95.   print "ok $ord\n";
  96.  
  97. }
  98.  
  99. # Chains of assignments
  100.  
  101. my ($l1, $l2, $l3, $l4);
  102. my $zzzz = 12;
  103. $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 1 + $zzzz;
  104.  
  105. $ord++;
  106. print "# $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 13\nnot "
  107.   unless $zzz1 == 13 and $zzz2 == 13 and $l1 == 13
  108.   and $l2 == 13 and $l3 == 13 and $l4 == 13;
  109. print "ok $ord\n";
  110.  
  111. for (@INPUT) {
  112.   $ord++;
  113.   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
  114.   $comment = $op unless defined $comment;
  115.   $op = "$op==$op" unless $op =~ /==/;
  116.   ($op, $expectop) = $op =~ /(.*)==(.*)/;
  117.   
  118.   $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
  119.       ? "skip" : "not";
  120.   $integer = ($comment =~ /^i_/) ? "use integer" : '' ;
  121.   (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
  122.   
  123.   eval <<EOE;
  124.   local \$SIG{__WARN__} = \\&wrn;
  125.   my \$a = 'fake';
  126.   $integer;
  127.   \$a = $op;
  128.   \$b = $expectop;
  129.   if (\$a ne \$b) {
  130.     print "# \$comment: got `\$a', expected `\$b'\n";
  131.     print "\$skip " if \$a ne \$b or \$skip eq 'skip';
  132.   }
  133.   print "ok \$ord\\n";
  134. EOE
  135.   if ($@) {
  136.     if ($@ =~ /is unimplemented/) {
  137.       print "# skipping $comment: unimplemented:\nok $ord\n";
  138.     } else {
  139.       warn $@;
  140.       print "not ok $ord\n";
  141.     }
  142.   }
  143. }
  144.  
  145. for (@simple_input) {
  146.   $ord++;
  147.   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
  148.   $comment = $op unless defined $comment;
  149.   ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n";
  150.   eval <<EOE;
  151.   local \$SIG{__WARN__} = \\&wrn;
  152.   my \$$variable = "Ac# Ca\\nxxx";
  153.   \$$variable = $operator \$$variable;
  154.   \$toself = \$$variable;
  155.   \$direct = $operator "Ac# Ca\\nxxx";
  156.   print "# \\\$$variable = $operator \\\$$variable\\nnot "
  157.     unless \$toself eq \$direct;
  158.   print "ok \$ord\\n";
  159. EOE
  160.   if ($@) {
  161.     if ($@ =~ /is unimplemented/) {
  162.       print "# skipping $comment: unimplemented:\nok $ord\n";
  163.     } elsif ($@ =~ /Can't (modify|take log of 0)/) {
  164.       print "# skipping $comment: syntax not good for selfassign:\nok $ord\n";
  165.     } else {
  166.       warn $@;
  167.       print "not ok $ord\n";
  168.     }
  169.   }
  170. }
  171. __END__
  172. ref $xref            # ref
  173. ref $cstr            # ref nonref
  174. `$runme -e "print qq[1\n]"`                # backtick skip(MSWin32)
  175. `$undefed`            # backtick undef skip(MSWin32)
  176. <*>                # glob
  177. <OP>                # readline
  178. 'faked'                # rcatline
  179. (@z = (1 .. 3))            # aassign
  180. chop $chopit            # chop
  181. (chop (@x=@chopar))        # schop
  182. chomp $chopit            # chomp
  183. (chop (@x=@chopar))        # schomp
  184. pos $posstr            # pos
  185. pos $chopit            # pos returns undef
  186. $nn++==2            # postinc
  187. $nn++==3            # i_postinc
  188. $nn--==4            # postdec
  189. $nn--==3            # i_postdec
  190. $n ** $n            # pow
  191. $n * $n                # multiply
  192. $n * $n                # i_multiply
  193. $n / $n                # divide
  194. $n / $n                # i_divide
  195. $n % $n                # modulo
  196. $n % $n                # i_modulo
  197. $n x $n                # repeat
  198. $n + $n                # add
  199. $n + $n                # i_add
  200. $n - $n                # subtract
  201. $n - $n                # i_subtract
  202. $n . $n                # concat
  203. $n . $a=='2fake'        # concat with self
  204. "3$a"=='3fake'            # concat with self in stringify
  205. "$n"                # stringify
  206. $n << $n            # left_shift
  207. $n >> $n            # right_shift
  208. $n <=> $n            # ncmp
  209. $n <=> $n            # i_ncmp
  210. $n cmp $n            # scmp
  211. $n & $n                # bit_and
  212. $n ^ $n                # bit_xor
  213. $n | $n                # bit_or
  214. -$n                # negate
  215. -$n                # i_negate
  216. ~$n                # complement
  217. atan2 $n,$n            # atan2
  218. sin $n                # sin
  219. cos $n                # cos
  220. '???'                # rand
  221. exp $n                # exp
  222. log $n                # log
  223. sqrt $n                # sqrt
  224. int $n                # int
  225. hex $n                # hex
  226. oct $n                # oct
  227. abs $n                # abs
  228. length $posstr            # length
  229. substr $posstr, 2, 2        # substr
  230. vec("abc",2,8)            # vec
  231. index $posstr, 2        # index
  232. rindex $posstr, 2        # rindex
  233. sprintf "%i%i", $n, $n        # sprintf
  234. ord $n                # ord
  235. chr $n                # chr
  236. crypt $n, $n            # crypt
  237. ucfirst ($cstr . "a")        # ucfirst padtmp
  238. ucfirst $cstr            # ucfirst
  239. lcfirst $cstr            # lcfirst
  240. uc $cstr            # uc
  241. lc $cstr            # lc
  242. quotemeta $cstr            # quotemeta
  243. @$aref                # rv2av
  244. @$undefed            # rv2av undef
  245. each %h==1            # each
  246. values %h            # values
  247. keys %h                # keys
  248. %$href                # rv2hv
  249. pack "C2", $n,$n        # pack
  250. split /a/, "abad"        # split
  251. join "a"; @a            # join
  252. push @a,3==6            # push
  253. unshift @aaa            # unshift
  254. reverse    @a            # reverse
  255. reverse    $cstr            # reverse - scal
  256. grep $_, 1,0,2,0,3        # grepwhile
  257. map "x$_", 1,0,2,0,3        # mapwhile
  258. subb()                # entersub
  259. caller                # caller
  260. warn "ignore this\n"        # warn
  261. 'faked'                # die
  262. open BLAH, "<non-existent"    # open
  263. fileno STDERR            # fileno
  264. umask 0                # umask
  265. select STDOUT            # sselect
  266. select "","","",0        # select
  267. getc OP                # getc
  268. '???'                # read
  269. '???'                # sysread
  270. '???'                # syswrite
  271. '???'                # send
  272. '???'                # recv
  273. '???'                # tell
  274. '???'                # fcntl
  275. '???'                # ioctl
  276. '???'                # flock
  277. '???'                # accept
  278. '???'                # shutdown
  279. '???'                # ftsize
  280. '???'                # ftmtime
  281. '???'                # ftatime
  282. '???'                # ftctime
  283. chdir 'non-existent'        # chdir
  284. '???'                # chown
  285. '???'                # chroot
  286. unlink 'non-existent'        # unlink
  287. chmod 'non-existent'        # chmod
  288. utime 'non-existent'        # utime
  289. rename 'non-existent', 'non-existent1'    # rename
  290. link 'non-existent', 'non-existent1' # link
  291. '???'                # symlink
  292. readlink 'non-existent', 'non-existent1' # readlink
  293. '???'                # mkdir
  294. '???'                # rmdir
  295. '???'                # telldir
  296. '???'                # fork
  297. '???'                # wait
  298. '???'                # waitpid
  299. system "$runme -e 0"        # system skip(VMS)
  300. '???'                # exec
  301. '???'                # kill
  302. getppid                # getppid
  303. getpgrp                # getpgrp
  304. '???'                # setpgrp
  305. getpriority $$, $$        # getpriority
  306. '???'                # setpriority
  307. time                # time
  308. localtime $^T            # localtime
  309. gmtime $^T            # gmtime
  310. sleep 1                # sleep
  311. '???'                # alarm
  312. '???'                # shmget
  313. '???'                # shmctl
  314. '???'                # shmread
  315. '???'                # shmwrite
  316. '???'                # msgget
  317. '???'                # msgctl
  318. '???'                # msgsnd
  319. '???'                # msgrcv
  320. '???'                # semget
  321. '???'                # semctl
  322. '???'                # semop
  323. '???'                # getlogin
  324. '???'                # syscall
  325.