#!/usr/bin/perl

# Purpose: 
#   Generates Assert/Fail macros for use with check.
#
# Usage:
#   make_macros macros.in > macros.h
# 
# macros.in: one or more lines containing...
#   Assert
#   Assert_(|not)(Success|Error|Failure|NULL|True|False|Same)
#   Fail_(if|unless)(Success|Error|Failure|NULL|True|False|Same)
#   Assert_(|not)(0[0-7]+|0x[0-9A-Fa-f]+|0b[01]+|[1-9][0-9]+)
#   Fail_(if|unless)(0[0-7]+|0x[0-9A-Fa-f]+|0b[01]+|[1-9][0-9]+)
#   Assert_(|not)(LT|LE|EQ|GE|GT|NE)
#   Fail_(if|unless)(LT|LE|EQ|GE|GT|NE)
#   Assert_(|not){Type}(LT|LE|EQ|GE|GT|NE)
#   Fail_(if|unless){Type}(LT|LE|EQ|GE|GT|NE)
#   {Type}_compare
#
# Example:
#   echo -e 'Assert_notNULL\nAssertStringEQ' | make_macros > macros.h
#
#   #include "macros.h"
#          ...
#   char *foo;
#   Assert_notNULL( foo = strdup( "foo" ) , NULL );
#   Assert_StringEQ( foo, "foo", NULL );
#
# author: unknown... if you know, please correct or email check-devel

use warnings;
use strict;

use Switch 'Perl6';
use Text::Wrap;

our %need;
our %include;
our %macros;

sub make_macro {
    my ($name, $fh) = @_;
    my ($condition) = $name;
    
    my ($failIf, $failUnless, $assertNot, $assert);
    for ($condition) {
        $failIf     = 1, next if s/^ Fail_ if     ([A-Z0-9]?) /$1/x;
        $failUnless = 1, next if s/^ Fail_ unless ([A-Z0-9]?) /$1/x;
        $assertNot  = 1, next if s/^ Assert_ not  ([A-Z0-9] ) /$1/x;
        $assert     = 1, next if s/^ Assert_      (.        ) /$1/x;
        $assert     = 1, next if s/^ Assert                  $//x;
        print $fh "#error don't know how to make ${name}\n\n";
        return;
    }
    
    my ($invert) = 0;
    foreach ($failIf, $assertNot) {
    	$invert = !$invert if $_;
    }
    
    my $type = "";
    if ($condition =~ s/(LT|LE|EQ|GE|GT|NE)$//) {
        $type = $condition;
        $condition = $1;
    }
    $type = "Number" unless length $type;
    
    my (@args) = qw( expr );
    my ($expr) = qw( (expr) );
    my ($msg);
    my ($doc);
    my (%argdocs) = (
        expr => "The expression to test."
    );
    
    my ($not)  = sub { $invert ? "not " :     "" };
    my ($Not)  = sub { $invert ?     "" : "not " };
    my ($EQ)   = sub { $invert ? "!=" : "==" };
    my ($NE)   = sub { $invert ? "==" : "!=" };

    given ($condition) {
        when "" {
            unless ( $invert ) {
                $doc = "Asserts that \@p expr is true.";
                $msg = "Assertion '\"#expr\"' failed.";
            } else {
                $doc = "Asserts that \@p expr is false.";
                $msg = "Negative assertion '\"#expr\"' failed";
            }
        }
        when [qw(Error error Failure failure Success success)] {
            $invert = !$invert when [qw(Success success)];
            unless ( $invert ) {
                $doc = "Asserts that \@p expr failed.";
                $msg = "'\"#expr\"' did not fail";
            } else {
                $doc = "Asserts that \@p expr did not fail.";
                $msg = "'\"#expr\"' failed";
            }
            $invert = !$invert;
        }
        when [qw(True true False false)] {
            $invert = !$invert when "false";
            $doc = "Asserts that \@p expr is ".( $invert ? "false" : "true" ).".";
            $msg = "'\"#expr\"' was " . ( $invert ? "true" : "false" );
        }
        when "NULL" {
            $msg = "'\"#expr\"' was ".&$Not."NULL";
            $doc = "Asserts that \@p expr is ".&$not."NULL";
            $expr = "(expr) ".&$EQ." NULL";
            $invert = 0;
            $include{"stddef.h"} = 1;
        }
        when m/^(?:[1-9]\d*|0x[0-9A-Fa-f]+|0b[01]+|0[0-7]+)$/x {
            $msg = "'\"#expr\"' was ".&$Not."equal to $condition";
            $doc = "Asserts that \@p expr is ".&$not."equal to $condition.";
            $condition = oct($condition) if $condition =~ /^0/;
            $expr = "(expr) ".&$EQ." $condition";
            $invert = 0;
        }
        when [qw(GT GE LT LE EQ NE Equal equal)] {
            my $op;
            given ( $condition ) {
              $op = [ "less than"                 , "<"  ] when "LT";
              $op = [ "less than that or equal to", "<=" ] when "LE";
              $op = [ "equal to"                  , "==" ] when ["EQ", "Equal", "equal", "NE"];
              $op = [ "greater than or equal to"  , ">=" ] when "GE";
              $op = [ "greater than"              , ">"  ] when "GT";
            };
            $invert = !$invert when "NE";
            @args = ( $type."1", $type."2" );
            %argdocs = (
                $type."1" => "The expression to test.",
                $type."2" => "The test value."
            );
            $msg = "'\"#$args[0]\"' is ".&$Not.$op->[0]." '\"#$args[1]\"'";
            $doc = "Asserts that \@p $args[0] is ".&$not.$op->[0]." \@p $args[1].";
            $expr = "(${type}_compare( $args[0], $args[1] ) ".$op->[1]." 0)";
            $need{$type."_compare"} = 1;
        }
        when [qw(Same same)] {
            @args = qw( arg1 arg2 );
            %argdocs = (
                arg1 => "The expression to test.",
                arg2 => "The expected value."
            );
            $msg = "'\"#arg1\"' and '\"#arg2\"' are ".&$Not."the same";
            $msg = "Asserts that \@p arg1 and \@p arg2 are ".&$not."the same";
            $expr = "(arg1) ".&$EQ." (arg2)";
            $invert = 0;
        }
        default {
            print $fh "#error don't know how to make ${name}\n\n";
            return;
        }
    }

    if ($invert) {
        $expr = "!$expr";
    }

    if ($doc) {
        print $fh "/**\n";
        print $fh wrap(" * "," * ","$doc\n");
        my ($maxlength) = 3;
        foreach (keys %argdocs) {
            $maxlength = length $_ if length $_ > $maxlength;
        }
        my ($indent) = " " x ($maxlength + 1 + 7);
        foreach (keys %argdocs) {
            print $fh wrap(" * ",
                           " * $indent",
                          "\@param $_ ".(" " x ($maxlength - length $_)).
                          "$argdocs{$_}\n");
        }
        print $fh wrap(" * ",
                       " * $indent",
                       "\@param ... ".(" " x ($maxlength - 3)).
                       "An optional message to indicate the assertion failed; ".
                       "Omit for a default message.\n");

        print $fh " */\n";
    }
    print $fh "#define ${name}(",(join ", ", @args, '...'),") \\\n";
    print $fh "    _ck_assert_msg( $expr, __FILE__, __LINE__, \\\n";
    print $fh "                  \"$msg\", ## __VA_ARGS__, NULL)\n";
    print $fh "\n";
    
    $macros{$name} = 1;
}

