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