We only need local $? if we inline calls to DEMOLISH
[gitmo/Moose.git] / t / type_constraints / util_std_type_constraints.t
index 4b4dc4b..31e22b4 100644 (file)
@@ -3,8 +3,10 @@
 use strict;
 use warnings;
 
+use Test::Fatal;
 use Test::More;
 
+use Eval::Closure;
 use IO::File;
 use Moose::Util::TypeConstraints;
 use Scalar::Util qw( blessed openhandle );
@@ -19,6 +21,8 @@ my $NEG_NUM = -42.42;
 my $EMPTY_STRING  = q{};
 my $STRING        = 'foo';
 my $NUM_IN_STRING = 'has 42 in it';
+my $INT_WITH_NL1  = "1\n";
+my $INT_WITH_NL2  = "\n1";
 
 my $SCALAR_REF     = \( my $var );
 my $SCALAR_REF_REF = \$SCALAR_REF;
@@ -26,8 +30,7 @@ my $ARRAY_REF      = [];
 my $HASH_REF       = {};
 my $CODE_REF       = sub { };
 
-no warnings 'once';    # << I *hates* that warning ...
-my $GLOB     = *GLOB_REF;
+my $GLOB     = do { no warnings 'once'; *GLOB_REF };
 my $GLOB_REF = \$GLOB;
 
 open my $FH, '<', $0 or die "Could not open $0 for the test";
@@ -35,8 +38,9 @@ open my $FH, '<', $0 or die "Could not open $0 for the test";
 my $FH_OBJECT = IO::File->new( $0, 'r' )
     or die "Could not open $0 for the test";
 
-my $REGEX = qr/../;
-my $REGEX_OBJ = bless qr/../, 'BlessedQR';
+my $REGEX      = qr/../;
+my $REGEX_OBJ  = bless qr/../, 'BlessedQR';
+my $FAKE_REGEX = bless {}, 'Regexp';
 
 my $OBJECT = bless {}, 'Foo';
 
@@ -71,6 +75,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -82,6 +88,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -97,6 +104,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -108,6 +117,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -123,6 +133,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -134,6 +146,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
         ],
         reject => [
@@ -154,6 +167,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -165,6 +180,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
         ],
     },
@@ -182,6 +198,8 @@ my %tests = (
             $NEG_NUM,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -193,6 +211,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
         ],
     },
@@ -207,6 +226,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -218,6 +239,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -233,6 +255,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $GLOB,
         ],
         reject => [
@@ -246,6 +270,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -262,6 +287,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
         ],
         reject => [
@@ -274,6 +300,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $GLOB,
             $UNDEF,
         ],
@@ -286,6 +314,8 @@ my %tests = (
             $NEG_INT,
             $NUM,
             $NEG_NUM,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
         ],
         reject => [
             $EMPTY_STRING,
@@ -302,6 +332,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -319,6 +350,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -330,6 +363,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -345,6 +379,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
         ],
         reject => [
             $SCALAR_REF,
@@ -358,6 +394,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -377,6 +414,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $ARRAY_REF,
             $HASH_REF,
             $CODE_REF,
@@ -386,6 +425,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -404,6 +444,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $HASH_REF,
@@ -414,6 +456,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -432,6 +475,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -442,6 +487,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -460,6 +506,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -470,6 +518,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -489,6 +538,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -500,6 +551,7 @@ my %tests = (
             $FH_OBJECT,
             $OBJECT,
             $UNDEF,
+            $FAKE_REGEX,
         ],
     },
     GlobRef => {
@@ -517,6 +569,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -527,6 +581,7 @@ my %tests = (
             $OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $UNDEF,
         ],
     },
@@ -545,6 +600,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -555,6 +612,7 @@ my %tests = (
             $OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $UNDEF,
         ],
     },
