One Level Up Top Level

test/util/reindex - ktap

Data types defined

Source code

  1. #!/usr/bin/env perl

  3. # reindex
  4. # reindex .t files for Test::Base based test files
  5. # Copyright (C) Yichun Zhang (agentzh)

  7. use strict;
  8. use warnings;

  10. use Getopt::Std;

  12. my %opts;
  13. getopts('hb:', \%opts);
  14. if ($opts{h} or ! @ARGV) {
  15.     die "Usage: reindex [-b 0] t/*.t\n";
  16. }

  18. my $init = $opts{b};
  19. $init = 1 if not defined $init;

  21. my @files = map glob, @ARGV;
  22. for my $file (@files) {
  23.     next if -d $file or $file !~ /\.t_?$/;
  24.     reindex($file);
  25. }

  27. ‌sub reindex {
  28.     my $file = $_[0];
  29.     open my $in, $file or
  30.         die "Can't open $file for reading: $!";
  31.     my @lines;
  32.     my $counter = $init;
  33.     my $changed;
  34.     while (<$in>) {
  35.         s/\r$//;
  36.         my $num;
  37.         s/ ^ === \s+ TEST \s+ (\d+)/$num=$1; "=== TEST " . $counter++/xie;
  38.         next if !defined $num;
  39.         if ($num != $counter-1) {
  40.             $changed++;
  41.         }
  42.     } continue {
  43.         push @lines, $_;
  44.     }
  45.     close $in;
  46.     my $text = join '', @lines;
  47.     $text =~ s/(?x) \n+ === \s+ TEST/\n\n\n\n=== TEST/ixsg;
  48.     $text =~ s/__(DATA|END)__\n+=== TEST/__${1}__\n\n=== TEST/;
  49.     #$text =~ s/\n+$/\n\n/s;
  50.     if (! $changed and $text eq join '', @lines) {
  51.         warn "reindex: $file:\tskipped.\n";
  52.         return;
  53.     }
  54.     open my $out, "> $file" or
  55.         die "Can't open $file for writing: $!";
  56.     binmode $out;
  57.     print $out $text;
  58.     close $out;

  60.     warn "reindex: $file:\tdone.\n";
  61. }

One Level Up Top Level