#!/usr/bin/perl
use strict;
use warnings;
use Inline C => <<'C_HUNK';
void c_output() {
fprintf(stdout, "###c_output");
}
void c_output_newline() {
fprintf(stdout, "###c_output_newline\n");
}
C_HUNK
sub test_global {
my $out_var = '';
my $prev_select = select;
open my $prev_stdout, '>&', \*STDOUT or die "Error: $!";
close STDOUT;
open STDOUT, '>', \$out_var or die "Error: $!";
select $out_var; $|=1;
select $prev_select;
outp_test();
open STDOUT, '>&', \$prev_stdout or die "Error: $!";
return $out_var;
}
sub outp_test {
# Test with newline (autoflush)
warn "\tprinting [perl_output_newline]\n";
print STDOUT "***perl_output_newline\n";
warn "\tcalling [c_output_newline]\n";
c_output_newline();
# Test without newline
warn "\tprinting [perl_output]\n";
print STDOUT "***perl_output";
warn "\tcalling [c_output]\n";
c_output();
}
warn "===============dry run============\n";
outp_test();
print "\n";
warn "=============test_global==========\n";
my $buffer = test_global();
$buffer =~ s/\n/\\n/g;
warn "test_global buffer:\n($buffer)\n";
print "\n";
####
===============dry run============
printing [perl_output_newline]
***perl_output_newline
calling [c_output_newline]
###c_output_newline
printing [perl_output]
calling [c_output]
***perl_output###c_output
=============test_global==========
printing [perl_output_newline]
calling [c_output_newline]
printing [perl_output]
calling [c_output]
test_global buffer:
(***perl_output_newline\n***perl_output)
####
===============dry run============
printing [perl_output_newline]
***perl_output_newline
calling [c_output_newline]
###c_output_newline
printing [perl_output]
calling [c_output]
***perl_output
=============test_global==========
printing [perl_output_newline]
calling [c_output_newline]
printing [perl_output]
calling [c_output]
test_global buffer:
(***perl_output_newline\n***perl_output)
###c_output