TER1 (Statement): 100.00%
TER2 (Branch): 100.00%
TER3 (LCSAJ): 100.0% (3/3)
Approximate LCSAJ segments: 19
● Covered — this LCSAJ path was executed during testing.
● Not covered — this LCSAJ path was never executed. These are the paths to focus on.
Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows:
start → end → jump
Uncovered paths show [NOT COVERED] in the tooltip.
1: package Sub::Abstract; 2: 3: # Minimum required Perl version: 5.8 (Attribute::Handlers became core in 5.8). 4: use 5.008; 5: use strict; 6: use warnings; 7: use autodie qw(:all); 8: 9: use Attribute::Handlers; 10: use Carp qw(croak carp); # carp reserved for future non-fatal paths 11: use Readonly; 12: use Params::Validate::Strict 0.33 qw(validate_strict); 13: use Return::Set qw(set_return); 14: 15: # NOTE: Params::Get is available for any future method that accepts named 16: # parameters. import() uses a positional calling convention imposed by 17: # Perl's "use" mechanism and therefore cannot use named params. 18: 19: =head1 NAME 20: 21: Sub::Abstract - Abstract (virtual) methods for plain-Perl OO 22: 23: =head1 VERSION 24: 25: Version 0.01 26: 27: =cut 28: 29: our $VERSION = '0.01'; 30: 31: # --------------------------------------------------------------------------- 32: # Constants 33: # --------------------------------------------------------------------------- 34: 35: # Self-referential constant: the canonical name of this package. 36: Readonly::Scalar my $SELF => __PACKAGE__; 37: 38: # Validation schema for a single Perl sub name passed to import(). 39: # Matches any legal Perl identifier: starts with _ or letter, then \w*. 40: Readonly::Scalar my $SUB_NAME_SCHEMA => { 41: name => { 42: type => 'string', 43: regex => qr/\A[_a-zA-Z]\w*\z/, 44: } 45: }; 46: 47: # --------------------------------------------------------------------------- 48: # Public variables 49: # --------------------------------------------------------------------------- 50: 51: # Set to a true value to suppress all abstract-method croaks globally. 52: # Always use 'local' in tests to prevent state from bleeding between cases. 53: our $BYPASS = 0; 54: 55: # Runtime tunables. Modify $config{harness_bypass} to control whether 56: # HARNESS_ACTIVE suppresses enforcement. May be extended in future releases. 57: our %config = ( 58: harness_bypass => 1, # 1 = suppress croaks when HARNESS_ACTIVE is set 59: ); 60: 61: # --------------------------------------------------------------------------- 62: # Internal state 63: # --------------------------------------------------------------------------- 64: 65: # Pending (owner_pkg, sub_name) pairs queued by import() during compilation. 66: # Populated before CHECK fires; consumed and cleared by the CHECK block. 67: my @_pending; 68: 69: # Becomes 1 once the CHECK block has fired. 70: # import() consults this to decide whether to queue or wrap immediately. 71: my $_post_check = 0; 72: 73: # --------------------------------------------------------------------------- 74: # ATTRIBUTE HANDLER 75: # --------------------------------------------------------------------------- 76: 77: # UNIVERSAL::Abstract :ATTR(CODE,CHECK) 78: # Purpose : Replace any sub decorated with :Abstract with the croak 79: # closure returned by _wrap(). Fires once per decorated sub 80: # at CHECK time, after all subs in all packages are compiled. 81: # Entry : Invoked by Attribute::Handlers with six positional args: 82: # $package -- the package in which the sub was declared 83: # $symbol -- the typeglob for the sub 84: # $referent -- the CODE ref (stub body; discarded) 85: # $attr -- the attribute name ('Abstract') 86: # $data -- attribute arguments (undef for :Abstract) 87: # $phase -- 'CHECK' 88: # Exit status : Returns nothing (void); replaces *{$symbol} in the stash. 89: # Side effects : Overwrites the CODE slot for $symbol in $package's stash. 90: # Notes : Compiled inside Sub::Abstract so that caller(1) inside 91: # _assert_private_caller resolves to Sub::Abstract rather 92: # than the calling package -- allowing the guard to pass. 93: # Installing :Abstract in UNIVERSAL gives all packages access 94: # after a single "use Sub::Abstract", at the cost of global 95: # namespace pollution (see KNOWN LIMITATIONS). 96: # $referent, $attr, $data, $phase are received but unused; 97: # they are named for documentation clarity only. 98: sub UNIVERSAL::Abstract :ATTR(CODE,CHECK) { 99: my ($package, $symbol, undef, undef, undef, undef) = @_; 100: 101: # Extract the bare sub name from the typeglob, then replace the glob. 102: my $sub_name = *{$symbol}{NAME}; 103: no warnings 'redefine'; 104: *{$symbol} = _wrap($package, $sub_name); 105: return; 106: } 107: 108: # --------------------------------------------------------------------------- 109: # PUBLIC INTERFACE 110: # --------------------------------------------------------------------------- 111: 112: =head1 SYNOPSIS 113: 114: package Animal; 115: use Sub::Abstract; 116: 117: # Attribute form (stub body required for Attribute::Handlers) 118: sub speak :Abstract { } 119: sub eat :Abstract { } 120: 121: # Declarative form (no stub body needed) 122: use Sub::Abstract qw(speak eat); 123: 124: package Dog; 125: our @ISA = ('Animal'); 126: sub speak { 'Woof' } # satisfies the contract; wrapper never fires 127: # forgot eat -- runtime croak when called 128: 129: =head1 DESCRIPTION 130: 131: Enforces abstract (virtual) method contracts for plain-Perl OO without 132: requiring Moose or Moo. A subroutine decorated with C<:Abstract> (or 133: named in C<use Sub::Abstract qw(...)>) is replaced at C<CHECK> time with 134: a wrapper that C<Carp::croak>s whenever it is reached. 135: 136: Perl's MRO ensures the wrapper is only reached when no subclass in the 137: call chain has provided an implementation: if C<Dog::speak> exists, the 138: wrapper installed in C<Animal::speak> is never called. 139: 140: This module is only meaningful for plain-Perl OO or packages that do not 141: use a full object framework. Moo and Moose handle abstract/required 142: methods in their own object systems. 143: 144: =head2 Two usage forms 145: 146: =over 4 147: 148: =item Attribute form (preferred) 149: 150: sub speak :Abstract { } 151: 152: The C<:Abstract> attribute is registered in C<UNIVERSAL> via 153: L<Attribute::Handlers> when C<Sub::Abstract> is loaded, so every package 154: has access to it without further C<use> or inheritance. A stub body 155: (even an empty one) is required because C<Attribute::Handlers> needs a 156: C<CODE> ref. The stub is replaced at C<CHECK> time. 157: 158: =item Declarative form 159: 160: use Sub::Abstract qw(speak eat); 161: 162: Each named method is installed as an abstract-croak wrapper at C<CHECK> 163: time (or immediately if the module is loaded past C<CHECK>). No stub body 164: is needed. 165: 166: =back 167: 168: =head2 Bypass for testing 169: 170: Either condition alone (OR logic) suppresses the croak at call time: 171: 172: =over 4 173: 174: =item * C<$Sub::Abstract::BYPASS> set to a true value. Use C<local> in tests. 175: Checked first; short-circuits the second condition. 176: 177: =item * C<$ENV{HARNESS_ACTIVE}> set (the convention used by L<Test::Harness>/prove) 178: B<and> C<$config{harness_bypass}> is truthy (the default). 179: 180: =back 181: 182: The C<HARNESS_ACTIVE> bypass can be disabled: 183: 184: $Sub::Abstract::config{harness_bypass} = 0; 185: 186: B<Important:> setting C<$BYPASS> to any truthy value takes full precedence. 187: Even with C<harness_bypass = 0>, a truthy C<$BYPASS> still suppresses the 188: croak. The two guards use C<||> (short-circuit OR) and C<$BYPASS> is 189: checked first. See L</Bypass precedence> under KNOWN LIMITATIONS. 190: 191: =head2 Error message format 192: 193: speak() is an abstract method of Animal and must be implemented by Dog 194: 195: =head1 PUBLIC INTERFACE 196: 197: =head2 import 198: 199: use Sub::Abstract; # attribute form -- no arguments 200: use Sub::Abstract qw(speak eat); # declarative form 201: 202: =head3 Purpose 203: 204: With B<no arguments>: loads the module and makes the C<:Abstract> attribute 205: globally available via C<UNIVERSAL>. No stash entries are modified. 206: 207: With B<one or more method names>: installs abstract-croak wrappers for 208: those methods in the calling package. Wrappers are installed at C<CHECK> 209: time when called during compilation, or immediately when called after 210: C<CHECK> has fired. Validation is fail-fast and all-or-nothing: if any 211: name is invalid the entire call croaks before touching the stash. 212: 213: =head3 Arguments 214: 215: =over 4 216: 217: =item C<$class> (required, implicit via C<use>) 218: 219: The invocant. Always C<'Sub::Abstract'> in normal usage; not validated 220: because Perl's C<use> mechanism enforces it. 221: 222: =item C<@methods> (optional) 223: 224: Zero or more Perl sub names, each matching C</\A[_a-zA-Z]\w*\z/>. 225: An undef or reference in this list is coerced to the empty string before 226: validation, producing a clear identifier-mismatch error. 227: 228: =back 229: 230: =head3 Returns 231: 232: The class name (C<'Sub::Abstract'>) as a plain string. All call paths 233: return this value, consistent with the sister modules C<Sub::Private> 234: and C<Sub::Protected>. 235: 236: =head3 Example 237: 238: package MyBase; 239: use Sub::Abstract qw(render serialize); 240: 241: package MyConcrete; 242: our @ISA = ('MyBase'); 243: sub render { ... } # satisfies render contract 244: sub serialize { ... } # satisfies serialize contract 245: 246: # MyBase->new->render croaks; MyConcrete->new->render does not. 247: 248: =head3 API SPECIFICATION 249: 250: =head4 Input 251: 252: # import() uses positional arguments imposed by Perl's "use" mechanism; 253: # named parameters are not applicable here. 254: # Each element of @methods is validated individually against: 255: { 256: name => { 257: type => 'string', 258: regex => qr/\A[_a-zA-Z]\w*\z/, 259: } 260: } 261: 262: =head4 Output 263: 264: { type => 'string' } # always returns the class name ('Sub::Abstract') 265: 266: =head3 PSEUDOCODE 267: 268: import($class, @methods): 269: IF @methods is empty 270: RETURN class name # attribute form; nothing to install 271: FOR EACH name in @methods 272: coerce undef/ref to empty string 273: validate against /\A[_a-zA-Z]\w*\z/ via validate_strict() 274: CROAK if invalid # fail-fast; no stash modification 275: END FOR 276: owner_pkg <- caller package 277: IF post_check flag is set # CHECK has already fired 278: FOR EACH name: _process_one(owner_pkg, name) 279: ELSE # still compiling; queue for CHECK 280: FOR EACH name: push [owner_pkg, name] onto @_pending 281: END IF 282: RETURN class name 283: 284: =head3 MESSAGES 285: 286: Message Meaning / Action 287: ------- ---------------- 288: Sub::Abstract->import: 'NAME' is not a valid NAME failed the identifier regex 289: Perl identifier /\A[_a-zA-Z]\w*\z/. Common causes: 290: leading digit, hyphen, non-ASCII 291: character, undef passed where a name 292: was expected, or a reference in the 293: list. Action: inspect the argument 294: list passed to "use Sub::Abstract 295: qw(...)". 296: 297: =cut 298: 299: sub import { ●300 → 304 → 344●300 → 304 → 0 300: my ($class, @subs) = @_; 301: 302: # Only do stash work when sub names were actually supplied. 303: # With no arguments the :Abstract attribute is already globally available. 304: if (@subs) {Mutants (Total: 1, Killed: 1, Survived: 0)
305: # Validate every name before touching the stash. 306: # Fail fast, all-or-nothing: no partial wrapping on bad input. 307: for my $sub_name (@subs) { 308: # Coerce undef and references to empty string so the validator 309: # produces a meaningful "'' is not a valid identifier" message. 310: my $check = (defined $sub_name && !ref $sub_name) ? $sub_name : q{}; 311: 312: # BUG FIX: use the "eval { ...; 1 } or do { $err = $@ }" pattern 313: # rather than "eval { ... }; croak if $@". A DESTROY method fired 314: # between the eval and the $@ test can overwrite $@, causing the 315: # error to be silently swallowed or a wrong message to be reported. 316: my $ok = eval { 317: validate_strict( 318: schema => $SUB_NAME_SCHEMA, 319: input => { name => $check }, 320: ); 321: 1; 322: }; 323: croak "$SELF->import: '$check' is not a valid Perl identifier" 324: unless $ok; 325: } 326: 327: # Decide whether to wrap immediately or queue for CHECK. 328: my $owner_pkg = caller; 329: if ($_post_check) {
330: # CHECK has already fired: install wrappers directly into the stash. 331: for my $sub_name (@subs) { 332: _process_one($owner_pkg, $sub_name); 333: } 334: } 335: else { 336: # Still in compilation: queue each pair for CHECK to drain. 337: for my $sub_name (@subs) { 338: push @_pending, [ $owner_pkg, $sub_name ]; 339: } 340: } 341: } 342: 343: # Single return path: consistent with Sub::Private and Sub::Protected. ●344 → 344 → 0 344: return set_return($class, { type => 'string' }); 345: } 346: 347: # --------------------------------------------------------------------------- 348: # CHECK-TIME PROCESSING 349: # --------------------------------------------------------------------------- 350: 351: # CHECK block. 352: # Purpose : Drain @_pending (all import() calls queued during compilation) 353: # and mark the module post-CHECK so future import() calls wrap 354: # immediately rather than queuing. 355: # Ordering note: $_post_check is set to 1 BEFORE @_pending is drained. 356: # This means if _process_one were ever to trigger import() 357: # (it does not in practice), that nested import() would call 358: # _process_one directly rather than re-queuing. 359: # The _assert_private_caller guard inside _process_one is 360: # satisfied because this CHECK block is compiled inside 361: # Sub::Abstract: caller(1) resolves to Sub::Abstract. 362: CHECK { 363: $_post_check = 1; 364: _process_one(@{$_}) for @_pending; 365: @_pending = (); 366: } 367: 368: # --------------------------------------------------------------------------- 369: # PRIVATE SUBROUTINES 370: # --------------------------------------------------------------------------- 371: 372: # _process_one 373: # Purpose : Install an abstract-croak wrapper for one named method in 374: # a given package. 375: # Entry : $owner_pkg -- the package declaring the abstract method 376: # $sub_name -- unqualified method name (a valid identifier) 377: # Exit status : Returns nothing (void); the package stash is modified. 378: # Side effects : Overwrites *{"${owner_pkg}::${sub_name}"} with the closure 379: # returned by _wrap(). Creates the glob entry if it does not 380: # yet exist (the declarative form requires no pre-existing stub). 381: # Notes : Unlike Sub::Private::_process_one there is no pre-existence 382: # check: abstract methods in the declarative form have no body. 383: # Protected by _assert_private_caller (via the bypass guard) 384: # so that external callers cannot invoke this directly. 385: sub _process_one { 386: my ($owner_pkg, $sub_name) = @_; 387: 388: # Guard: only Sub::Abstract itself may call this. 389: # Bypass is active under the test harness or when $BYPASS is set. 390: _assert_private_caller('_process_one') 391: unless $BYPASS || ($config{harness_bypass} && $ENV{HARNESS_ACTIVE}); 392: 393: # Install the wrapper; suppress redefine warnings for the attribute form. 394: no strict 'refs'; 395: no warnings 'redefine'; 396: *{"${owner_pkg}::${sub_name}"} = _wrap($owner_pkg, $sub_name); 397: return; 398: } 399: 400: # _wrap 401: # Purpose : Build and return the abstract-enforcement closure for one 402: # method. The closure croaks with a message naming both the 403: # abstract owner package and the concrete invocant class. 404: # Entry : $owner_pkg -- the package declaring the abstract method 405: # $sub_name -- unqualified method name (for error messages) 406: # Exit status : Returns a new CODE ref (the enforcement wrapper). 407: # Side effects : None. The closure captures $owner_pkg and $sub_name by 408: # value; $BYPASS and %config are read at call time (not 409: # capture time), so runtime changes to them take effect. 410: # Notes : No $code argument and no delegation (unlike Sub::Private). 411: # Calling an abstract method is always an error; there is 412: # nothing to delegate to. 413: # Invocant extraction: (ref($_[0]) || $_[0]) // '<undef>' 414: # ref() -- for blessed objects: returns the concrete class 415: # $_[0] -- for class-method calls: the package name string 416: # '<undef>' -- guard against a completely absent invocant 417: # $BYPASS is consulted first (short-circuit ||); setting 418: # harness_bypass=0 does NOT re-enable enforcement while 419: # $BYPASS is truthy (see KNOWN LIMITATIONS). 420: sub _wrap { 421: my ($owner_pkg, $sub_name) = @_; 422: 423: # Guard: same bypass semantics as _process_one. 424: _assert_private_caller('_wrap') 425: unless $BYPASS || ($config{harness_bypass} && $ENV{HARNESS_ACTIVE}); 426: 427: # Return a closure that enforces the abstract contract at call time. 428: return sub { 429: return if $BYPASS; 430: return if $config{harness_bypass} && $ENV{HARNESS_ACTIVE}; 431: my $invocant = ref($_[0]) || $_[0] // '<undef>'; 432: croak "${sub_name}() is an abstract method of ${owner_pkg}" 433: . " and must be implemented by ${invocant}"; 434: }; 435: } 436: 437: # _assert_private_caller 438: # Purpose : Croak if the guarded private method (_wrap or _process_one) 439: # was invoked from outside Sub::Abstract. 440: # Entry : $method_name -- the name of the guarded method (used only 441: # in the error message; not validated). 442: # Exit status : Returns normally when the immediate caller of the guarded 443: # function is Sub::Abstract. Croaks otherwise. 444: # Side effects : May croak. 445: # Notes : Uses caller(1), not caller(0). 446: # Inside _assert_private_caller: 447: # caller(0) = Sub::Abstract (this sub's own frame) 448: # caller(1) = the package that called _wrap/_process_one 449: # For calls from CHECK{} or UNIVERSAL::Abstract (both compiled 450: # inside Sub::Abstract), caller(1) = Sub::Abstract -- allowed. 451: # For direct external calls to _wrap or _process_one, caller(1) 452: # is the calling package -- denied unless bypass is active. 453: # The '//' fallback to q{} handles the pathological case where 454: # caller(1) returns undef (top-level call outside any sub); 455: # this path is practically unreachable in production. 456: # This guard is a lint tool, not a security fence: code that 457: # injects a sub into the Sub::Abstract namespace can defeat it 458: # (see KNOWN LIMITATIONS). 459: sub _assert_private_caller { 460: my $method_name = $_[0]; 461: my $caller = (caller(1))[0] // q{}; 462: 463: # Single conditional croak; one return at the bottom. 464: croak "${method_name}() is a private method of $SELF" 465: . " and cannot be called from ${caller}" 466: unless $caller eq $SELF; 467: return; 468: } 469: 470: 1; 471: 472: __END__ 473: 474: =head1 KNOWN LIMITATIONS 475: 476: =over 4 477: 478: =item Runtime-only enforcement 479: 480: Checks are runtime only. There is no compile-time scan of C<@ISA> trees 481: to verify that all abstract methods are implemented -- that would require 482: knowing all subclasses at compile time, which is not possible in general 483: Perl. A future C<use Sub::Abstract -verify> pragma (walking C<@ISA> at 484: C<INIT> time) is under consideration. 485: 486: =item C<can()> returns the croak-stub 487: 488: Because the stash entry is replaced with a wrapper closure, 489: C<< Animal->can('speak') >> returns the wrapper (a truthy CODE ref) rather 490: than C<undef>. Code that duck-types on C<can()> will silently believe the 491: abstract method is implemented and then crash when it is called. A future 492: release may add a caller-aware C<can()> override. 493: 494: =item UNIVERSAL namespace pollution 495: 496: The C<:Abstract> attribute is installed in C<UNIVERSAL>, which means 497: C<UNIVERSAL::Abstract> is added to the global namespace for the lifetime of 498: the process. Any code loaded after C<Sub::Abstract> can use C<:Abstract> 499: without a C<use Sub::Abstract> statement, which can be surprising in large 500: codebases. 501: 502: =item Bypass precedence 503: 504: The enforcement guard is C<$BYPASS || ($config{harness_bypass} && 505: $ENV{HARNESS_ACTIVE})>. Because C<$BYPASS> is checked first with 506: short-circuit C<||>, setting C<$config{harness_bypass} = 0> does B<not> 507: re-enable enforcement when C<$BYPASS> is truthy. To test enforcement 508: inside a harness you must set both: 509: 510: local $Sub::Abstract::BYPASS = 0; 511: local $Sub::Abstract::config{harness_bypass} = 0; 512: 513: =item Thread safety 514: 515: C<@_pending> and C<$_post_check> are package-global lexicals. Concurrent 516: threads loading modules that call C<import()> before C<CHECK> fires may 517: race on these variables. This module is not safe for concurrent use 518: across threads during the compilation phase. 519: 520: =item DESTROY and Perl 5.42+ 521: 522: On Perl 5.42 and later, exceptions thrown inside C<DESTROY> are not 523: propagated to the caller -- Perl emits a C<(in cleanup)> message to STDERR 524: instead. If a class marks C<DESTROY> as abstract, the enforcement croak 525: will be silently discarded rather than propagating. Test with C<lives_ok>, 526: not C<throws_ok>, for C<DESTROY> paths on modern Perl. 527: 528: =item _assert_private_caller is a lint tool, not a security fence 529: 530: Injecting a subroutine directly into the C<Sub::Abstract> namespace (via 531: glob assignment C<*Sub::Abstract::injected = sub { ... }>) defeats the 532: C<caller(1)> check because the injected sub runs inside the C<Sub::Abstract> 533: package. The guard deters accidental misuse; it does not prevent deliberate 534: circumvention. 535: 536: =item Not for Moo/Moose 537: 538: Moo and Moose handle required/abstract methods in their own object systems. 539: This module is for plain-Perl OO only. 540: 541: =back 542: 543: =head1 BUGS 544: 545: =over 4 546: 547: =item eval/$@ clobber race (fixed in current release) 548: 549: The original validation loop used: 550: 551: eval { validate_strict(...) }; 552: croak "..." if $@; 553: 554: A C<DESTROY> method invoked between the C<eval> and the C<if ($@)> test 555: could overwrite C<$@>, causing the validation error to be silently dropped 556: or replaced with an unrelated message. 557: 558: B<Fix:> the current code uses: 559: 560: my $ok = eval { validate_strict(...); 1 }; 561: croak "..." unless $ok; 562: 563: The success flag C<$ok> is set inside the C<eval> itself and is unaffected 564: by any C<DESTROY> calls that occur after the C<eval> exits. 565: 566: =item Implicit $_ in postfix for (fixed in current release) 567: 568: The original dispatch branches used implicit C<$_> as the iterator: 569: 570: _process_one($owner_pkg, $_) for @subs; 571: push @_pending, [ $owner_pkg, $_ ] for @subs; 572: 573: While postfix C<for> does localize C<$_>, the implicit iterator makes it 574: harder to audit whether the caller's C<$_> is preserved and obscures the 575: intent. 576: 577: B<Fix:> both loops now use explicit named variables: 578: 579: for my $sub_name (@subs) { _process_one($owner_pkg, $sub_name) } 580: for my $sub_name (@subs) { push @_pending, [ $owner_pkg, $sub_name ] } 581: 582: =item Duplicate set_return call (fixed in current release) 583: 584: The original C<import()> called C<set_return($class, ...)> on two separate 585: return paths (an early return for the no-args case and the normal return). 586: This is a minor inefficiency and a maintenance hazard: any future change to 587: the return schema must be applied in two places. 588: 589: B<Fix:> C<import()> now has a single C<return set_return(...)> statement at 590: the end; the no-args case falls through to it via a conditional block. 591: 592: =back 593: 594: =head1 FORMAL SPECIFICATION 595: 596: The following schemas formally specify the C<AbstractCroak> operation 597: and the compile-time registration state. 598: 599: -- Type abbreviations 600: Package == seq CHAR -- a non-empty Perl package name string 601: SubName == seq CHAR -- a Perl identifier string 602: 603: -- System state (runtime) 604: +-Registry--------------------------------------------+ 605: | abstract : P (Package x SubName) | 606: | bypass : BOOL | 607: | config : { harness_bypass : BOOL } | 608: +-----------------------------------------------------+ 609: 610: -- Initial state 611: +-InitRegistry----------------------------------------+ 612: | Registry | 613: |-----------------------------------------------------| 614: | abstract = {} | 615: | bypass = false | 616: | config = { harness_bypass |-> true } | 617: +-----------------------------------------------------+ 618: 619: -- Bypass predicate (OR logic; $BYPASS checked first) 620: bypass_active(R) <=> 621: R.bypass 622: or (R.config.harness_bypass and HARNESS_ACTIVE) 623: 624: -- AbstractCroak: fires when the wrapper is reached 625: -- (Perl MRO guarantees no subclass override exists) 626: +-AbstractCroak---------------------------------------+ 627: | Xi-Registry | 628: | invocant? : Package | 629: | owner? : Package | 630: | name? : SubName | 631: |-----------------------------------------------------| 632: | (owner?, name?) in abstract | 633: | not bypass_active => | 634: | croak("name?()" ++ " is an abstract method of " | 635: | ++ owner? ++ " and must be implemented by" | 636: | ++ invocant?) | 637: +-----------------------------------------------------+ 638: 639: -- Key difference from Sub::Private / Sub::Protected: 640: -- No caller check is performed inside the wrapper. 641: -- Reaching the wrapper already proves no subclass 642: -- provided an implementation (MRO guarantees this). 643: 644: =head1 DEPENDENCIES 645: 646: L<Carp> (core), 647: L<Attribute::Handlers> (core since 5.8), 648: L<Readonly>, 649: L<Params::Validate::Strict>, 650: L<Return::Set>. 651: 652: =head1 SEE ALSO 653: 654: =over 4 655: 656: =item * L<Test Dashboard|https://nigelhorne.github.io/Sub-Abstract/coverage/> 657: 658: =item * L<Class::Abstract> 659: 660: Sister module: enforces abstract classes. 661: Pair with C<Sub::Abstract> to create fully enforced abstract base classes. 662: 663: =item * L<Sub::Private> 664: 665: Sister module enforcing strictly private (owner-only) access. 666: 667: =item * L<Sub::Protected> 668: 669: Sister module enforcing protected (owner + subclass) access. 670: 671: =back 672: 673: =head1 PUBLIC VARIABLES 674: 675: =head2 C<$BYPASS> 676: 677: Set to a true value to disable the abstract-method croak for all wrapped 678: subs. Use C<local> in tests: 679: 680: local $Sub::Abstract::BYPASS = 1; 681: 682: B<Warning:> any truthy value (including strings like C<"false">, C<"off">, 683: C<"no">) enables bypass, because Perl's truthiness is not English. 684: 685: =head2 C<%config> 686: 687: =over 4 688: 689: =item C<harness_bypass> (default: 1) 690: 691: When true, the abstract-method croak is suppressed whenever 692: C<$ENV{HARNESS_ACTIVE}> is set (the convention used by L<Test::Harness>/prove). 693: Set to 0 to test enforcement from within a test harness. 694: 695: Note that C<$BYPASS> takes precedence: see L</Bypass precedence> under 696: KNOWN LIMITATIONS. 697: 698: =back 699: 700: =head1 AUTHOR 701: 702: Nigel Horne, C<< <njh at nigelhorne.com> >> 703: 704: =head1 LICENCE AND COPYRIGHT 705: 706: Copyright 2026 Nigel Horne. 707: 708: Usage is subject to the GPL2 licence terms. 709: If you use it, please let me know. 710: 711: =cutMutants (Total: 1, Killed: 0, Survived: 1)
- COND_INV_329_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes