From a75789c4fd2160030d62a93795d10284df5233d5 Mon Sep 17 00:00:00 2001 From: Ludovic Tolhurst-Cleaver Date: Fri, 31 Oct 2025 22:53:40 +0000 Subject: [PATCH 1/4] Directory and test for yes script with forking. Runs yes as child process with parent reading ten lines. May be run on alternative yes programs for comparison. --- t/yes/yes | 47 +++++++++++++++++++++++++++++++++++++++++++++++ t/yes/yes.t | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 100 insertions(+) create mode 100644 t/yes/yes create mode 100644 t/yes/yes.t diff --git a/t/yes/yes b/t/yes/yes new file mode 100644 index 00000000..7bfd2365 --- /dev/null +++ b/t/yes/yes @@ -0,0 +1,47 @@ +#!/usr/bin/env perl + +# tryout script for running PPT's 'yes' in a child process +# and reading from it without blocking + +use strict; +use warnings; + +$|++; # autoflush both processes (superfluous?) + +my ($pid, $child); + +# default path to yes from PPT Git repo root +my $default_ppt_yes = './bin/yes'; + +# Update path to PPT yes if different to default, +# or to compare with other yes implementations, +# e.g. /usr/bin/yes. +my $ppt_yes_path = defined($ARGV[0]) ? $ARGV[0] : $default_ppt_yes; + +die "Can't find 'yes' script at $ppt_yes_path\n" + unless (-e $ppt_yes_path && -f $ppt_yes_path); + +# fork and run yes in child process via open '-|' +if ($pid = open($child, '-|', $ppt_yes_path)) { + # PARENT PROCESS + # run parent code, reading from child + print "Parent PID: $$\nChild PID: $pid\n"; + + my @lines; + for (1..10) { + # NOTE <> must be called in scalar context to prevent blocking. + my $line = <$child>; + push @lines, $line; + } + # Set output field separator to empty string + # to prevent outdenting of all but first 'y'. + local $" = ''; + print "Child Output:-\n@lines"; + + close($child); # apparently gratuitous +} else { + die "cannot fork:$!\n" unless defined $pid; + # CHILD PROCESS + exit; # apparently gratuitous +} + diff --git a/t/yes/yes.t b/t/yes/yes.t new file mode 100644 index 00000000..e02ea87f --- /dev/null +++ b/t/yes/yes.t @@ -0,0 +1,53 @@ +use strict; +use warnings; + +use File::Spec; +use Test::More; + +$|++; # autoflush both processes (superfluous?) + +subtest 'test yes' => sub { + # set default path to yes as seen from PPT root directory + my $yes_path = './bin/yes'; + # Amend path to PPT yes, if required, by setting environment + # variable YESPATH. This may also be used to compare with + # other yes implementations, e.g. at /usr/bin/yes. + if (defined($ENV{YESPATH})) { + $yes_path = $ENV{YESPATH}; + diag "Testing yes at $ENV{YESPATH}"; + } + + ok -e $yes_path && -f $yes_path, "found 'yes' program at $yes_path" + or return; # fail rest of script + + subtest 'fork and run yes in child process' => sub { + SKIP: { + skip "Don't run fork test on Windows", 1 if $^O eq 'MSWin32'; + my ($pid, $child); + if ($pid = open($child, '-|', $yes_path)) { + # PARENT PROCESS + # read ten lines from child + my @lines; + for (1..10) { + # NOTE <> must be called in scalar context to prevent blocking. + my $line = <$child>; + push @lines, $line; + } + + is $lines[0], "y\n", 'first line is "y\n"'; # superfluous? + is scalar(@lines), 10, 'expected no. of output lines (10)'; + my $count_of_ys = grep { /^y$/ } @lines; + note $count_of_ys; + is $count_of_ys, 10, 'all 10 lines contain "y\n" only'; + + close($child); # apparently superfluous + } else { + die "cannot fork:$!\n" unless defined $pid; + # CHILD PROCESS + exit; # apparently superfluous + } + } + }; +}; + +done_testing(); From af51ea425771e4618c7f0fb596da8557554c3170 Mon Sep 17 00:00:00 2001 From: Ludovic Tolhurst-Cleaver Date: Fri, 31 Oct 2025 23:33:47 +0000 Subject: [PATCH 2/4] Added argument test to t/yes/yes.t. --- t/yes/yes.t | 53 ++++++++++++++++++++++++++++++----------------------- 1 file changed, 30 insertions(+), 23 deletions(-) diff --git a/t/yes/yes.t b/t/yes/yes.t index e02ea87f..4e8a98dc 100644 --- a/t/yes/yes.t +++ b/t/yes/yes.t @@ -23,31 +23,38 @@ subtest 'test yes' => sub { subtest 'fork and run yes in child process' => sub { SKIP: { skip "Don't run fork test on Windows", 1 if $^O eq 'MSWin32'; - my ($pid, $child); - if ($pid = open($child, '-|', $yes_path)) { - # PARENT PROCESS - # read ten lines from child - my @lines; - for (1..10) { - # NOTE <> must be called in scalar context to prevent blocking. - my $line = <$child>; - push @lines, $line; - } - - is $lines[0], "y\n", 'first line is "y\n"'; # superfluous? - is scalar(@lines), 10, 'expected no. of output lines (10)'; - my $count_of_ys = grep { /^y$/ } @lines; - note $count_of_ys; - is $count_of_ys, 10, 'all 10 lines contain "y\n" only'; - - close($child); # apparently superfluous - } else { - die "cannot fork:$!\n" unless defined $pid; - # CHILD PROCESS - exit; # apparently superfluous - } + fork_yes($yes_path); + fork_yes($yes_path, 'iluvperl'); } }; }; +sub fork_yes { + my ($yes_path, $yes_str) = @_; + my ($pid, $child); + $yes_str ||= 'y'; + if ($pid = open($child, '-|', "$yes_path $yes_str")) { + # PARENT PROCESS + # read ten lines from child + my @lines; + for (1..10) { + # NOTE <> must be called in scalar context to prevent blocking. + my $line = <$child>; + push @lines, $line; + } + + is $lines[0], "$yes_str\n", "First line is '$yes_str'.\n"; # superfluous? + is scalar(@lines), 10, 'Expected no. of output lines (10).'; + my $count_of_ys = grep { /^$yes_str$/ } @lines; + note $count_of_ys; + is $count_of_ys, 10, "All 10 lines contain '$yes_str' only.\n"; + + close($child); # apparently superfluous + } else { + die "cannot fork:$!\n" unless defined $pid; + # CHILD PROCESS + exit; # apparently superfluous + } +} + done_testing(); From fb7205d7e988f0eeeb0cc61a0654ec66265e6449 Mon Sep 17 00:00:00 2001 From: Ludovic Tolhurst-Cleaver Date: Sat, 1 Nov 2025 18:49:31 +0000 Subject: [PATCH 3/4] Attempted reformat of yes.t to match preferred coding style. --- t/yes/yes.t | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/t/yes/yes.t b/t/yes/yes.t index 4e8a98dc..111f3e83 100644 --- a/t/yes/yes.t +++ b/t/yes/yes.t @@ -15,7 +15,7 @@ subtest 'test yes' => sub { if (defined($ENV{YESPATH})) { $yes_path = $ENV{YESPATH}; diag "Testing yes at $ENV{YESPATH}"; - } + } ok -e $yes_path && -f $yes_path, "found 'yes' program at $yes_path" or return; # fail rest of script @@ -25,9 +25,9 @@ subtest 'test yes' => sub { skip "Don't run fork test on Windows", 1 if $^O eq 'MSWin32'; fork_yes($yes_path); fork_yes($yes_path, 'iluvperl'); - } + } + }; }; -}; sub fork_yes { my ($yes_path, $yes_str) = @_; @@ -41,7 +41,7 @@ sub fork_yes { # NOTE <> must be called in scalar context to prevent blocking. my $line = <$child>; push @lines, $line; - } + } is $lines[0], "$yes_str\n", "First line is '$yes_str'.\n"; # superfluous? is scalar(@lines), 10, 'Expected no. of output lines (10).'; @@ -50,11 +50,12 @@ sub fork_yes { is $count_of_ys, 10, "All 10 lines contain '$yes_str' only.\n"; close($child); # apparently superfluous - } else { + } + else { die "cannot fork:$!\n" unless defined $pid; # CHILD PROCESS exit; # apparently superfluous + } } -} done_testing(); From b597f41f77950fe3238fea63b38b2cb61a1e54b2 Mon Sep 17 00:00:00 2001 From: Ludovic Tolhurst-Cleaver Date: Fri, 7 Nov 2025 00:21:20 +0000 Subject: [PATCH 4/4] remove extraneous file --- t/yes/yes | 47 ----------------------------------------------- 1 file changed, 47 deletions(-) delete mode 100644 t/yes/yes diff --git a/t/yes/yes b/t/yes/yes deleted file mode 100644 index 7bfd2365..00000000 --- a/t/yes/yes +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/env perl - -# tryout script for running PPT's 'yes' in a child process -# and reading from it without blocking - -use strict; -use warnings; - -$|++; # autoflush both processes (superfluous?) - -my ($pid, $child); - -# default path to yes from PPT Git repo root -my $default_ppt_yes = './bin/yes'; - -# Update path to PPT yes if different to default, -# or to compare with other yes implementations, -# e.g. /usr/bin/yes. -my $ppt_yes_path = defined($ARGV[0]) ? $ARGV[0] : $default_ppt_yes; - -die "Can't find 'yes' script at $ppt_yes_path\n" - unless (-e $ppt_yes_path && -f $ppt_yes_path); - -# fork and run yes in child process via open '-|' -if ($pid = open($child, '-|', $ppt_yes_path)) { - # PARENT PROCESS - # run parent code, reading from child - print "Parent PID: $$\nChild PID: $pid\n"; - - my @lines; - for (1..10) { - # NOTE <> must be called in scalar context to prevent blocking. - my $line = <$child>; - push @lines, $line; - } - # Set output field separator to empty string - # to prevent outdenting of all but first 'y'. - local $" = ''; - print "Child Output:-\n@lines"; - - close($child); # apparently gratuitous -} else { - die "cannot fork:$!\n" unless defined $pid; - # CHILD PROCESS - exit; # apparently gratuitous -} -