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 $압Ƈ'd읯ⱪ = 6; #' 38 39 $ꑭʑ = 2; 40 41 $ꑭʑ = join(':', sort(keys %ꑭʑ::)); 42 $압Ƈ = join(':', sort(keys %압Ƈ::)); 43 44 ::is $ꑭʑ, 'bar:ニュー:ꑭʑ:압Ƈ', "comp/stash.t test 1"; 45 ::is $압Ƈ, "d읯ⱪ:ㄅĽuṞfⳐ", "comp/stash.t test 2"; 46 ::is $main'ㄅĽuṞfⳐ, 123, "comp/stash.t test 3"; 47 48 package 압Ƈ; 49 50 ::is $ㄅĽuṞfⳐ, 5, "comp/stash.t test 4"; 51 eval '::is $ㄅĽuṞfⳐ, 5, "comp/stash.t test 5";'; 52 eval 'package main; is $ㄅĽuṞfⳐ, 123, "comp/stash.t test 6";'; 53 ::is $ㄅĽuṞfⳐ, 5, "comp/stash.t test 7"; 54 55 #This is actually pretty bad, as caller() wasn't clean to begin with. 56 package main; 57 sub ㄘ { caller(0) } 58 59 sub ƒஓ { 60 my $s = shift; 61 if ($s) { 62 package ᛔQR; 63 main::ㄘ(); 64 } 65 } 66 67 is((ƒஓ(1))[0], 'ᛔQR', "comp/stash.t test 8"); 68 69 my $Q = ꑭʑ->ニュー(); 70 undef %ꑭʑ::; 71 eval { $a = *ꑭʑ::ニュー{PACKAGE}; }; 72 is $a, "__ANON__", "comp/stash.t test 9"; 73 74 { 75 local $@; 76 eval { $Q->param; }; 77 like $@, qr/^Can't use anonymous symbol table for method lookup/, "comp/stash.t test 10"; 78 } 79 80 like "$Q", qr/^__ANON__=/, "comp/stash.t test 11"; 81 82 is ref $Q, "__ANON__", "comp/stash.t test 12"; 83 84 package bugⅲⅱⅴⅵⅱ { #not really latin, but bear with me, I'm not Damian. 85 ::is( __PACKAGE__, 'bugⅲⅱⅴⅵⅱ', "comp/stash.t test 13"); 86 ::is( eval('__PACKAGE__'), 'bugⅲⅱⅴⅵⅱ', "comp/stash.t test 14"); 87 } 88} 89 90#This comes from comp/package_block.t 91{ 92 local $@; 93 eval q[package ᕘ {]; 94 like $@, qr/\AMissing right curly /, "comp/package_block.t test"; 95} 96 97# perl #105922 98 99{ 100 my $latin_1 = "þackage"; 101 my $utf8 = "þackage"; 102 utf8::downgrade($latin_1); 103 utf8::upgrade($utf8); 104 105 local $@; 106 eval { $latin_1->can("yadda") }; 107 ok(!$@, "latin1->meth works"); 108 109 local $@; 110 eval { $utf8->can("yadda") }; 111 ok(!$@, "utf8->meth works"); 112} 113