sub make_compare {
    my ($name, $fh) = @_;
    my ($type) = $name;
    $type =~ s/_compare$//;

    my ($expr);
    my ($warning);
    my ($ord);
    my (@name) = ( "", "" );

    given ($type) {
        when "Number" {
            $expr = "( ${type}1 - ${type}2 )";
            $ord = "is";
        }
        when "String" {
            $expr = "strcmp( ${type}1, ${type}2 )";
            $include{"string.h"} = 1;
            $ord = "is";
        }
        default {
            $expr = "memcmp( ${type}1, ${type}2, sizeof( ${type} ) )";
            $include{"string.h"} = 1;
            $ord = "are";
            @name = ( "'s bytes ", "'s" );
            $warning = "This compares \@p ${type}1 and \@p ${type}2 "
                     . "byte-for-byte, this is probably not what you want "
                     . "for all but the simplest of structures.";
        }
    }

    print $fh "/**\n";
    print $fh " * Compares \@p ${type}1 and \@p ${type}2.\n";
    print $fh wrap(" * "," * ",$warning . "\n") if $warning;
    print $fh " * \@param ${type}1 The first ${type}.\n";
    print $fh " * \@param ${type}2 The second ${type}.\n";
    my (%val_name) = (
        ">0" => "greater than",
        "0 " => "equal to",
        "<0" => "less than",
    );
    while (my ($val, $name) = each %val_name) {
        print $fh " * \@retval $val If \@p ${type}1 $name[0]$ord $name \@p ${type}2 $name[1].\n";
    }
    print $fh " */\n";
    print $fh "#define ${type}_compare(${type}1, ${type}2) \\\n";
    print $fh "    $expr\n";
    print $fh "\n";
    $macros{$name} = 1;
}

my $INCLUDES = '';
open my $includes, ">", \$INCLUDES or die;

my $MACROS = '';
open my $macros, ">", \$MACROS or die;

my $MACROS2 = '';
open my $macros2, ">", \$MACROS2 or die;

while (<>) {
    chomp;
    make_macro( $_, $macros2 ) if /^(?:Assert|Fail)/;
    make_compare( $_, $macros ) if /_compare$/;
}

foreach my $need (keys %need) {
    given ($need) {
        when /^(?:String|Number)_compare$/ {
            make_compare( $need, $macros );
            delete $need{$need};
        }
    }
}

foreach my $macro (keys %macros) {
    delete $need{$macro};
}

if (scalar %need) {
    print $includes "/* needed functions/macros:\n";
    foreach my $need (keys %need) {
        if ($need =~ /^(.*)_compare$/) {
            print $includes " * int $need(${1}1,${1}2);\n";
        } else {
            print $includes " * $need\n";
        }
    }
    print $includes " */\n\n";
}

foreach my $include (keys %include) {
    print $includes "#include <$include>\n";
}

print <<'END';
#ifndef _CHECK_MACROS_H
#define _CHECK_MACROS_H

END
print $INCLUDES;
print "\n";
print $MACROS;
print $MACROS2;
print <<'END';

#endif /* _CHECK_MACROS_H */
END