File Coverage

blib/lib/Syntax/Operator/Identical.pm
Criterion Covered Total %
statement 40 47 85.1
branch 9 12 75.0
condition n/a
subroutine 11 14 78.5
pod 1 4 25.0
total 61 77 79.2


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2022-2023 -- leonerd@leonerd.org.uk
5              
6             package Syntax::Operator::Identical 0.01;
7              
8 4     4   727544 use v5.14;
  4         41  
9 4     4   26 use warnings;
  4         12  
  4         100  
10              
11 4     4   22 use Carp;
  4         7  
  4         1359  
12              
13             require XSLoader;
14             XSLoader::load( __PACKAGE__, our $VERSION );
15              
16             =encoding UTF-8
17              
18             =head1 NAME
19              
20             C - almost certainly a terrible idea; don't use this
21              
22             =head1 SYNOPSIS
23              
24             You almost certainly don't want to use this.
25              
26             However, if despite all my warnings you still want to, then on Perl v5.38 or
27             later:
28              
29             use v5.38;
30             use Syntax::Operator::Identical;
31              
32             my $x = ...;
33             my $y = ...;
34              
35             if( $x ≡ $y ) {
36             say "x and y are identical";
37             }
38              
39             Or via L on Perl v5.14 or later:
40              
41             use v5.14;
42             use Syntax::Keyword::Match;
43             use Syntax::Operator::Identical;
44              
45             my $x = ...;
46              
47             match($x : ≡) {
48             case(undef) { say "The value is not defined" }
49             case(123) { say "The value is identical to 123" }
50             case("abc") { say "The value is identical to abc" }
51             }
52              
53             =head1 DESCRIPTION
54              
55             This module provides an infix operator that implements an identity test
56             between two values, in a way somewhat similar to the now-deprecated smartmatch
57             (C<~~>) operator, or other similar ideas.
58              
59             It is probably not a good idea to use this operator; it is written largely as
60             a demonstration on how such an operator I be implemented, as well as to
61             illustrate how fragile it is, in particular around the "is it a string or a
62             number?" part of the logic.
63              
64             =head2 Comparison Logic
65              
66             This operator acts symmetrically; that is, given any pair of values C<$x> and
67             C<$y>, the result of C<$x ≡ $y> will be the same as C<$y ≡ $x>. It uses the
68             following rules:
69              
70             =over 4
71              
72             =item * Definedness
73              
74             If both values are C, the operator yields true. Otherwise, if one value
75             is defined and the other is not, it yields false.
76              
77             =item * Booleans (on Perl v5.36 or later)
78              
79             If both values are booleans (as according to C), then the
80             operator returns true or false depending on whether they have the same value.
81             Otherwise, if only one is a boolean then it yields false.
82              
83             =item * References
84              
85             If both values are references, the operator yields true or false depending on
86             whether they both refer to the same thing. Otherwise, if only one is a
87             reference it returns false.
88              
89             =item * Non-references
90              
91             For any other pairs of values, if I value has a numerical part, then a
92             numerical comparison is made as per the C<==> operator, and if that is false
93             then this operator yields false. Then, if I value has a stringy part,
94             then a string comparison is made as per the C operator, and if that is
95             false then this operator yields false. Because non-defined and reference
96             values have already been considered at this point, at least one of these tests
97             must necessarily be performed.
98              
99             At this point, if there are no other reasons to reject it, the operator yields
100             true.
101              
102             =back
103              
104             As a consequence of the boolean rule, on Perl v5.36 or later, real boolean
105             values are not identical to either the numfied or stringified values they
106             would yield.
107              
108             (5 == 5) == 1; # is true
109             (5 == 5) ≡ 1; # is false
110              
111             (5 == 5) eq "1"; # is true
112             (5 == 5) ≡ "1"; # is false
113              
114             As a consequence of the reference rule, references are not identical to a
115             numified or stringified copy of themselves.
116              
117             my $aref = [];
118              
119             $aref == 0+$aref; # is true
120             $aref ≡ 0+$aref; # is false
121              
122             $aref eq "$aref"; # is true
123             $aref ≡ "$aref"; # is false
124              
125             Also as a consequence of the reference rule, any reference to an object is
126             never considered identical to a plain string or number, I that object
127             overloads the string or number comparison operators in a way that would
128             consider it to be.
129              
130             As a consequence of the final non-reference rule, comparisons between a
131             mixture of pure-number and pure-string values will be more strict than either
132             the C<==> or C operator alone would perform. Both operators must consider
133             the values equal for it to pass.
134              
135             10 == "10.0"; # is true
136             10 ≡ "10.0"; # is false, because eq says so
137              
138             =cut
139              
140             sub import
141             {
142 4     4   301 my $pkg = shift;
143 4         13 my $caller = caller;
144              
145 4         16 $pkg->import_into( $caller, @_ );
146             }
147              
148             sub unimport
149             {
150 0     0   0 my $pkg = shift;
151 0         0 my $caller = caller;
152              
153 0         0 $pkg->unimport_into( $caller, @_ );
154             }
155              
156 4     4 0 11 sub import_into { shift->apply( 1, @_ ) }
157 0     0 0 0 sub unimport_into { shift->apply( 0, @_ ) }
158              
159             sub apply
160             {
161 4     4 0 6 my $pkg = shift;
162 4         14 my ( $on, $caller, @syms ) = @_;
163              
164 4 100       23 @syms or @syms = qw( identical );
165              
166 4         10 my %syms = map { $_ => 1 } @syms;
  6         21  
167 4 100       21 if( delete $syms{identical} ) {
168             $on ? $^H{"Syntax::Operator::Identical/identical"}++
169 2 50       36 : delete $^H{"Syntax::Operator::Identical/identical"};
170             }
171              
172 4         31 foreach (qw( is_identical is_not_identical )) {
173 8 100       32 next unless delete $syms{$_};
174              
175 4     4   32 no strict 'refs';
  4         15  
  4         679  
176 4 50       11 $on ? *{"${caller}::$_"} = \&{$_}
  4         21  
  4         12  
177             : warn "TODO: implement unimport of package symbol";
178             }
179              
180 4 50       4496 croak "Unrecognised import symbols @{[ keys %syms ]}" if keys %syms;
  0            
181             }
182              
183             =head1 OPERATORS
184              
185             =head2 ≡, =:=
186              
187             my $equal = $lhs ≡ $rhs;
188             my $equal = $lhs =:= $rhs;
189              
190             Yields true if the two operands are identical, using the rules defined above.
191             The two different spellings are aliases; the latter is simply an ASCII-safe
192             variant to avoid needing to type the C<≡> symbol.
193              
194             =head2 ≢, !:=
195              
196             my $unequal = $lhs ≢ $rhs;
197             my $unequal = $lhs !:= $rhs;
198              
199             The complement operator to C<≡>; yielding true where it would yield false, and
200             vice versa. The two different spellings are aliases; the latter is simply an
201             ASCII-safe variant to avoid needing to type the C<≢> symbol.
202              
203             =head1 FUNCTIONS
204              
205             As a convenience, the following functions may be imported which implement the
206             same behaviour as the infix operators, though are accessed via regular
207             function call syntax.
208              
209             These wrapper functions are implemented using L, and thus
210             have an optimising call-checker attached to them. In most cases, code which
211             calls them should not in fact have the full runtime overhead of a function
212             call because the underlying test operator will get inlined into the calling
213             code at compiletime. In effect, code calling these functions should run with
214             the same performance as code using the infix operators directly.
215              
216             =head2 is_identical
217              
218             my $equal = is_identical( $lhs, $rhs );
219              
220             A function version of the C<≡> operator.
221              
222             =head2 is_not_identical
223              
224             my $unequal = is_not_identical( $lhs, $rhs );
225              
226             A function version of the C<≢> operator.
227              
228             =cut
229              
230             =head1 AUTHOR
231              
232             Paul Evans
233              
234             =cut
235              
236             0x55AA;