Integrate with mainperl.

p4raw-id: //depot/cfgperl@3576

5 files changed, 104 insertions, 28 deletions

diff --git a/t/io/openpid.t b/t/io/openpid.t
new file mode 100755
index 0000000000..2d3ac9f32f
--- /dev/null
+++ b/t/io/openpid.t
@@ -0,0 +1,78 @@
+
+#!./perl
+
+#####################################################################
+#
+# Test for process id return value from open
+# Ronald Schmidt (The Software Path) RonaldWS@software-path.com
+#
+#####################################################################
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+
+use FileHandle;
+autoflush STDOUT 1;
+$SIG{PIPE} = 'IGNORE';
+
+print "1..10\n";
+
+$perl = "$^X -I../lib";
+
+#
+# commands run 4 perl programs.  Two of these programs write a
+# short message to STDOUT and exit.  Two of these programs
+# read from STDIN.  One reader never exits and must be killed.
+# the other reader reads one line, waits a few seconds and then
+# exits to test the waitpid function.
+#
+$cmd1 = qq/$perl -e "use FileHandle; autoflush STDOUT 1; / .
+        qq/print qq[first process\\n]; sleep 30;"/;
+$cmd2 = qq/$perl -e "use FileHandle; autoflush STDOUT 1; / .
+        qq/print qq[second process\\n]; sleep 30;"/;
+$cmd3 = qq/$perl -e "print <>;"/; # hangs waiting for end of STDIN
+$cmd4 = qq/$perl -e "print scalar <>;"/;
+
+#warn "#$cmd1\n#$cmd2\n#$cmd3\n#$cmd4\n";
+
+# start the processes
+$pid1 = open(FH1, "$cmd1 |") or print "not ";
+print "ok 1\n";
+$pid2 = open(FH2, "$cmd2 |") or print "not ";
+print "ok 2\n";
+$pid3 = open(FH3, "| $cmd3") or print "not ";
+print "ok 3\n";
+$pid4 = open(FH4, "| $cmd4") or print "not ";
+print "ok 4\n";
+
+print "# pids were $pid1, $pid2, $pid3, $pid4\n";
+
+# get message from first process and kill it
+chomp($from_pid1 = scalar(<FH1>));
+print "# child1 returned [$from_pid1]\nnot "
+    unless $from_pid1 eq 'first process';
+print "ok 5\n";
+$kill_cnt = kill STOP, $pid1;
+print "not " unless $kill_cnt == 1;
+print "ok 6\n";
+
+# get message from second process and kill second process and reader process
+chomp($from_pid2 = scalar(<FH2>));
+print "# child2 returned [$from_pid2]\nnot "
+    unless $from_pid2 eq 'second process';
+print "ok 7\n";
+$kill_cnt = kill STOP, $pid2, $pid3;
+print "not " unless $kill_cnt == 2;
+print "ok 8\n";
+
+# send one expected line of text to child process and then wait for it
+autoflush FH4 1;
+print FH4 "ok 9\n";
+print "# waiting for process $pid4 to exit\n";
+$reap_pid = waitpid $pid4, 0;
+print "# reaped pid $reap_pid != $pid4\nnot "
+    unless $reap_pid == $pid4;
+print "ok 10\n";
diff --git a/t/lib/cgi-form.t b/t/lib/cgi-form.t
index 83217a2070..e3cba5fc20 100755
--- a/t/lib/cgi-form.t
+++ b/t/lib/cgi-form.t
@@ -44,16 +44,16 @@ test(6,textfield(-name=>'weather') eq qq(<INPUT TYPE="text" NAME="weather" VALUE
 test(7,textfield(-name=>'weather',-value=>'nice') eq qq(<INPUT TYPE="text" NAME="weather" VALUE="dull">),"textfield({-name,-value})");
 test(8,textfield(-name=>'weather',-value=>'nice',-override=>1) eq qq(<INPUT TYPE="text" NAME="weather" VALUE="nice">),
      "textfield({-name,-value,-override})");
-test(9,checkbox(-name=>'weather',-value=>'nice') eq qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice">weather\n),
+test(9,checkbox(-name=>'weather',-value=>'nice') eq qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice">weather),
      "checkbox()");
 test(10,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast') eq 
-     qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice">forecast\n),
+     qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice">forecast),
      "checkbox()");
 test(11,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast',-checked=>1,-override=>1) eq 
-     qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice" CHECKED>forecast\n),
+     qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice" CHECKED>forecast),
      "checkbox()");
 test(12,checkbox(-name=>'weather',-value=>'dull',-label=>'forecast') eq 
-     qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="dull" CHECKED>forecast\n),
+     qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="dull" CHECKED>forecast),
      "checkbox()");
 
 test(13,radio_group(-name=>'game') eq 
diff --git a/t/lib/cgi-html.t b/t/lib/cgi-html.t
index 3fe41d170a..d4c9c1b7a7 100755
--- a/t/lib/cgi-html.t
+++ b/t/lib/cgi-html.t
@@ -10,9 +10,6 @@ BEGIN {
 }
 
 BEGIN {$| = 1; print "1..20\n"; }
-BEGIN {$eol = "\n"   if $^O eq 'VMS';
-       $eol = "\r\n" if $Config{ebcdic} eq 'define';
-       $eol = "\cM\cJ" unless defined $eol; }
 END {print "not ok 1\n" unless $loaded;}
 use CGI (':standard','-no_debug','*h3','start_table');
 $loaded = 1;
@@ -40,10 +37,10 @@ test(7,h1({-align=>'CENTER'},['fred','agnes']) eq
     local($") = '-'; 
     test(8,h1('fred','agnes','maura') eq '<H1>fred-agnes-maura</H1>',"open/close tag \$\" interpolation");
 }
-test(9,header() eq "Content-Type: text/html${eol}${eol}","header()");
-test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${eol}${eol}","header()");
-test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${eol}Content-Type: image/gif${eol}${eol}","header()");
-test(12,header(-nph=>1) eq "HTTP/1.0 200 OK${eol}Content-Type: text/html${eol}${eol}","header()");
+test(9,header() eq "Content-Type: text/html\015\012\015\012","header()");
+test(10,header(-type=>'image/gif') eq "Content-Type: image/gif\015\012\015\012","header()");
+test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks\015\012Content-Type: image/gif\015\012\015\012","header()");
+test(12,header(-nph=>1) eq "HTTP/1.0 200 OK\015\012Content-Type: text/html\015\012\015\012","header()");
 test(13,start_html() ."\n" eq <<END,"start_html()");
 <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
 <HTML><HEAD><TITLE>Untitled Document</TITLE>
@@ -63,8 +60,8 @@ test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
 END
     ;
 test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 
-     'fred=chocolate&chip; path=/',"cookie()");
-test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${eol}Date:.*${eol}Content-Type: text/html${eol}${eol}!s,
+     'fred=chocolate&chip; domain=localhost; path=/',"cookie()");
+test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; domain=localhost; path=/\015\012Date:.*\015\012Content-Type: text/html\015\012\015\012!s,
      "header(-cookie)");
 test(18,start_h3 eq '<H3>');
 test(19,end_h3 eq '</H3>');
