#!/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.
use strict;
use Getopt::Long;
use FindBin;
use File::Temp;

my ($html, $blame, $parse_err);
GetOptions ("html" => \$html, "blame" => \$blame, "parse-err" => \$parse_err);

my $test_path = $FindBin::RealBin;

my %queries;

sub add_assert_fail {
    my ($q, $file, $fun, $assertion) = @_;
    $_ = "$file: $fun: $assertion";
    if ($html) {
        s/([&])/$1amp;/g; s/([<])/&lt;/g; s/[>]/&gt;/g;
    }
    push @{ $queries {$_} }, $q;
}

sub by_number_desc_then_string {
    return -(($a <=> $b) || ($a cmp $b));
}

sub svn_blame {
    if (! $blame) { return ""; }
    
    my $author;

    my ($qfh, $qf) = File::Temp::tempfile ();
    print $qfh '
declare option saxon:output "omit-xml-declaration=yes";
declare variable $line external;
//entry [@line-number eq $line]//author/text()
';
    close ($qfh);
    
    if (m#([^:]+):([^:]+):#) {
        my ($file, $line) = ($1, $2);
        if (($file eq "?") || ($line eq "?")) { return ""; }
        $author = `svn blame --xml $file | $test_path/zorbatest/xquery -s - $qf line=$line`
    }

    unlink $qf;
    return "$author: ";
}

my ($query, $in_valgrind, $vg_err);

while (<>) {
    if (m#^[0-9]+/[0-9]+ Testing: (.*)$#) {
        $query = $1;
        $in_valgrind = 0;
        $vg_err = "";
    } elsif (m#^[^:]+: ([^:]+:[0-9]+): (.*): Assertion (.*) failed.$#) {
        add_assert_fail $query, $1, $2, $3;
    } elsif (m#XQP0005:.*Assertion (.*) failed in ([^:]+:[0-9]+): (.*)$#) {
        add_assert_fail $query, $2, $3, $1;
    } elsif (m#XQP0019: ?Zorba internal error (.*)#) {
        add_assert_fail $query, "?", "?:?", "XQP0019: exception $1 suppressed";
    } elsif (m#^[<] [<]root[>]XPST0003[<]/root>$# && $parse_err) {
        add_assert_fail $query, "?", "?:?", "parser failure XPST0003";
    } elsif (m#^[>] [<]root[>]XPST0003[<]/root>$# && $parse_err) {
        add_assert_fail $query, "?", "?:?", "parse incorrectly succeeded, should have raised XPST0003";
    } elsif (m#running valgrind#) {
        $in_valgrind = 1;
    } elsif ($in_valgrind == 1 && m#^==[0-9]+== ([^ ].*)#) {
        $in_valgrind++;
        $vg_err = "Valgrind: $1";
    } elsif ($in_valgrind == 2 && m#^==[0-9]+== *at 0x[0-9A-Z]+: (.*) [(](.*:[0-9]+)[)]$#) {
        add_assert_fail ($query, $2, $1, $vg_err);
        $in_valgrind = 3;
    }
}

# change testcase names to include fault count
my %queries_new;
foreach (keys %queries) {
    my @qs = @{ $queries {$_} };
    $_ = scalar @qs . " queries: " . svn_blame . $_;
    @{ $queries_new {$_} } = @qs;
}
%queries = %queries_new;

foreach (sort (by_number_desc_then_string keys(%queries))) {
    my $case = $_;
    my @qs = @{ $queries {$case} };
    print $case . "\n" . join ("\n", @qs) . "\n\n";
}
