From 6893ced703bee2d34c224d48ef31abb78b4a7daa Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Mon, 12 Nov 2018 12:23:23 -0800 Subject: [PATCH] snippets are now written in packing list order --- t/snippets/align10.in | 2 + t/snippets/align11.in | 4 + t/snippets/align12.in | 3 + t/snippets/make_t.pl | 190 +++++++++++++++++++++++++--- t/snippets/packing_list.txt | 244 ++++++++++++++++++++++++++++++++++++ 5 files changed, 427 insertions(+), 16 deletions(-) create mode 100644 t/snippets/align10.in create mode 100644 t/snippets/align11.in create mode 100644 t/snippets/align12.in create mode 100644 t/snippets/packing_list.txt diff --git a/t/snippets/align10.in b/t/snippets/align10.in new file mode 100644 index 00000000..cdef79c6 --- /dev/null +++ b/t/snippets/align10.in @@ -0,0 +1,2 @@ +$message =~ &rhs_wordwrap( $message, $width ); +$message_len =~ split( /^/, $message ); diff --git a/t/snippets/align11.in b/t/snippets/align11.in new file mode 100644 index 00000000..7e9680f3 --- /dev/null +++ b/t/snippets/align11.in @@ -0,0 +1,4 @@ +my $accountno = getnextacctno( $env, $bornum, $dbh ); +my $item = getiteminformation( $env, $itemno ); +my $account = "Insert into accountlines + bla bla"; diff --git a/t/snippets/align12.in b/t/snippets/align12.in new file mode 100644 index 00000000..25edf2e3 --- /dev/null +++ b/t/snippets/align12.in @@ -0,0 +1,3 @@ + my $type = shift || "o"; + my $fname = ( $type eq 'oo' ? 'orte_city' : 'orte' ); + my $suffix = ( $coord_system eq 'standard' ? '' : '-orig' ); diff --git a/t/snippets/make_t.pl b/t/snippets/make_t.pl index 0a190c1f..0cab9d8c 100755 --- a/t/snippets/make_t.pl +++ b/t/snippets/make_t.pl @@ -6,6 +6,13 @@ my $rtests; my $ipath = 'expect/'; +# The packing list file is used to keep the snippets packed in the +# same order each time, in order to avoid creating file differences +# when files are checked in to git. Each of the snippet files +# also has a small packing list at the top, and the list can +# be obtained there instead. +my $fpacking_list = "packing_list.txt"; + # Limit file size to simplify debugging my $MAX_TESTS_PER_FILE = 20; @@ -70,56 +77,207 @@ EOM return; }; +# We can either get the packing list from the snippets, or by +# reading the packing list file. To get it from the file, +# pass 'get_passing_list()' the file name. Otherwise, +# it will be constructed from the snippets. Both +# methods work. +#my $rpacking_list=get_packing_list($fpacking_list); +my $rpacking_list=get_packing_list(); + my @exp = glob("$ipath*"); #print "exp=(@exp)\n"; +my $ix = 0; +my $rix_lookup = {}; foreach my $file_exp (@exp) { my $estring = $get_string->($file_exp); my $ename = $file_exp; if ( $ename =~ /([^\/]+)$/ ) { $ename = $1 } my ( $sname, $pname ) = split /\./, $ename; - #print "BUBBA: file=$file_exp, ename = $ename, sname=$sname, pname=$pname\n"; $get_source->($sname); $get_param->($pname); push @{$rtests}, [ $ename, $pname, $sname, $estring ]; + $rix_lookup->{$ename} = $ix; + $ix++; +} + +# assign indexes to existing packing locations +my $rassigned; +my $rcount; +my $high_file=""; +my $high_digits=0; +foreach my $item ( @{$rpacking_list} ) { + my ( $ofile, $ename ) = @{$item}; + $rcount->{$ofile}++; + my $ix = $rix_lookup->{$ename}; + push @{$item}, $ix; + $rassigned->{$ix} = $ofile; + + # Find the last snippet file in the set + if ( $ofile =~ /(\d+)\.t/ ) { + my $digits = $1; + if ( $digits > $high_digits ) { + $high_digits = $digits; + $high_file = $ofile; + } + } } -my $file_count = 0; -my $nend = -1; -my $nstop = @{$rtests} - 1; -while ( $nend < $nstop ) { - $file_count++; - my $nbeg = $nend + 1; - $nend += $MAX_TESTS_PER_FILE; - if ( $nend > $nstop ) { $nend = $nstop } - my @tests; - foreach my $n ( $nbeg .. $nend ) { push @tests, $rtests->[$n]; } +# Pack all new items. Continue with last file in the list +my $ofile_last = $rpacking_list->[-1]->[0]; +my $case_count = $rcount->{$ofile_last} + 1; + +my $file_count = $high_digits; + +for ( my $ix = 0 ; $ix < @{$rtests} ; $ix++ ) { + next if ( $rassigned->{$ix} ); + if ( $case_count >= $MAX_TESTS_PER_FILE ) { $case_count = 1; $file_count++ } + my $ename = $rtests->[$ix]->[0]; my $ofile = "../snippets" . $file_count . ".t"; - make_snippet_t( $ofile, \@tests, $rparams, $rsources ); - print "Now run a 'make test' from the top directory to check these\n"; + push @{$rpacking_list}, [ $ofile, $ename, $ix ]; + print "Added case $ename to $ofile\n"; + $case_count++; +} + +# make the packing list for each file +my $rpacking_hash; +my @missing_cases; +foreach my $item ( @{$rpacking_list} ) { + my ( $ofile, $ename, $ix ) = @{$item}; + if ( !defined($ix) ) { push @missing_cases, $ename; next } + push @{ $rpacking_hash->{$ofile} }, $rtests->[$ix]; +} + +# Write the snippet files +my @empty_files; +foreach my $ofile ( sort keys %{$rpacking_hash} ) { + my @tests = @{ $rpacking_hash->{$ofile} }; + my $num = @tests; + if ($num) { + make_snippet_t( $ofile, \@tests, $rparams, $rsources ); + print "writing $num tests to $ofile\n"; + } + else { + + # a file no longer exists, we should delete or move it + push @empty_files, $ofile; + system "mv $ofile $ofile.bak"; + } +} + +if (@missing_cases) { + local $" = '> <'; + print < +EOM +} + +if (@empty_files) { + local $" = '> <'; + print < +EOM +} + +write_packing_list("$fpacking_list", $rpacking_list); +print "Now run a 'make test' from the top directory to check these\n"; + +sub write_packing_list { + my ( $ofile, $rpacking ) = @_; + if (-e $ofile) {system "mv $ofile $ofile.bak"} + open my $fh, '>', $ofile or die "cannot open $ofile: $!\n"; + $fh->print("# This file is automatically generated by make_t.pl\n"); + foreach my $item ( @{$rpacking} ) { + my ( $ofile, $ename ) = @{$item}; + $fh->print("$ofile\t$ename\n"); + } + $fh->close(); + print "wrote new packing list to $fpacking_list\n"; +} + +sub get_packing_list { + my ($ifile) = @_; + my $rlist; + if ( defined($ifile) && -e $ifile ) { + $rlist = read_packing_list($ifile); + } + else { + $rlist = construct_packing_list(); + } + return $rlist; +} + +sub read_packing_list { + + my ($ifile) = @_; + my $rlist; + open my $fh, '<', $ifile or die "cannot open $ifile: $!\n"; + foreach my $line (<$fh>) { + $line =~ s/^\s+//; + $line =~ s/\s+$//; + next unless ($line); + next if ( $line =~ /^#/ ); + my ( $ofile, $ename ) = split /\t/, $line; + push @{$rlist}, [ $ofile, $ename ]; + } + $fh->close(); + return $rlist; +} + +sub construct_packing_list { + + # construct the packing list directly from the snippet files + # this should be more reliable + my @files = glob("../snippets*.t"); + my $rlist; + foreach my $ifile (@files) { + open my $fh, '<', $ifile or die "cannot open $ifile: $!\n"; + my $saw_contents; + foreach my $line (<$fh>) { + if ( !$saw_contents ) { + if ( $line =~ /# Contents/ ) { $saw_contents = 1; next } + } + else { + if ( $line =~ /#\d+\s+(.*)\s*$/ ) { + my $ename = $1; + push @{$rlist}, [ $ifile, $ename ]; + } + else { last } + } + } + } + return $rlist; } sub make_snippet_t { my ( $ofile, $rtests, $rparams_all, $rsources_all ) = @_; + my $ename_string = "# Contents:\n"; # pull out the parameters and sources we need my $rparams = {}; my $rsources = {}; + my $nn=0; foreach my $item ( @{$rtests} ) { my ( $ename, $pname, $sname, $estring ) = @{$item}; $rparams->{$pname} = $rparams_all->{$pname}; $rsources->{$sname} = $rsources_all->{$sname}; + $nn++; + $ename_string .= "#$nn $ename\n"; } my $count = 0; my $audit_string = audit_string('#'); my $script = <