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