#!/public/bin/perl

#***** delimiters for use in script
$EXCMONITOR = "#excMonitor";
$VALUECHECK = "#valueCheck";
$SEPARATOR = "#";
$END = "#end";

# default classes for compare/print methods
$VALUETYPE = "ValueType";
$EXCEPTIONTYPE = "ExceptionType";

$ROASTPREFIX = "Roast"; # prefix for Roast ids inserted in driver code
$lineCount = 0; # physical line number, set by nextLine
$lineBuf = undef; # static local for nextLine

#***** main line
@line = &nextLine();
while ($line[0] ne "eof") {
    if ($line[0] eq "roast") {
        if ($line[1] =~ /^$EXCMONITOR$/i) {
            &excMonitor($line[2]);
        } elsif ($line[1] =~ /^$VALUECHECK$/i) {
            &valueCheck($line[2]);
        } else {
            &fail("Unknown keyword",$line[2]);
        }
    } else {
        print "$line[1]\n";
    }
    @line = &nextLine();
}

sub fail
{
    local($message,$lineNumber) = @_;

    if (@_ == 2) {
        print STDERR "***** Roast error at line $lineNumber. $message\n";
    } else {
        print STDERR "***** Roast error. $message\n";
    }
    exit(-1);
}

sub excMonitor
{
    local($startLine) = @_;
    local($expExc,$excType,$state) = (undef,undef,"code");

    &genHeader($startLine,$EXCMONITOR);
    &genTry();

    @line = &nextLine();
    while ($line[0] ne "eof") {
        if ($state eq "code") {
            if ($line[0] eq "roast") {
                if ($line[1] eq $SEPARATOR) {
                    $state = "expExc";
                    &genCatch();
                } elsif ($line[1] eq $END) {
                    &genCatch();
                    &genCompareExc($startLine,$expExc,$EXCEPTIONTYPE);
                    &genFooter();
                    return;
                } else {
                    &fail("Unexpected keyword.",$line[2]);
                }
            } else {
                print "$line[1]\n"
            }
        } elsif ($state eq "expExc") {
            if ($line[0] eq "roast") {
                if ($line[1] eq $SEPARATOR) {
                    if ($expExc eq undef) {
                        &fail("Missing expected exception.",$line[2]);
                    }
                    $state = "excType";
                } elsif ($line[1] eq $END) {
                    if ($expExc eq undef) {
                        &fail("Missing expected exception.",$line[2]);
                    }
                    &genCompareExc($startLine,$expExc,$EXCEPTIONTYPE);
                    &genFooter();
                    return;
                } else {
                    &fail("Unexpected keyword.",$line[2]);
                }
            } else {
                if ($expExc eq undef) {
                    $expExc = $line[1];
                } else {
                    $expExc .= " " . $line[1];
                }
            }
        } elsif ($state eq "excType") {
            if ($line[0] eq "roast") {
                if ($line[1] eq $SEPARATOR) {
                    if ($excType eq undef) {
                        &fail("Missing exception type.",$line[2]);
                    }
                    $state = "excType";
                } elsif ($line[1] eq $END) {
                    if ($excType eq undef) {
                        &fail("Missing exception type.",$line[2]);
                    }
                    &genCompareExc($startLine,$expExc,$excType);
                    &genFooter();
                    return;
                } else {
                    &fail("Unexpected keyword.",$line[2]);
                }
            } else {
                if ($excType eq undef) {
                    $excType = $line[1];
                } else {
                    $excType .= "\n" . $line[1];
                }
            }
        } else {
            &fail("Roast internal error ($EXCMONITOR).",$line[2]);
        }
        @line = &nextLine();
    }
    &fail("End of file reached before keyword $END",$line[2]);
}

sub valueCheck
{
    local($startLineCount) = @_;
    local($actVal,$expVal,$type,$state) = (undef,undef,undef,"act");

    @line = &nextLine();
    while ($line[0] ne "eof") {
        if ($state eq "act") {
            if ($line[0] eq "roast") {
                if ($line[1] eq $SEPARATOR) {
                    if ($actVal eq undef) {
                        &fail("Missing actual value.",$line[2]);
                    }
                    $state = "exp";
                } else {
                    &fail("$SEPARATOR expected.",$line[2]);
                }
            } else {
                if ($actVal eq undef) {
                    $actVal = $line[1];
                } else {
                    $actVal .= "\n" . $line[1];
                }
            }
        } elsif ($state eq "exp") {
            if ($line[0] eq "roast") {
                if ($line[1] eq $SEPARATOR) {
                    if ($expVal eq undef) {
                        &fail("Expected value missing.",$line[2]);
                    }
                    $state = "type";
                } elsif ($line[1] eq $END) {
                    if ($expVal eq undef) {
                        &fail("Expected value missing.",$line[2]);
                    }
                    &genHeader
                        ($startLineCount,$VALUECHECK);
                    &genTry();
                    &genCompareValue
                        ($startLineCount,
                        $actVal,$expVal,$type);
                    &genCatch();
                    &genCompareExc($startLineCount,undef,$EXCEPTIONTYPE);
                    &genFooter();
                    return;
                } else {
                    &fail("$SEPARATOR or $END expected.",$line[2]);
                }
            } else {
                if ($expVal eq undef) {
                    $expVal = $line[1];
                } else {
                    $expVal .= "\n" . $line[1];
                }
            }
        } elsif ($state eq "type") {
            if ($line[0] eq "roast") {
                if ($line[1] eq $END) {
                    if ($type eq undef) {
                        &fail("Missing type.",$line[2]);
                    }
                    $state = "exp";
                    &genHeader
                        ($startLineCount,$VALUECHECK);
                    &genTry();
                    &genCompareValue
                        ($startLineCount,
                        $actVal,$expVal,$type);
                    &genCatch();
                    &genCompareExc($startLineCount,undef,$EXCEPTIONTYPE);
                    &genFooter();
                    return;
                } else {
                    &fail("$END expected.",$line[2]);
                }
            } else {
                # MORE NEEDED: better check on $type
                $s = trim($line[1]);
                if ($s ne undef) {
                    if ($type eq undef) {
                        $type = $s;
                    } else {
                        &fail("Multiple exceptions.",$line[2]);
                    }
                }
            }
        } else {
            &fail("Roast internal error ($VALUECHECK).",$line[2]);
        }

        @line = &nextLine();
    }
    &fail("End of file reached before keyword $END",$line[2]);
}