diff --git a/t/lib/cgi-request.t b/t/lib/cgi-request.t
index 2a6f3fb906..9e8cdc290a 100755
--- a/t/lib/cgi-request.t
+++ b/t/lib/cgi-request.t
@@ -25,15 +25,16 @@ sub test {
 }
 
 # Set up a CGI environment
-$ENV{REQUEST_METHOD}='GET';
-$ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
-$ENV{PATH_INFO}     ='/somewhere/else';
-$ENV{PATH_TRANSLATED} ='/usr/local/somewhere/else';
-$ENV{SCRIPT_NAME}   ='/cgi-bin/foo.cgi';
+$ENV{REQUEST_METHOD}  = 'GET';
+$ENV{QUERY_STRING}    = 'game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO}       = '/somewhere/else';
+$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME}     = '/cgi-bin/foo.cgi';
 $ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
-$ENV{SERVER_PORT} = 8080;
-$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
-$ENV{HTTP_LOVE} = 'true';
+$ENV{SERVER_PORT}     = 8080;
+$ENV{SERVER_NAME}     = 'the.good.ship.lollypop.com';
+$ENV{REQUEST_URI}     = "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}";
+$ENV{HTTP_LOVE}       = 'true';
 
 $q = new CGI;
 test(2,$q,"CGI::new()");
diff --git a/t/pragma/warn/op b/t/pragma/warn/op
index c72534a15f..a07a837ffb 100644
--- a/t/pragma/warn/op
+++ b/t/pragma/warn/op
@@ -87,13 +87,13 @@
      (Maybe you meant system() when you said exec()?
  	exec "true" ; my $a
 
-     defined(@array) is deprecated (and not really meaningful)
+     defined(@array) is deprecated
      (Maybe you should just omit the defined()?)
 	defined @a ;
 	my @a ; defined @a ;
 	defined (@a = (1,2,3)) ;
 
-     defined(%hash) is deprecated (and not really meaningful)
+     defined(%hash) is deprecated
      (Maybe you should just omit the defined()?)
 	defined %h ;
 	my %h ; defined %h ;
@@ -558,33 +558,33 @@ Statement unlikely to be reached at - line 4.
 use warning 'deprecated' ;
 defined(@a);
 EXPECT
-defined(@array) is deprecated (and not really meaningful) at - line 3.
+defined(@array) is deprecated at - line 3.
 (Maybe you should just omit the defined()?)
 ########
 # op.c
 use warning 'deprecated' ;
 my @a; defined(@a);
 EXPECT
-defined(@array) is deprecated (and not really meaningful) at - line 3.
+defined(@array) is deprecated at - line 3.
 (Maybe you should just omit the defined()?)
 ########
 # op.c
 use warning 'deprecated' ;
 defined(@a = (1,2,3));
 EXPECT
-defined(@array) is deprecated (and not really meaningful) at - line 3.
+defined(@array) is deprecated at - line 3.
 (Maybe you should just omit the defined()?)
 ########
 # op.c
 use warning 'deprecated' ;
 defined(%h);
 EXPECT
-defined(%hash) is deprecated (and not really meaningful) at - line 3.
+defined(%hash) is deprecated at - line 3.
 (Maybe you should just omit the defined()?)
 ########
 # op.c
 use warning 'deprecated' ;
 my %h; defined(%h);
 EXPECT
-defined(%hash) is deprecated (and not really meaningful) at - line 3.
+defined(%hash) is deprecated at - line 3.
 (Maybe you should just omit the defined()?)