@@ -563,6 +621,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
         ],
         reject => [
@@ -575,6 +634,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -601,6 +662,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -612,6 +675,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -631,6 +695,8 @@ my %tests = (
             $EMPTY_STRING,
             $STRING,
             $NUM_IN_STRING,
+            $INT_WITH_NL1,
+            $INT_WITH_NL2,
             $SCALAR_REF,
             $SCALAR_REF_REF,
             $ARRAY_REF,
@@ -642,6 +708,7 @@ my %tests = (
             $FH_OBJECT,
             $REGEX,
             $REGEX_OBJ,
+            $FAKE_REGEX,
             $OBJECT,
             $UNDEF,
         ],
@@ -650,6 +717,68 @@ my %tests = (
 
 for my $name ( sort keys %tests ) {
     test_constraint( $name, $tests{$name} );
+
+    test_constraint(
+        Moose::Util::TypeConstraints::find_or_create_type_constraint(
+            "$name|$name"),
+        $tests{$name}
+    );
+}
+
+my %substr_test_str = (
+    ClassName   => 'x' . $CLASS_NAME,
+    RoleName    => 'x' . $ROLE_NAME,
+);
+
+# We need to test that the Str constraint (and types that derive from it)
+# accept the return val of substr() - which means passing that return val
+# directly to the checking code
+foreach my $type_name (qw(Str Num Int ClassName RoleName))
+{
+    my $str = $substr_test_str{$type_name} || '123456789';
+
+    my $type = Moose::Util::TypeConstraints::find_type_constraint($type_name);
+
+    my $unoptimized
+        = $type->has_parent
+        ? $type->_compile_subtype( $type->constraint )
+        : $type->_compile_type( $type->constraint );
+
+    my $inlined;
+    {
+        $inlined = eval_closure(
+            source => 'sub { ( ' . $type->_inline_check('$_[0]') . ' ) }',
+        );
+    }
+
+    ok(
+        $type->check( substr( $str, 1, 5 ) ),
+        $type_name . ' accepts return val from substr using ->check'
+    );
+    ok(
+        $unoptimized->( substr( $str, 1, 5 ) ),
+        $type_name . ' accepts return val from substr using unoptimized constraint'
+    );
+    ok(
+        $inlined->( substr( $str, 1, 5 ) ),
+        $type_name . ' accepts return val from substr using inlined constraint'
+    );
+
+    # only Str accepts empty strings.
+    next unless $type_name eq 'Str';
+
+    ok(
+        $type->check( substr( $str, 0, 0 ) ),
+        $type_name . ' accepts empty return val from substr using ->check'
+    );
+    ok(
+        $unoptimized->( substr( $str, 0, 0 ) ),
+        $type_name . ' accepts empty return val from substr using unoptimized constraint'
+    );
+    ok(
+        $inlined->( substr( $str, 0, 0 ) ),
+        $type_name . ' accepts empty return val from substr using inlined constraint'
+    );
 }
 
 {
@@ -671,6 +800,8 @@ for my $name ( sort keys %tests ) {
                 $EMPTY_STRING,
                 $STRING,
                 $NUM_IN_STRING,
+                $INT_WITH_NL1,
+                $INT_WITH_NL2,
                 $SCALAR_REF,
                 $SCALAR_REF_REF,
                 $ARRAY_REF,
@@ -682,6 +813,7 @@ for my $name ( sort keys %tests ) {
                 $FH_OBJECT,
                 $REGEX,
                 $REGEX_OBJ,
+                $FAKE_REGEX,
                 $OBJECT,
                 $UNDEF,
             ],
@@ -692,21 +824,21 @@ for my $name ( sort keys %tests ) {
 {
     package Duck;
 
-    sub quack {}
-    sub flap {}
+    sub quack { }
+    sub flap  { }
 }
 
 {
     package DuckLike;
 
-    sub quack {}
-    sub flap {}
+    sub quack { }
+    sub flap  { }
 }
 
 {
     package Bird;
 
-    sub flap {}
+    sub flap { }
 }
 
 {
@@ -720,7 +852,6 @@ for my $name ( sort keys %tests ) {
                 ( bless {}, 'DuckLike' ),
             ],
             reject => [
-                'Thing',
                 $ZERO,
                 $ONE,
                 $INT,
@@ -730,6 +861,8 @@ for my $name ( sort keys %tests ) {
                 $EMPTY_STRING,
                 $STRING,
                 $NUM_IN_STRING,
+                $INT_WITH_NL1,
+                $INT_WITH_NL2,
                 $SCALAR_REF,
                 $SCALAR_REF_REF,
                 $ARRAY_REF,
@@ -741,6 +874,7 @@ for my $name ( sort keys %tests ) {
                 $FH_OBJECT,
                 $REGEX,
                 $REGEX_OBJ,
+                $FAKE_REGEX,
                 $OBJECT,
                 ( bless {}, 'Bird' ),
                 $UNDEF,
@@ -757,7 +891,6 @@ for my $name ( sort keys %tests ) {
         'Enumerated', {
             accept => \@allowed,
             reject => [
-                'Thing',
                 $ZERO,
                 $ONE,
                 $INT,
@@ -767,6 +900,8 @@ for my $name ( sort keys %tests ) {
                 $EMPTY_STRING,
                 $STRING,
                 $NUM_IN_STRING,
+                $INT_WITH_NL1,
+                $INT_WITH_NL2,
                 $SCALAR_REF,
                 $SCALAR_REF_REF,
                 $ARRAY_REF,
@@ -778,6 +913,212 @@ for my $name ( sort keys %tests ) {
                 $FH_OBJECT,
                 $REGEX,
                 $REGEX_OBJ,
+                $FAKE_REGEX,
+                $OBJECT,
+                $UNDEF,
+            ],
+        }
+    );
+}
+
+{
+    my $union = Moose::Meta::TypeConstraint::Union->new(
+        type_constraints => [
+            find_type_constraint('Int'),
+            find_type_constraint('Object'),
+        ],
+    );
+
+    test_constraint(
+        $union, {
+            accept => [
+                $ZERO,
+                $ONE,
+                $INT,
+                $NEG_INT,
+                $FH_OBJECT,
+                $REGEX,
+                $REGEX_OBJ,
+                $FAKE_REGEX,
+                $OBJECT,
+            ],
+            reject => [
+                $NUM,
+                $NEG_NUM,
+                $EMPTY_STRING,
+                $STRING,
+                $NUM_IN_STRING,
+                $INT_WITH_NL1,
+                $INT_WITH_NL2,
+                $SCALAR_REF,
+                $SCALAR_REF_REF,
+                $ARRAY_REF,
+                $HASH_REF,
+                $CODE_REF,
+                $GLOB,
+                $GLOB_REF,
+                $FH,
+                $UNDEF,
+            ],
+        }
+    );
+}
+{
+    note 'Anonymous Union Test';
+
+    my $union = union(['Int','Object']);
+
+    test_constraint(
+        $union, {
+            accept => [
+                $ZERO,
+                $ONE,
+                $INT,
+                $NEG_INT,
+                $FH_OBJECT,
+                $REGEX,
+                $REGEX_OBJ,
+                $FAKE_REGEX,
+                $OBJECT,
+            ],
+            reject => [
+                $NUM,
+                $NEG_NUM,
+                $EMPTY_STRING,
+                $STRING,
+                $NUM_IN_STRING,
+                $INT_WITH_NL1,
+                $INT_WITH_NL2,
+                $SCALAR_REF,
+                $SCALAR_REF_REF,
+                $ARRAY_REF,
+                $HASH_REF,
+                $CODE_REF,
+                $GLOB,
+                $GLOB_REF,
+                $FH,
+                $UNDEF,
+            ],
+        }
+    );
+}
+{
+    note 'Named Union Test';
+    union 'NamedUnion' => ['Int','Object'];
+
+    test_constraint(
+        'NamedUnion', {
+            accept => [
+                $ZERO,
+                $ONE,
+                $INT,
+                $NEG_INT,
+                $FH_OBJECT,
+                $REGEX,
+                $REGEX_OBJ,
+                $FAKE_REGEX,
+                $OBJECT,
+            ],
+            reject => [
+                $NUM,
+                $NEG_NUM,
+                $EMPTY_STRING,
+                $STRING,
+                $NUM_IN_STRING,
+                $INT_WITH_NL1,
+                $INT_WITH_NL2,
+                $SCALAR_REF,
+                $SCALAR_REF_REF,
+                $ARRAY_REF,
+                $HASH_REF,
+                $CODE_REF,
+                $GLOB,
+                $GLOB_REF,
+                $FH,
+                $UNDEF,
+            ],
+        }
+    );
+}
+
+{
+    note 'Combined Union Test';
+    my $union = union( [ 'Int', enum( [qw[ red green blue ]] ) ] );
+
+    test_constraint(
+        $union, {
+            accept => [
+                $ZERO,
+                $ONE,
+                $INT,
+                $NEG_INT,
+                'red',
+                'green',
+                'blue',
+            ],
+            reject => [
+                'yellow',
+                'pink',
+                $FH_OBJECT,
+                $REGEX,
+                $REGEX_OBJ,
+                $FAKE_REGEX,
+                $OBJECT,
+                $NUM,
+                $NEG_NUM,
+                $EMPTY_STRING,
+                $STRING,
+                $NUM_IN_STRING,
+                $INT_WITH_NL1,
+                $INT_WITH_NL2,
+                $SCALAR_REF,
+                $SCALAR_REF_REF,
+                $ARRAY_REF,
+                $HASH_REF,
+                $CODE_REF,
+                $GLOB,
+                $GLOB_REF,
+                $FH,
+                $UNDEF,
+            ],
+        }
+    );
+}
+
+
+{
+    enum 'Enum1' => 'a', 'b';
+    enum 'Enum2' => 'x', 'y';
+
+    subtype 'EnumUnion', as 'Enum1 | Enum2';
+
+    test_constraint(
+        'EnumUnion', {
+            accept => [qw( a b x y )],
+            reject => [
+                $ZERO,
+                $ONE,
+                $INT,
+                $NEG_INT,
+                $NUM,
+                $NEG_NUM,
+                $EMPTY_STRING,
+                $STRING,
+                $NUM_IN_STRING,
+                $INT_WITH_NL1,
+                $INT_WITH_NL2,
+                $SCALAR_REF,
+                $SCALAR_REF_REF,
+                $ARRAY_REF,
+                $HASH_REF,
+                $CODE_REF,
+                $GLOB,
+                $GLOB_REF,
+                $FH,
+                $FH_OBJECT,
+                $REGEX,
+                $REGEX_OBJ,
+                $FAKE_REGEX,
                 $OBJECT,
                 $UNDEF,
             ],
@@ -849,12 +1190,34 @@ sub test_constraint {
         : $type->_compile_type( $type->constraint );
 
     my $inlined;
-    if ( $type->has_inlined_type_constraint ) {
-        local $@;
-        $inlined = eval 'sub { ( ' . $type->_inline_check('$_[0]') . ' ) }';
-        die $@ if $@;
+    if ( $type->can_be_inlined ) {
+        $inlined = eval_closure(
+            source      => 'sub { ( ' . $type->_inline_check('$_[0]') . ' ) }',
+            environment => $type->inline_environment,
+        );
     }
 
+    my $class = Moose::Meta::Class->create_anon(
+        superclasses => ['Moose::Object'],
+    );
+    $class->add_attribute(
+        simple => (
+            is  => 'ro',
+            isa => $type,
+        )
+    );
+
+    $class->add_attribute(
+        collection => (
+            traits  => ['Array'],
+            isa     => 'ArrayRef[' . $type->name . ']',
+            default => sub { [] },
+            handles => { add_to_collection => 'push' },
+        )
+    );
+
+    my $anon_class = $class->name;
+
     for my $accept ( @{ $tests->{accept} || [] } ) {
         my $described = describe($accept);
         ok(
@@ -871,6 +1234,22 @@ sub test_constraint {
                 "$name accepts $described using inlined constraint"
             );
         }
+
+        is(
+            exception {
+                $anon_class->new( simple => $accept );
+            },
+            undef,
+            "no exception passing $described to constructor with $name"
+        );
+
+        is(
+            exception {
+                $anon_class->new()->add_to_collection($accept);
+            },
+            undef,
+            "no exception passing $described to native trait push method with $name"
+        );
     }
 
     for my $reject ( @{ $tests->{reject} || [] } ) {
@@ -889,6 +1268,20 @@ sub test_constraint {
                 "$name rejects $described using inlined constraint"
             );
         }
+
+        ok(
+            exception {
+                $anon_class->new( simple => $reject );
+            },
+            "got exception passing $described to constructor with $name"
+        );
+
+        ok(
+            exception {
+                $anon_class->new()->add_to_collection($reject);
+            },
+            "got exception passing $described to native trait push method with $name"
+        );
     }
 }
 
@@ -899,9 +1292,11 @@ sub describe {
 
     if ( !ref $val ) {
         return q{''} if $val eq q{};
-    }
 
-    return $val unless ref $val;
+        $val =~ s/\n/\\n/g;
+
+        return $val;
+    }
 
     return 'open filehandle'
         if openhandle $val && !blessed $val;