@@ -12,6 +12,8 @@ our @EXPORT = qw(
1212 restart_test_server
1313 psql
1414 system_or_bail
15+ system_log
16+ run_log
1517
1618 command_ok
1719 command_fails
@@ -24,11 +26,47 @@ our @EXPORT = qw(
2426) ;
2527
2628use Cwd;
29+ use File::Basename;
2730use File::Spec;
2831use File::Temp ();
2932use IPC::Run qw( run start) ;
33+
34+ use SimpleTee;
35+
3036use Test::More;
3137
38+ # Open log file. For each test, the log file name uses the name of the
39+ # file launching this module, without the .pl suffix.
40+ my $log_path = ' tmp_check/log' ;
41+ mkdir ' tmp_check' ;
42+ mkdir $log_path ;
43+ my $test_logfile = basename($0 );
44+ $test_logfile =~ s /\. [^.]+$// ;
45+ $test_logfile = " $log_path /regress_log_$test_logfile " ;
46+ open TESTLOG, ' >' , $test_logfile or die " Cannot open STDOUT to logfile: $! " ;
47+
48+ # Hijack STDOUT and STDERR to the log file
49+ open (ORIG_STDOUT, " >&STDOUT" );
50+ open (ORIG_STDERR, " >&STDERR" );
51+ open (STDOUT , " >&TESTLOG" );
52+ open (STDERR , " >&TESTLOG" );
53+
54+ # The test output (ok ...) needs to be printed to the original STDOUT so
55+ # that the 'prove' program can parse it, and display it to the user in
56+ # real time. But also copy it to the log file, to provide more context
57+ # in the log.
58+ my $builder = Test::More-> builder;
59+ my $fh = $builder -> output;
60+ tie *$fh , " SimpleTee" , *ORIG_STDOUT, *TESTLOG;
61+ $fh = $builder -> failure_output;
62+ tie *$fh , " SimpleTee" , *ORIG_STDERR, *TESTLOG;
63+
64+ # Enable auto-flushing for all the file handles. Stderr and stdout are
65+ # redirected to the same file, and buffering causes the lines to appear
66+ # in the log in confusing order.
67+ autoflush STDOUT 1;
68+ autoflush STDERR 1;
69+ autoflush TESTLOG 1;
3270
3371# Set to untranslated messages, to be able to compare program output
3472# with expected strings.
@@ -73,7 +111,7 @@ sub tempdir_short
73111sub standard_initdb
74112{
75113 my $pgdata = shift ;
76- system_or_bail(" initdb -D ' $pgdata ' -A trust -N >/dev/null " );
114+ system_or_bail(' initdb' , ' -D ' , " $pgdata " , ' -A ' , ' trust' , ' -N ' );
77115 system_or_bail(" $ENV {top_builddir}/src/test/regress/pg_regress" ,
78116 ' --config-auth' , $pgdata );
79117}
@@ -87,14 +125,15 @@ sub start_test_server
87125
88126 my $tempdir_short = tempdir_short;
89127
128+ print (" ### Starting test server in $tempdir \n " );
90129 standard_initdb " $tempdir /pgdata" ;
91- $ret = system ' pg_ctl' , ' -D' , " $tempdir /pgdata" , ' -s ' , ' -w' , ' -l' ,
130+ $ret = system_log( ' pg_ctl' , ' -D' , " $tempdir /pgdata" , ' -w' , ' -l' ,
92131 " $tempdir /logfile" , ' -o' ,
93- " --fsync=off -k $tempdir_short --listen-addresses='' --log-statement=all" ,
94- ' start' ;
95-
132+ " --fsync=off -k \" $tempdir_short \" --listen-addresses='' --log-statement=all" ,
133+ ' start' );
96134 if ($ret != 0)
97135 {
136+ print " # pg_ctl failed; logfile:\n " ;
98137 system (' cat' , " $tempdir /logfile" );
99138 BAIL_OUT(" pg_ctl failed" );
100139 }
@@ -106,28 +145,45 @@ sub start_test_server
106145
107146sub restart_test_server
108147{
109- system ' pg_ctl' , ' -s' , ' -D' , $test_server_datadir , ' -w' , ' -l' ,
110- $test_server_logfile , ' restart' ;
148+ print (" ### Restarting test server\n " );
149+ system_log(' pg_ctl' , ' -D' , $test_server_datadir , ' -w' , ' -l' ,
150+ $test_server_logfile , ' restart' );
111151}
112152
113153END
114154{
115155 if ($test_server_datadir )
116156 {
117- system ' pg_ctl' , ' -D' , $test_server_datadir , ' -s ' , ' -w ' , ' -m' ,
118- ' immediate' , ' stop' ;
157+ system_log( ' pg_ctl' , ' -D' , $test_server_datadir , ' -m' ,
158+ ' immediate' , ' stop' ) ;
119159 }
120160}
121161
122162sub psql
123163{
124164 my ($dbname , $sql ) = @_ ;
165+ print (" # Running SQL command: $sql \n " );
125166 run [ ' psql' , ' -X' , ' -q' , ' -d' , $dbname , ' -f' , ' -' ], ' <' , \$sql or die ;
126167}
127168
128169sub system_or_bail
129170{
130- system (@_ ) == 0 or BAIL_OUT(" system @_ failed: $? " );
171+ if (system_log(@_ ) != 0)
172+ {
173+ BAIL_OUT(" system $_ [0] failed: $? " );
174+ }
175+ }
176+
177+ sub system_log
178+ {
179+ print (" # Running: " . join (" " , @_ ) ." \n " );
180+ return system (@_ );
181+ }
182+
183+ sub run_log
184+ {
185+ print (" # Running: " . join (" " , @{$_ [0]}) ." \n " );
186+ return run (@_ );
131187}
132188
133189
@@ -139,24 +195,22 @@ sub system_or_bail
139195sub command_ok
140196{
141197 my ($cmd , $test_name ) = @_ ;
142- my $result = run $cmd , ' >' , File::Spec-> devnull(), ' 2>' ,
143- File::Spec-> devnull();
198+ my $result = run_log($cmd );
144199 ok($result , $test_name );
145200}
146201
147202sub command_fails
148203{
149204 my ($cmd , $test_name ) = @_ ;
150- my $result = run $cmd , ' >' , File::Spec-> devnull(), ' 2>' ,
151- File::Spec-> devnull();
205+ my $result = run_log($cmd );
152206 ok(!$result , $test_name );
153207}
154208
155209sub command_exit_is
156210{
157211 my ($cmd , $expected , $test_name ) = @_ ;
158- my $h = start $cmd , ' > ' , File::Spec -> devnull(), ' 2> ' ,
159- File::Spec -> devnull() ;
212+ print ( " # Running: " . join ( " " , @{ $cmd }) . " \n " );
213+ my $h = start $cmd ;
160214 $h -> finish();
161215 is($h -> result(0), $expected , $test_name );
162216}
@@ -165,6 +219,7 @@ sub program_help_ok
165219{
166220 my ($cmd ) = @_ ;
167221 my ($stdout , $stderr );
222+ print (" # Running: $cmd --help\n " );
168223 my $result = run [ $cmd , ' --help' ], ' >' , \$stdout , ' 2>' , \$stderr ;
169224 ok($result , " $cmd --help exit code 0" );
170225 isnt($stdout , ' ' , " $cmd --help goes to stdout" );
@@ -175,6 +230,7 @@ sub program_version_ok
175230{
176231 my ($cmd ) = @_ ;
177232 my ($stdout , $stderr );
233+ print (" # Running: $cmd --version\n " );
178234 my $result = run [ $cmd , ' --version' ], ' >' , \$stdout , ' 2>' , \$stderr ;
179235 ok($result , " $cmd --version exit code 0" );
180236 isnt($stdout , ' ' , " $cmd --version goes to stdout" );
@@ -185,7 +241,9 @@ sub program_options_handling_ok
185241{
186242 my ($cmd ) = @_ ;
187243 my ($stdout , $stderr );
188- my $result = run [ $cmd , ' --not-a-valid-option' ], ' >' , \$stdout , ' 2>' , \$stderr ;
244+ print (" # Running: $cmd --not-a-valid-option\n " );
245+ my $result = run [ $cmd , ' --not-a-valid-option' ], ' >' , \$stdout , ' 2>' ,
246+ \$stderr ;
189247 ok(!$result , " $cmd with invalid option nonzero exit code" );
190248 isnt($stderr , ' ' , " $cmd with invalid option prints error message" );
191249}
@@ -194,6 +252,7 @@ sub command_like
194252{
195253 my ($cmd , $expected_stdout , $test_name ) = @_ ;
196254 my ($stdout , $stderr );
255+ print (" # Running: " . join (" " , @{$cmd }) . " \n " );
197256 my $result = run $cmd , ' >' , \$stdout , ' 2>' , \$stderr ;
198257 ok($result , " @$cmd exit code 0" );
199258 is($stderr , ' ' , " @$cmd no stderr" );
@@ -203,9 +262,8 @@ sub command_like
203262sub issues_sql_like
204263{
205264 my ($cmd , $expected_sql , $test_name ) = @_ ;
206- my ($stdout , $stderr );
207265 truncate $test_server_logfile , 0;
208- my $result = run $cmd , ' > ' , \ $stdout , ' 2> ' , \ $stderr ;
266+ my $result = run_log( $cmd ) ;
209267 ok($result , " @$cmd exit code 0" );
210268 my $log = ` cat '$test_server_logfile '` ;
211269 like($log , $expected_sql , " $test_name : SQL found in server log" );
0 commit comments