Basic automated testing framework

PerlRPG/Console.pm

@@ -16,6 +16,7 @@ use constant {
 	ERROR	=> 5,
 	CRIT	=> 6,
 	FATAL	=> 7,
+	NOLOG	=> 99,
 };
 my @debugnames=qw/DEVALL DEBUG INFO STATUS WARN ERROR CRIT FATAL/;
 $StackTraceLevel = ERROR;

PerlRPG/Script.pm

@@ -13,7 +13,7 @@ use PerlRPG::Drawing;
 
 use vars qw/@ISA @EXPORT @EXPORT_OK/;
 @ISA = qw/Exporter/;
-@EXPORT = qw/CompileScripts RunScript RunScriptTick GetGameVar SetGameVar DefGameVar/;
+@EXPORT = qw/CompileScripts RunScript RunScriptTick GetGameVar SetGameVar DefGameVar EvalString/;
 @EXPORT_OK = @EXPORT;
 
 my %labels;

Tests/Script.pl

@@ -0,0 +1,30 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use PerlRPG::Console;
+use PerlRPG::Script;
+
+
+use Test::More;
+
+$PerlRPG::Console::LogLevel = ERROR;
+ok( !GetGameVar("TestVar"),				"Undefined GetGameVar should fail");
+ok( !SetGameVar("TestVar"),				"Undefined SetGameVar should fail");
+$PerlRPG::Console::LogLevel = WARN;
+DefGameVar('TestVar', 1);
+ok( GetGameVar("TestVar") == 1,				"Defined GetGameVar should be 1");
+ok( SetGameVar("TestVar", 2) == 2,			"Defined SetGameVar(2) should be 2");
+DefGameVar('TestVar', 1);
+ok( SetGameVar("TestVar", 2) == 2,			"Redefined GameVar=1 should still be 2");
+
+PerlRPG::Script::RunScriptLine("test", 1, "TestVar = TestVar + 1");
+ok( GetGameVar("TestVar")==3,				"RunScriptLine sets TestVar to 3");
+
+ok( PerlRPG::Script::IsString("\"foo\""),		"'\"foo\"' is a string");
+ok( PerlRPG::Script::IsString("foo")==0,		"'foo' is not a string");
+ok( PerlRPG::Script::IsString(5)==0,			"'5' is not a string");
+ok( EvalString("\"[TestVar]\"") eq '3',			"\"[TestVar]\" is 3");
+ok( EvalString("3 + 3") == 6,				"\"3 + 3\" == 6");
+ok( EvalString("lc('FoO') . uc('FoO')") eq 'fooFOO',	"String function test");
+
+done_testing();

runtests.pl

@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+use strict;
+
+$|=1;
+
+my @tests=(<Tests/*.pl>);
+my($longest) = sort { $b <=> $a } map { length($_) } (@tests);
+my $failed=0;
+
+foreach my $test (<Tests/*.pl>) {
+	printf("Running %-*s... ", $longest, $test);
+	my $r = system("$test > /dev/null 2>\&1");
+	if($r) {
+		print "Failed!\n";
+		$failed++;
+	} else {
+		print "OK!\n";
+	}
+}
+
+if($failed) {
+	print "\nFailed $failed tests\n";
+} else {
+	print "\nAll tests passed!\n";
+}