File: mg

package info (click to toggle)
perl 5.42.0-2
  • links: PTS, VCS
  • area: main
  • in suites: experimental
  • size: 128,392 kB
  • sloc: perl: 534,963; ansic: 240,563; sh: 72,042; pascal: 6,934; xml: 2,428; yacc: 1,360; makefile: 1,197; cpp: 208; lisp: 1
file content (171 lines) | stat: -rw-r--r-- 3,857 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
  mg.c	AOK

  No such signal: SIG%s
    $SIG{FRED} = sub {}

  SIG%s handler \"%s\" not defined.
    $SIG{"INT"} = "ok3"; kill "INT",$$;

__END__
# mg.c
use warnings 'signal' ;
$SIG{FRED} = sub {};
EXPECT
No such signal: SIGFRED at - line 3.
########
# mg.c
no warnings 'signal' ;
$SIG{FRED} = sub {};
EXPECT

########
# mg.c
use warnings 'signal' ;
if ($^O eq 'MSWin32' || $^O eq 'VMS') {
    print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
}
$|=1;
$SIG{"INT"} = "fred"; kill "INT",$$;
EXPECT
SIGINT handler "fred" not defined.
########
# mg.c
no warnings 'signal' ;
if ($^O eq 'MSWin32' || $^O eq 'VMS') {
    print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
}
$|=1;
$SIG{"INT"} = "fred"; kill "INT",$$;
EXPECT

########
# mg.c
use warnings 'signal' ;
if ($^O eq 'MSWin32' || $^O eq 'VMS') {
    print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
}
$|=1;
$SIG{__WARN__} = sub { warn shift =~ s/\0/\\0/rugs };
$SIG{"INT"} = "fr\0d"; kill "INT",$$;
EXPECT
SIGINT handler "fr\0d" not defined.
########
# mg.c
use warnings 'signal' ;
use open ":std", ":utf8";
use utf8;
if ($^O eq 'MSWin32' || $^O eq 'VMS') {
    print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
}
$|=1;
$SIG{"INT"} = "프레드"; kill "INT",$$;
EXPECT
SIGINT handler "프레드" not defined.
########
# mg.c
use warnings 'uninitialized';
'foo' =~ /(foo)/;
oct $3;
EXPECT
Use of uninitialized value $3 in oct at - line 4.
########
# mg.c
use warnings 'uninitialized';
oct $3;
EXPECT
Use of uninitialized value $3 in oct at - line 3.
########
# mg.c
use warnings 'uninitialized';
$ENV{FOO} = undef; # should not warn
EXPECT
########
# NAME Use of uninitialized value $_[0] in defined operator
# github 22423
use warnings 'uninitialized';
sub f { defined $_[0] }
my $s;
my %h;
f($h{$s});
EXPECT
Use of uninitialized value $s in hash element at - line 6.
########
# NAME Use of uninitialized value $_[0] in defined operator (tied)
# github 22423
# should we allow tied hashes to distinguish between undef and ""
# without warning?  For now test the current behaviour, this
# didn't produce the warning described in github #22423 since
# if the hash is tied for the call the PVLV uses packelem (tie)
# magic rather than defelem magic
use v5.36;
++$|;
sub f { defined $_[0] }
my $s;
tie my %h, "Foo";
f($h{$s});
$h{+undef} = 1;
$h{""} = 2;
say $h{+undef};
f($h{$s});

package Foo;

sub TIEHASH {
  bless {}, shift;
}
sub STORE {
  my ($self, $index, $val) = @_;
  $self->{defined $index ? $index : "+undef"} = $val;
}
sub FETCH {
  my ($self, $index) = @_;
  $self->{defined $index ? $index : "+undef"};
}
sub EXISTS {
  my ($self, $index) = @_;
  exists $self->{defined $index ? $index : "+undef"};
}

EXPECT
Use of uninitialized value $s in hash element at - line 12.
Use of uninitialized value in hash element at - line 13.
Use of uninitialized value in hash element at - line 15.
1
Use of uninitialized value $s in hash element at - line 16.
########
# NAME Use of uninitialized value $_[0] in defined operator (tied2)
# github 22423
# In this case we have a tied hash, but it's only tied after the
# PVLV is created for the element. This *does* produce the warning
# complained about in #22423
use v5.36;
++$|;
my %h;
sub f {
  tie %h, "Foo";
  defined $_[0];
}
my $s;
say f($h{$s}) ? "defined" : "undefined";

package Foo;

sub TIEHASH {
  bless { "+undef" => "tied-undef" }, shift;
}
sub STORE($self, $index, $val) {
  $self->{defined $index ? $index : "+undef"} = $val;
}
sub FETCH($self, $index) {
  $self->{defined $index ? $index : "+undef"};
}
sub EXISTS($self, $index) {
  exists $self->{defined $index ? $index : "+undef"};
}
sub DELETE($self, $index) {
  delete $self->{defined $index ? $index : "+undef"};
}
EXPECT
Use of uninitialized value $s in hash element at - line 13.
Use of uninitialized value $_[0] in defined operator at - line 10.
defined