sub genHeader
{
    local($lineNumber,$caseType) = @_;

    local(@s) = (
    qq[{ // ***** Test case start *******************************],
    qq[  // ***** Case type: $caseType. Script line number $lineNumber.],
    qq[  // *****************************************************],
    qq[Roast.totalCaseCount++;],
    );

    for ($i = 0; $i < @s; $i++) {
        print "$s[$i]\n";
    }
}

sub genFooter
{
    print "} // ***** test case end\n";
}

sub genTry
{
    local($lineNumber) = @_;

    local(@s) = (
    qq[Object ${ROASTPREFIX}ActExc = null;],
    qq[try {],
    );

    for ($i = 0; $i < @s; $i++) {
        print "$s[$i]\n";
    }
}

sub genCatch
{
    local(@s) = (
    qq[} catch (Throwable ${ROASTPREFIX}Exc) {],
    qq[\t${ROASTPREFIX}ActExc = ${ROASTPREFIX}Exc;],
    qq[}]
    );

    for ($i = 0; $i < @s; $i++) {
        print "$s[$i]\n";
    }
}

sub genCompareExc
{
    local($lineNumber,$expExc,$excType) = @_;

    if ($expExc eq undef) {
        $expExc = qq[null];
    }

    local(@s) = (
    qq[if (!$excType.compareExc(${ROASTPREFIX}ActExc,$expExc)) {],
    qq[\t$excType.printExc($lineNumber,${ROASTPREFIX}ActExc,$expExc);],
    qq[}],
    );

    for ($i = 0; $i < @s; $i++) {
        print "$s[$i]\n";
    }
}

sub genCompareValue
{
    local($lineNumber,$actVal,$expVal,$type) = @_;
    local($valueType);

    if ($type eq undef) {
        $type = $VALUETYPE;
    }

    local(@s) = (
    qq[\t\tif (!$type.compareValue($actVal,$expVal)) {],
    qq[\t\t\t$type.printValue($lineNumber,$actVal,$expVal);],
    qq[\t\t}]
    );

    for ($i = 0; $i < @s; $i++) {
        print "$s[$i]\n";
    }
}

# nextLine()
#    extract the next line from STDIN
#
#    insert newlines as needed to place each Roast delimiter
#        on a line of its own
#
#    increment $lineCount for each physical line
#
#    return (type,value,lineNum) where
#        type: "roast", "normal", or "eof"
#        value: the line, or "" for "eof"
#        lineNum: the physical line number on which the line occurred
sub nextLine
{
    # refill buffer if empty
    if ($lineBuf eq undef) {
        if (eof(STDIN)) {
            return ("eof","",$lineCount);
        }
        $lineCount++;
        $lineBuf = <STDIN>;
        chop $lineBuf;
    }

    # extract next line
    if ($lineBuf =~ /#/) { # Roast delimiter present
        $pre = $`;
        $post = $';

        # non-whitespace before delimiter? if so return it
        if (!($pre =~ /^\s*$/)) {
            $lineBuf = "#" . $post;
            return ("normal",$pre,$lineCount);
        }

        # extract keyword and return it
        $post =~ /^([a-zA-Z]*)\s*(.*)/;
        if ($2 eq undef) {
            $lineBuf = undef;
        } else {
            $lineBuf = $2;
        }
        return ("roast","#" . $1,$lineCount);
    } else { # no Roast delimiter in this line: return it as is
        $tmpBuf = $lineBuf;
        $lineBuf = undef;
        return ("normal",$tmpBuf,$lineCount);
    }
}

# trim(s) returns s with leading and trailing whitespace removed
# if there is nothing but whitespace in s, return undef
# assumed: s has no whitespace between the first and last non-whitespace
sub trim
{
    local($s) = @_;

    $s =~ /^\s*([^\s]+)\s*$/;
    return $1;
}
