Perl: add step4_if_fn_do

- Move string/printing tests to the bottom of tests/step4_if_fn_do

1 files changed, 18 insertions, 7 deletions

diff --git a/perl/printer.pm b/perl/printer.pm
index 94219d4..d5bc306 100644
--- a/perl/printer.pm
+++ b/perl/printer.pm
@@ -1,31 +1,42 @@
 package printer;
-use feature qw(switch);
 use strict;
 use warnings;
+use feature qw(switch);
 use Exporter 'import';
 our @EXPORT_OK = qw( _pr_str );
 
 use types qw($nil $true $false);
 
 sub _pr_str {
-    my($obj) = @_;
+    my($obj, $print_readably) = @_;
+    my($_r) = (defined $print_readably) ? $print_readably : 1;
     given (ref $obj) {
         when(/^List/) {
-            return '(' . join(' ', map {_pr_str($_)} @$obj) . ')';
+            return '(' . join(' ', map {_pr_str($_, $_r)} @$obj) . ')';
         }
         when(/^Vector/) {
-            return '[' . join(' ', map {_pr_str($_)} @$obj) . ']';
+            return '[' . join(' ', map {_pr_str($_, $_r)} @$obj) . ']';
         }
         when(/^HashMap/) {
             my @elems = ();
             foreach my $key (keys %$obj) {
-                push(@elems, _pr_str(String->new($key)));
-                push(@elems, _pr_str($obj->{$key}));
+                push(@elems, _pr_str(String->new($key), $_r));
+                push(@elems, _pr_str($obj->{$key}, $_r));
             }
 
             return '{' . join(' ', @elems) . '}';
         }
-        when(/^String/) { return '"' . $$obj . '"'; }
+        when(/^String/) {
+            if ($_r) {
+                my $str = $$obj;
+                $str =~ s/\\/\\\\/g;
+                $str =~ s/"/\\"/g;
+                $str =~ s/\n/\\n"/g;
+                return '"' . $str . '"';
+            } else {
+                return $$obj;
+            }
+        }
         when(/^CODE/)   { return '<builtin_fn* ' . $obj . '>'; }
         default         { return $$obj; }
     }