This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid extra newlines on VMS in t/opbasic/arith.t
[perl5.git] / t / uni / tie.t
CommitLineData
d0644529
NC
1#!perl -w
2
3BEGIN {
b5efbd1f 4 chdir 't' if -d 't';
e4206093 5 require './test.pl';
d0644529
NC
6}
7
4886938f 8plan (tests => 10);
d0644529
NC
9use strict;
10
11{
12 package UTF8Toggle;
13
14 sub TIESCALAR {
15 my $class = shift;
16 my $value = shift;
17 my $state = shift||0;
18 return bless [$value, $state], $class;
19 }
20
21 sub FETCH {
22 my $self = shift;
23 $self->[1] = ! $self->[1];
24 if ($self->[1]) {
25 utf8::downgrade($self->[0]);
26 } else {
27 utf8::upgrade($self->[0]);
28 }
29 $self->[0];
30 }
31}
32
33foreach my $t ("ASCII", "B\366se") {
34 my $length = length $t;
35
36 my $u;
37 tie $u, 'UTF8Toggle', $t;
38 is (length $u, $length, "length of '$t'");
39 is (length $u, $length, "length of '$t'");
40 is (length $u, $length, "length of '$t'");
41 is (length $u, $length, "length of '$t'");
42}
43
44{
4886938f
BF
45 use utf8;
46 use open qw( :utf8 :std );
47 package Tìè::UTF8 {
48 sub TIESCALAR {
49 return bless {}, shift;
50 }
51 }
52
53 my $t;
54 tie $t, 'Tìè::UTF8';
55 is ref(tied($t)), 'Tìè::UTF8', "Tie'ing to a UTF8 package works.";
56}
57{
e4206093 58 local $::TODO = "Need more tests!";
d0644529
NC
59 fail();
60}