#!/usr/bin/perl
# Copyright 2006-2008 The FLWOR Foundation.                                                      
#  
# Licensed under the Apache License, Version 2.0 (the "License");                                
# you may not use this file except in compliance with the License.                               
# You may obtain a copy of the License at
#  
# http://www.apache.org/licenses/LICENSE-2.0                                                     
#  
# Unless required by applicable law or agreed to in writing, software                            
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.                       
# See the License for the specific language governing permissions and
# limitations under the License.

# Analyzes a ctest / valgrind output log for unique loss records
# Usage: vgsummarize [ --except REGEX ] valgrind_log

use strict;
use warnings;

my ($test, $record, $firstrecord, $intesthdr);
my %records;  # things we have already seen

my $except_regex;

if ($#ARGV >= 1 && $ARGV [0] eq "--except") {
    $except_regex = $ARGV [1];
    shift @ARGV; shift @ARGV;
} 

$record = "";
while (<>) {

    if (m@^ *[0-9]+/[0-9]+ +Memory Check ([^ ]+)@) {
        $test = $1;
        $firstrecord = 1;
        $intesthdr = 1;
    } elsif ($intesthdr && m@^test (.*)@) {
        $test = $1;
        $intesthdr = 0;
    } elsif (m@==[0-9]+== (.*) bytes in ([0-9,]+) blocks (.*) in loss .*@) {
        $record eq "" || die ("Record not empty: $record");
        $record = "$1 bytes $2 blocks $3\n";
    } elsif (m@==[0-9]+== ( ?)([A-Z].*)@) {
        # if $1 eq " ", inside an existing record; if not, new record
        # Segfaults are neither indented nor delimited by \n\n
        # ($record eq "" || $1) || die ("Record not empty: $record");
        $record .= "$2\n";
    } elsif (m@==[0-9]+== *((at|by) 0x.*)@) {
        $record .= "$1\n"
    } elsif ($record) {
        my $r = $record; $record = "";
        if ($records {$r} || ($except_regex && $r =~ m@($except_regex)@)) { next; }
        if ($firstrecord) {
            $firstrecord = 0;
            print "=== TEST $test\n"
        }
        print "$r\n";
        $records {$r} = 1;
    }

}
