From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

KIMOTO / SPVM-0.990044 / t / 02_vm / 05_op / print.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119

              
use lib "t/testlib";
use TestAuto;
use strict;
use warnings;
use File::Path 'mkpath';
use Test::More;
use TestFile;
use SPVM 'TestCase::Operator::Print';
my $test_dir = $ENV{SPVM_TEST_DIR};
my $build_dir = $ENV{SPVM_BUILD_DIR};
my $test_tmp_dir = "$test_dir/test_files/.tmp";
my $script_file = "$test_tmp_dir/print-script.pl";
my $output_file = "$test_tmp_dir/print-output.txt";
mkpath $test_tmp_dir;
sub write_script_file {
  my ($script_file, $func_call) = @_;
   
  my $pre = <<"EOS";
use lib "t/testlib";
use TestAuto;
use strict;
use warnings;
use SPVM 'TestCase::Operator::Print';
use TestFile;
EOS
  open my $script_fh, '>', $script_file
    or die "Can't open file $script_file: $!";
   
  my $output_source = "$pre$func_call;";
   
  print $script_fh $output_source;
}
sub slurp_binmode {
  my ($output_file) = @_;
   
  open my $fh, '<', $output_file
    or die "Can't open file $output_file:$!";
   
  binmode $fh;
   
  my $output = do { local $/; <$fh> };
   
  return $output;
}
# Start objects count
my $api = SPVM::api();
my $start_memory_blocks_count = $api->get_memory_blocks_count();
{
  # print
  {
    # test_print
    {
      my $func_call = 'SPVM::TestCase::Operator::Print->print';
      write_script_file($script_file, $func_call);
      system("$^X -Mblib $script_file > $output_file");
      my $output = slurp_binmode($output_file);
      is($output, 'Hello');
    }
    # test_print_newline
    {
      my $func_call = 'SPVM::TestCase::Operator::Print->print_newline';
      write_script_file($script_file, $func_call);
      system("$^X -Mblib $script_file > $output_file");
      my $output = slurp_binmode($output_file);
      is($output, "\x0A");
    }
     
    # test_print_long_lines
    {
      my $func_call = 'SPVM::TestCase::Operator::Print->print_long_lines';
      write_script_file($script_file, $func_call);
      system("$^X -Mblib $script_file > $output_file");
      my $output = slurp_binmode($output_file);
      is($output, "AAAAAAAAAAAAA\x0ABBBBBBBBBBBBBBBBBBB\x0ACCCCCCCCCCCCCCCCCCCCCCCCCCC\x0ADDDDDDDDDDDDDDDDDDDDDDDDD\x0AEEEEEEEEEEEEEEEEEEEEEE\x0AFFFFFFFFFFFFFF\x0A");
    }
    # test_print_empty
    {
      my $func_call = 'SPVM::TestCase::Operator::Print->print_empty';
      write_script_file($script_file, $func_call);
      system("$^X -Mblib $script_file > $output_file");
      my $output = slurp_binmode($output_file);
      is($output, "");
    }
    # test_print_undef
    {
      my $func_call = 'SPVM::TestCase::Operator::Print->print_undef';
      write_script_file($script_file, $func_call);
      system("$^X -Mblib $script_file > $output_file");
      my $output = slurp_binmode($output_file);
      is($output, "");
    }
  }
}
# All object is freed
$api->set_exception(undef);
my $end_memory_blocks_count = $api->get_memory_blocks_count();
is($end_memory_blocks_count, $start_memory_blocks_count);
done_testing;