わかりました。Perl と Perl 6 は初めてです。フォークとパイピングが機能するかどうか見てみようと思っていましたが、今のところできていません。これが私のPerl 6コードです:
use NativeCall;
# http://www.perlmonks.org/?node_id=989766
our sub c_close(int32) returns int32 is native is symbol('close') { * }
sub pipe(CArray[int32]) returns int32 is native { ... }
our sub c_read(int32, Str is encoded('utf8'), size_t) returns ssize_t is native is symbol('read') { *}
our sub c_write(int32, Str is encoded('utf8'), size_t) returns ssize_t is native is symbol('write') { *}
our sub c_wait(int32 is rw) is native is symbol('wait') { * }
sub c_puts(Str) is native is symbol("puts") { * }
sub waitpid(int32, Pointer, int32) returns int32 is native {*};
my @fd := CArray[int32].new;
#my ($child, $parent);
my $pok = pipe(@fd);
if ($pok == -1) { die "Pipe failed" ; }
sub fork() returns int32 is native { ... };
# See:
# https://rosettacode.org/wiki/Fork#Perl_6
my $pid = fork();
if ( $pid < 0) { die "Fork failed" ; }
if ( $pid == 0) {
print "C: I am the child\n";
if (c_close(@fd[1]) == -1) { die "Child couldn't close fd[1]" };
my $msg_in = "";
say "C: starting read";
my $nread = c_read(@fd[0], $msg_in, 80);
print "C: nread=$nread\n";
print "C: message:$msg_in.\n";
c_close(@fd[0]);
} else {
print "P: I am the parent of $pid\n";
if (c_close(@fd[0]) == -1) { die "Parent couldn't close fd[0]"; } ;
my $msg = "Hello from parent";
my $len = $msg.encode('utf8').bytes + 1;
print "P: test put string: ";
c_puts($msg);
#print "P: len=$len\n";
my $nwritten =c_write(@fd[1], $msg, $len);
print "P: len $len, wrote $nwritten\n";
say "P: Finished writing";
c_close(@fd[1]);
#my $null= 0;
#c_wait($null);
my $stat_loc;
waitpid($pid, $stat_loc ,0);
}
これを実行した結果は次のとおりです。
P: I am the parent of 25809
C: I am the child
C: starting read
C: nread=-1
C: message:.
P: test put string: Hello from parent
P: len 18, wrote -1
P: Finished writing
c_read()
関数が何らかの理由でブロックされていないようですが、 AFAIKは不可能です。とにかくフォークについてよく知っているわけではありません。
修正は何ですか?
答え
2016 年 12 月 19 日更新
@timotimo のおかげで、実用的な解決策を得ることができました。私の努力は改善される可能性が高いようです。たとえば、UTF-8 では正しく動作しないと思います。とにかく、少なくとも「それは機能します」。
use NativeCall;
# http://www.perlmonks.org/?node_id=989766
our sub c_close(int32) returns int32 is native is symbol('close') { * }
our sub c_fork() returns int32 is native is symbol('fork') { ... };
our sub c_pipe(CArray[int32]) returns int32 is native is symbol('pipe') { ... }
our sub c_puts(Str) is native is symbol("puts") { * }
our sub c_read(int32, CArray[uint8], size_t) returns ssize_t is native is symbol('read') { *}
our sub c_wait(int32 is rw) is native is symbol('wait') { * }
our sub c_waitpid(int32, Pointer, int32) returns int32 is native is symbol('waitpid') {*};
our sub c_write(int32, Str is encoded('utf8'), size_t) returns ssize_t is native is symbol('write') { *}
my @fd := CArray[int32].new(0, 0);
my $pok = c_pipe(@fd);
if ($pok == -1) { die "Pipe failed" ; }
# See:
# https://rosettacode.org/wiki/Fork#Perl_6
my $pid = c_fork();
if ( $pid < 0) { die "Fork failed" ; }
if ( $pid == 0) {
print "C: I am the child\n";
if (c_close(@fd[1]) == -1) { die "Child couldn't close fd[1]" };
my uint8 $b0 = 0;
my @buf := CArray[uint8].new( $b0 xx 80);
say "C: starting read";
my $nread = c_read(@fd[0], @buf, 80);
print "C: nread=$nread\n";
my $msg = "";
for (0..$nread-1) -> $i { $msg = $msg ~ chr(@buf[$i]); } ;
print "C: message:$msg.\n";
c_close(@fd[0]);
} else {
print "P: I am the parent of $pid\n";
if (c_close(@fd[0]) == -1) { die "Parent couldn't close fd[0]"; } ;
my $msg = "Hello from parent";
my $len = $msg.encode('utf8').bytes;
print "P: test put string: ";
c_puts($msg);
my $nwritten =c_write(@fd[1], $msg, $len);
print "P: len $len, wrote $nwritten\n";
say "P: Finished writing";
c_close(@fd[1]);
my $stat_loc;
c_waitpid($pid, $stat_loc ,0);
}
出力が期待どおりになりました:
P: I am the parent of 22448
C: I am the child
P: test put string: Hello from parent
C: starting read
P: len 17, wrote 17
P: Finished writing
C: nread=17
C: message:Hello from parent.
gistを作成し、必要に応じてソリューションを修正しました。