1## -*- mode: Perl -*- 2## 3## Copyright (c) 2015, 2016, 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_comments; 12 13use strict; 14use warnings; 15 16use File::Compare; 17use creduce_utils; 18use Regexp::Common qw /comment/; 19 20sub check_prereqs () { 21 return 1; 22} 23 24sub count_comments ($$) { 25 my ($cfile, $which) = @_; 26 open INF, "<$cfile" or die; 27 my $n = 0; 28 while (my $line = <INF>) { 29 if ($line =~ m/\/\/(.*?)$/) { 30 $n++; 31 } 32 } 33 close INF; 34 return $n; 35} 36 37sub new ($$) { 38 my ($cfile, $which) = @_; 39 my %sh; 40 $sh{"pass"} = -2; 41 $sh{"start"} = 1; 42 return \%sh; 43} 44 45sub advance ($$$) { 46 (my $cfile, my $which, my $state) = @_; 47 my %sh = %{$state}; 48 49 my $pass = $sh{"pass"}; 50 if ($pass < 0) { 51 $sh{"pass"}++; 52 } else { 53 $sh{"index"} += $sh{"chunk"}; 54 } 55 return \%sh; 56} 57 58sub do_transform_binsrch ($$$$) { 59 my ($cfile, $tmpfile, $which, $state) = @_; 60 my %sh = %{$state}; 61 62 my $instances = count_comments($cfile, $which); 63 my $index = $sh{"index"}; 64 my $chunk = $sh{"chunk"}; 65 66 if ($index < $instances && $instances > 0) { 67 open INF, "<$cfile" or die; 68 open OUTF, ">$tmpfile" or die; 69 my $comments = -1; 70 while (my $line = <INF>) { 71 my $newline = $line; 72 if ($line =~ m/\/\/(.*?)$/) { 73 $comments++; 74 if ($comments >= $index && $comments < $index + $chunk) { 75 $newline =~ s/\/\/(.*?)$//g; 76 } 77 } 78 print OUTF $newline; 79 } 80 close INF; 81 close OUTF; 82 83 my $new_instances = count_comments($tmpfile, $which); 84 print "went from $instances comments to $new_instances ", 85 "with chunk $chunk\n" if $DEBUG; 86 87 return 0; 88 } 89 return 1; 90} 91 92sub transform ($$$) { 93 (my $cfile, my $which, my $state) = @_; 94 my %sh = %{$state}; 95 96 my $prog = read_file ($cfile); 97 my $prog2 = $prog; 98 my $tmpfile = File::Temp::tmpnam(); 99 100 AGAIN: 101 my $pass = $sh{"pass"}; 102 if ($pass == -2) { 103 # remove all C-style comments 104 $prog2 =~ s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#defined $2 ? $2 : ""#gse; 105 write_file($tmpfile, $prog2); 106 } elsif ($pass == -1) { 107 # remove all C++-style comments 108 $prog2 =~ s/\/\/(.*?)$//gm; 109 write_file($tmpfile, $prog2); 110 } elsif ($pass == 0) { 111 # remove C++-style comments with binary search 112 113 if (defined($sh{"start"})) { 114 delete $sh{"start"}; 115 $sh{"index"} = 0; 116 $sh{"chunk"} = count_comments($cfile, $which); 117 } 118 119 my $rechunk = do_transform_binsrch($cfile, $tmpfile, $which, \%sh); 120 121 if ($rechunk) { 122 return ($STOP, \%sh) if ($sh{"chunk"} <= 1); 123 my $newchunk = int ($sh{"chunk"} / 2.0); 124 $sh{"chunk"} = $newchunk; 125 print "granularity reduced to $newchunk\n" if $DEBUG; 126 $sh{"index"} = 0; 127 goto AGAIN; 128 } 129 } 130 131 if (compare($cfile, $tmpfile) == 0) { 132 print "did not change file\n" if $DEBUG; 133 unlink $tmpfile; 134 if ($pass < 0) { 135 $sh{"pass"}++; 136 } else { 137 $sh{"index"} += $sh{"chunk"}; 138 } 139 goto AGAIN; 140 } 141 142 File::Copy::move($tmpfile, $cfile); 143 return ($OK, \%sh); 144} 145 1461; 147