1#!./perl 2 3# Checks if 'package' work as intended. 4 5BEGIN { 6 chdir 't' if -d 't'; 7 require './test.pl'; 8} 9 10plan (tests => 18); 11 12use utf8; 13use open qw( :utf8 :std ); 14 15package F����::B��r { } 16 17package ��������� { } 18 19package ������::��������� { } 20 21ok 1, "sanity check. If we got this far, UTF-8 in package names is legal."; 22 23#The next few come from comp/package.t 24{ 25 26 $�����u���f��� = 123; 27 28 package �����; 29 30 sub ��������� {bless [];} 31 $bar = 4; 32 { 33 package �����; 34 $�����u���f��� = 5; 35 } 36 37 { 38 no warnings qw(syntax deprecated); 39 $�����'d������ = 6; #' 40 } 41 42 $����� = 2; 43 44 $����� = join(':', sort(keys %�����::)); 45 $����� = join(':', sort(keys %�����::)); 46 47 ::is $�����, 'BEGIN:bar:���������:�����:�����', "comp/stash.t test 1"; 48 ::is $�����, "d������:�����u���f���", "comp/stash.t test 2"; 49 50 { 51 no warnings qw(syntax deprecated); 52 ::is $main'�����u���f���, 123, "comp/stash.t test 3"; 53 } 54 55 package �����; 56 57 ::is $�����u���f���, 5, "comp/stash.t test 4"; 58 eval '::is $�����u���f���, 5, "comp/stash.t test 5";'; 59 eval 'package main; is $�����u���f���, 123, "comp/stash.t test 6";'; 60 ::is $�����u���f���, 5, "comp/stash.t test 7"; 61 62 #This is actually pretty bad, as caller() wasn't clean to begin with. 63 package main; 64 sub ��� { caller(0) } 65 66 sub ����� { 67 my $s = shift; 68 if ($s) { 69 package ���QR; 70 main::���(); 71 } 72 } 73 74 is((�����(1))[0], '���QR', "comp/stash.t test 8"); 75 76 my $Q = �����->���������(); 77 undef %�����::; 78 eval { $a = *�����::���������{PACKAGE}; }; 79 is $a, "__ANON__", "comp/stash.t test 9"; 80 81 { 82 local $@; 83 eval { $Q->param; }; 84 like $@, qr/^Can't use anonymous symbol table for method lookup/, "comp/stash.t test 10"; 85 } 86 87 like "$Q", qr/^__ANON__=/, "comp/stash.t test 11"; 88 89 is ref $Q, "__ANON__", "comp/stash.t test 12"; 90 91 package bug��������������� { #not really latin, but bear with me, I'm not Damian. 92 ::is( __PACKAGE__, 'bug���������������', "comp/stash.t test 13"); 93 ::is( eval('__PACKAGE__'), 'bug���������������', "comp/stash.t test 14"); 94 } 95} 96 97#This comes from comp/package_block.t 98{ 99 local $@; 100 eval q[package ��� {]; 101 like $@, qr/\AMissing right curly /, "comp/package_block.t test"; 102} 103 104# perl #105922 105 106{ 107 my $latin_1 = "��ackage"; 108 my $utf8 = "��ackage"; 109 utf8::downgrade($latin_1); 110 utf8::upgrade($utf8); 111 112 local $@; 113 eval { $latin_1->can("yadda") }; 114 ok(!$@, "latin1->meth works"); 115 116 local $@; 117 eval { $utf8->can("yadda") }; 118 ok(!$@, "utf8->meth works"); 119} 120