From: Martin Mares <mj@ucw.cz>
Date: Thu, 17 Oct 2013 13:47:47 +0000 (+0200)
Subject: Tester: Support here-documents
X-Git-Tag: v5.99~76
X-Git-Url: http://mj.ucw.cz/gitweb/?a=commitdiff_plain;h=1a12d2794abaced3d0cd0dd0b858981e3f49c830;p=libucw.git

Tester: Support here-documents
---

diff --git a/build/tester b/build/tester
index ea1a6a31..0fdbeb9f 100755
--- a/build/tester
+++ b/build/tester
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 # A simple unit testing script
-# (c) 2004--2007 Martin Mares <mj@ucw.cz>
+# (c) 2004--2013 Martin Mares <mj@ucw.cz>
 # (c) 2007 Pavel Charvat <pchar@ucw.cz>
 
 # Tests in the test file have a syntax similar to mail headers,
@@ -18,6 +18,14 @@
 #		Both In<N> and Out<N> can be specified simultaneously if we
 #		are testing a program which modifies some of its input files.
 #	Exit:	expected exit code of the program (default: 0)
+#
+# A value of a field can be optionally given as a shell-style here-document:
+#
+#	In <<AMEN
+#	multiple
+#	lines
+#	of input
+#	AMEN
 
 use Getopt::Long;
 
@@ -46,6 +54,20 @@ while (<>) {
 		($tt->{$n}) && die "$n already defined";
 		$tt->{$n} = $v;
 		$append_to = \($tt->{$n});
+	} elsif (my ($n,$sep) = /^(\w+)\s*<<(\w+)\s*$/) {
+		if (!$tt) {
+			$tt = {};
+			push @tests, $tt;
+		}
+		($tt->{$n}) && die "$n already defined";
+		$tt->{$n} = "";
+		$sep .= "\n";
+		while (1) {
+			my $line = <>;
+			defined $line or die "Here-document not terminated";
+			last if $line eq $sep;
+			$tt->{$n} .= $line;
+		}
 	} else {
 		die "Test script syntax error";
 	}