1## -*- mode: Perl -*- 2## 3## Copyright (c) 2019 The University of Utah 4## All rights reserved. 5## 6## This file is distributed under the University of Illinois Open Source 7## License. See the file COPYING for details. 8 9############################################################################### 10 11package pass_line_markers; 12 13use strict; 14use warnings; 15 16use File::Copy; 17use File::Compare; 18use creduce_utils; 19 20sub check_prereqs () { 21 return 1; 22} 23 24sub count_line_markers ($$) { 25 (my $cfile, my $which) = @_; 26 open INF, "<$cfile" or die; 27 my $n = 0; 28 while (my $line = <INF>) { 29 if ($line =~ m/^\s*#\s*[0-9]+/) { 30 $n++; 31 } 32 } 33 close INF; 34 return $n; 35} 36 37sub new ($$) { 38 my ($cfile, $which) = @_; 39 my %sh; 40 my $instances = count_line_markers($cfile, $which); 41 $sh{"index"} = $instances; 42 $sh{"chunk"} = $instances; 43 return \%sh; 44} 45 46sub advance ($$$) { 47 (my $cfile, my $which, my $state) = @_; 48 my %sh = %{$state}; 49 50 $sh{"index"} -= $sh{"chunk"}; 51 if ($DEBUG) { 52 my $index = $sh{"index"}; 53 my $chunk = $sh{"chunk"}; 54 print "ADVANCE: index = $index, chunk = $chunk\n"; 55 } 56 return \%sh; 57} 58 59sub transform ($$$) { 60 my ($cfile, $which, $state) = @_; 61 my %sh = %{$state}; 62 63 AGAIN: 64 65 my $instances = count_line_markers($cfile, $which); 66 $sh{"index"} = $instances if ($sh{"index"} > $instances); 67 my $index = $sh{"index"}; 68 my $chunk = $sh{"chunk"}; 69 70 if ($index >= 0 && $instances > 0 && $chunk > 0) { 71 my $start = $index - $chunk; 72 $start = 0 if ($start < 0); 73 74 open INF, "<$cfile" or die; 75 my $tmpfile = File::Temp::tmpnam(); 76 open OUTF, ">$tmpfile" or die; 77 my $line_markers = -1; 78 while (my $line = <INF>) { 79 if ($line =~ m/^\s*#\s*[0-9]+/) { 80 $line_markers++; 81 if ($line_markers >= $start && $line_markers < $index) { 82 next; 83 } 84 } 85 print OUTF $line; 86 } 87 close INF; 88 close OUTF; 89 90 my $new_instances = count_line_markers($tmpfile, $which); 91 print "went from $instances line markers to $new_instances ", 92 "with chunk $chunk\n" if $DEBUG; 93 94 if (compare($cfile, $tmpfile) == 0) { 95 print "did not change file\n" if $DEBUG; 96 unlink $tmpfile; 97 $sh{"index"} -= $sh{"chunk"}; 98 goto AGAIN; 99 } 100 File::Copy::move($tmpfile, $cfile); 101 } else { 102 return ($STOP, \%sh) if ($chunk < 10); 103 my $newchunk = int ($chunk / 2.0); 104 $sh{"chunk"} = $newchunk; 105 print "granularity reduced to $newchunk\n" if $DEBUG; 106 $sh{"index"} = $instances; 107 goto AGAIN; 108 } 109 110 return ($OK, \%sh); 111} 112 1131; 114