chiark / gitweb /
Qualify name given to @bres_byname@.
[mLib] / da-gtest
1 #! /usr/bin/perl
2 #
3 # Generate a random test file for dynamic array testing.
4 #
5 # Syntax reference:
6 #
7 #   push n, pop, shift, unshift n -- normal stack ops (pop and shift print)
8 #   insert x y z ... -- insert items at beginning
9 #   append x y z ... -- append items at end
10 #   delete n -- remove n items from beginning
11 #   reduce n -- remove n items from end
12 #   set i n -- assign item at index i to be n
13 #   get i -- display item at index i
14 #   first, last -- show first or last item
15 #   show -- write entire array to stdout, space separated on one line
16
17 sub random ($) {
18   my $lim = shift;
19   return int(rand($lim));
20 }
21
22 $lines = shift || 100;
23 $max = 0; # Estimate of size of array
24 $serial = 1;
25 while ($lines) {
26   $what = random(21);
27   if ($what < 8) {
28     my $op = (qw(push pop shift unshift))[$what % 4];
29     if ($op eq "push" || $op eq "unshift") {
30       my $n = $serial++;
31       $max++;
32       print "$op $n\n";
33     } elsif ($max > 0) {
34       $max--;
35       print "$op\n";
36     }
37   } elsif ($what < 10) {
38     my @n = ($serial++);
39     my $op = (qw(insert append))[$what % 2];
40     push(@n, $serial++) while random(4) < 3;
41     print "$op ", join(" ", @n), "\n";
42     $max += @n;
43   } elsif ($what < 12) {
44     if ($max < 10000) { next; }
45     my $n = 1;
46     my $op = (qw(delete reduce))[$what % 2];
47     $n++ while random(4) < 3;
48     print "$op $n\n";
49     $max -= $n;
50     if ($max < 0) {
51       $max = 0;
52     }
53   } elsif ($what < 16) {
54     my $i = random($max);
55     $i++ while random(4) < 2;
56     if ($what % 2 == 0) {
57       my $n = $serial++;
58       print "set $i $n\n";
59       if ($i >= $max) {
60         $max = $i + 1;
61       }
62     } else {
63       print "get $i\n";
64     }
65   } elsif ($what < 20) {
66     my $op = (qw(first last))[$what % 2];
67     print "$op\n" if $max;
68   } elsif (random(10) == 0) {
69     print "show\n";
70   } else { next; }
71   $lines--;
72 }
73
74 print "show\n";