contrib/perl5/t/op/repeat.t

   1 #!./perl
   2
   3 # $RCSfile: repeat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:21 $
   4
   5 print "1..20\n";
   6
   7 # compile time
   8
   9 if ('-' x 5 eq '-----') {print "ok 1\n";} else {print "not ok 1\n";}
  10 if ('-' x 1 eq '-') {print "ok 2\n";} else {print "not ok 2\n";}
  11 if ('-' x 0 eq '') {print "ok 3\n";} else {print "not ok 3\n";}
  12
  13 if ('ab' x 3 eq 'ababab') {print "ok 4\n";} else {print "not ok 4\n";}
  14
  15 # run time
  16
  17 $a = '-';
  18 if ($a x 5 eq '-----') {print "ok 5\n";} else {print "not ok 5\n";}
  19 if ($a x 1 eq '-') {print "ok 6\n";} else {print "not ok 6\n";}
  20 if ($a x 0 eq '') {print "ok 7\n";} else {print "not ok 7\n";}
  21
  22 $a = 'ab';
  23 if ($a x 3 eq 'ababab') {print "ok 8\n";} else {print "not ok 8\n";}
  24
  25 $a = 'xyz';
  26 $a x= 2;
  27 if ($a eq 'xyzxyz') {print "ok 9\n";} else {print "not ok 9\n";}
  28 $a x= 1;
  29 if ($a eq 'xyzxyz') {print "ok 10\n";} else {print "not ok 10\n";}
  30 $a x= 0;
  31 if ($a eq '') {print "ok 11\n";} else {print "not ok 11\n";}
  32
  33 @x = (1,2,3);
  34
  35 print join('', @x x 4) eq '3333' ? "ok 12\n" : "not ok 12\n";
  36 print join('', (@x) x 4) eq '123123123123' ? "ok 13\n" : "not ok 13\n";
  37 print join('', (@x,()) x 4) eq '123123123123' ? "ok 14\n" : "not ok 14\n";
  38 print join('', (@x,1) x 4) eq '1231123112311231' ? "ok 15\n" : "not ok 15\n";
  39 print join(':', () x 4) eq '' ? "ok 16\n" : "not ok 16\n";
  40 print join(':', (9) x 4) eq '9:9:9:9' ? "ok 17\n" : "not ok 17\n";
  41 print join(':', (9,9) x 4) eq '9:9:9:9:9:9:9:9' ? "ok 18\n" : "not ok 18\n";
  42 print join('', (split(//,"123")) x 2) eq '123123' ? "ok 19\n" : "not ok 19\n";
  43
  44 #
  45 # The test #20 is actually testing for Digital C compiler optimizer bug.
  46 #
  47 # Dec C versions 5.* and 6.0 (used in Digital UNIX and VMS) used
  48 # to produce (as of December 1998) broken code for util.c:repeatcpy()
  49 # (a utility function for the 'x' operator) in the case *all* these
  50 # four conditions held:
  51 #
  52 # (1) len == 1
  53 # (2) "from" had the 8th bit on in its single character
  54 # (3) count > 7 (the 'x' count > 16)
  55 # (4) the highest optimization level was used in compilation
  56 #     (which is the default when compiling Perl)
  57 #
  58 # The bug looked like this (. being the eight-bit character and ? being \xff):
  59 #
  60 # 16 ................
  61 # 17 .........???????.
  62 # 18 .........???????..
  63 # 19 .........???????...
  64 # 20 .........???????....
  65 # 21 .........???????.....
  66 # 22 .........???????......
  67 # 23 .........???????.......
  68 # 24 .........???????.???????
  69 # 25 .........???????.???????.
  70 #
  71 # The bug could be (obscurely) avoided by changing "from" to
  72 # be an unsigned char pointer.
  73 #
  74 # The bug was triggered in the "if (len == 1)" branch.  The fix
  75 # was to introduce a new temporary variable.  In diff -u format:
  76 #
  77 #     register char *frombase = from;
  78 #
  79 #     if (len == 1) {
  80 #-       todo = *from;
  81 #+       register char c = *from;
  82 #        while (count-- > 0)
  83 #-           *to++ = todo;
  84 #+           *to++ = c;
  85 #        return;
  86 #     }
  87 #
  88 # This obscure bug was not found by the then test suite but instead
  89 # by Mark.Martinec@nsc.ijs.si while trying to install Digest-MD5-2.00.
  90 #
  91 # jhi@iki.fi
  92 #
  93 print "\xdd" x 24 eq "\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd" ? "ok 20\n" : "not ok 20\n";