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