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