#!/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