From f6b3007c38a92f48d086a19ea8682dd935b6d4ee Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Sun, 4 Jul 1999 22:39:23 +0000 Subject: Integrate with mainperl. p4raw-id: //depot/cfgperl@3576 --- t/io/openpid.t | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++++ t/lib/cgi-form.t | 8 +++--- t/lib/cgi-html.t | 15 +++++------ t/lib/cgi-request.t | 17 ++++++------ t/pragma/warn/op | 14 +++++----- 5 files changed, 104 insertions(+), 28 deletions(-) create mode 100755 t/io/openpid.t (limited to 't') 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()); +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()); +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('weather',-value=>'nice') eq qq(),"textfield({-name,-value})"); test(8,textfield(-name=>'weather',-value=>'nice',-override=>1) eq qq(), "textfield({-name,-value,-override})"); -test(9,checkbox(-name=>'weather',-value=>'nice') eq qq(weather\n), +test(9,checkbox(-name=>'weather',-value=>'nice') eq qq(weather), "checkbox()"); test(10,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast') eq - qq(forecast\n), + qq(forecast), "checkbox()"); test(11,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast',-checked=>1,-override=>1) eq - qq(forecast\n), + qq(forecast), "checkbox()"); test(12,checkbox(-name=>'weather',-value=>'dull',-label=>'forecast') eq - qq(forecast\n), + qq(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 '

fred-agnes-maura

',"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 < Untitled Document @@ -63,8 +60,8 @@ test(15,start_html(-Title=>'The world of foo') ."\n" eq <'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 '

'); test(19,end_h3 eq '

'); 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()?) -- cgit v1.2.1