t/type_constraints/util_std_type_constraints.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 use IO::File;
   9 use Moose::Util::TypeConstraints;
  10 use Scalar::Util qw( blessed openhandle );
  11
  12 my $ZERO    = 0;
  13 my $ONE     = 1;
  14 my $INT     = 100;
  15 my $NEG_INT = -100;
  16 my $NUM     = 42.42;
  17 my $NEG_NUM = -42.42;
  18
  19 my $EMPTY_STRING  = q{};
  20 my $STRING        = 'foo';
  21 my $NUM_IN_STRING = 'has 42 in it';
  22
  23 my $SCALAR_REF     = \( my $var );
  24 my $SCALAR_REF_REF = \$SCALAR_REF;
  25 my $ARRAY_REF      = [];
  26 my $HASH_REF       = {};
  27 my $CODE_REF       = sub { };
  28
  29 no warnings 'once';    # << I *hates* that warning ...
  30 my $GLOB     = *GLOB_REF;
  31 my $GLOB_REF = \$GLOB;
  32
  33 open my $FH, '<', $0 or die "Could not open $0 for the test";
  34
  35 my $FH_OBJECT = IO::File->new( $0, 'r' )
  36     or die "Could not open $0 for the test";
  37
  38 my $REGEX = qr/../;
  39 my $REGEX_OBJ = bless qr/../, 'BlessedQR';
  40
  41 my $OBJECT = bless {}, 'Foo';
  42
  43 my $UNDEF = undef;
  44
  45 {
  46     package Thing;
  47
  48     sub foo { }
  49 }
  50
  51 my $CLASS_NAME = 'Thing';
  52
  53 {
  54     package Role;
  55     use Moose::Role;
  56
  57     sub foo { }
  58 }
  59
  60 my $ROLE_NAME = 'Role';
  61
  62 my %tests = (
  63     Any => {
  64         accept => [
  65             $ZERO,
  66             $ONE,
  67             $INT,
  68             $NEG_INT,
  69             $NUM,
  70             $NEG_NUM,
  71             $EMPTY_STRING,
  72             $STRING,
  73             $NUM_IN_STRING,
  74             $SCALAR_REF,
  75             $SCALAR_REF_REF,
  76             $ARRAY_REF,
  77             $HASH_REF,
  78             $CODE_REF,
  79             $GLOB,
  80             $GLOB_REF,
  81             $FH,
  82             $FH_OBJECT,
  83             $REGEX,
  84             $REGEX_OBJ,
  85             $OBJECT,
  86             $UNDEF,
  87         ],
  88     },
  89     Item => {
  90         accept => [
  91             $ZERO,
  92             $ONE,
  93             $INT,
  94             $NEG_INT,
  95             $NUM,
  96             $NEG_NUM,
  97             $EMPTY_STRING,
  98             $STRING,
  99             $NUM_IN_STRING,
 100             $SCALAR_REF,
 101             $SCALAR_REF_REF,
 102             $ARRAY_REF,
 103             $HASH_REF,
 104             $CODE_REF,
 105             $GLOB,
 106             $GLOB_REF,
 107             $FH,
 108             $FH_OBJECT,
 109             $REGEX,
 110             $REGEX_OBJ,
 111             $OBJECT,
 112             $UNDEF,
 113         ],
 114     },
 115     Defined => {
 116         accept => [
 117             $ZERO,
 118             $ONE,
 119             $INT,
 120             $NEG_INT,
 121             $NUM,
 122             $NEG_NUM,
 123             $EMPTY_STRING,
 124             $STRING,
 125             $NUM_IN_STRING,
 126             $SCALAR_REF,
 127             $SCALAR_REF_REF,
 128             $ARRAY_REF,
 129             $HASH_REF,
 130             $CODE_REF,
 131             $GLOB,
 132             $GLOB_REF,
 133             $FH,
 134             $FH_OBJECT,
 135             $REGEX,
 136             $REGEX_OBJ,
 137             $OBJECT,
 138         ],
 139         reject => [
 140             $UNDEF,
 141         ],
 142     },
 143     Undef => {
 144         accept => [
 145             $UNDEF,
 146         ],
 147         reject => [
 148             $ZERO,
 149             $ONE,
 150             $INT,
 151             $NEG_INT,
 152             $NUM,
 153             $NEG_NUM,
 154             $EMPTY_STRING,
 155             $STRING,
 156             $NUM_IN_STRING,
 157             $SCALAR_REF,
 158             $SCALAR_REF_REF,
 159             $ARRAY_REF,
 160             $HASH_REF,
 161             $CODE_REF,
 162             $GLOB,
 163             $GLOB_REF,
 164             $FH,
 165             $FH_OBJECT,
 166             $REGEX,
 167             $REGEX_OBJ,
 168             $OBJECT,
 169         ],
 170     },
 171     Bool => {
 172         accept => [
 173             $ZERO,
 174             $ONE,
 175             $EMPTY_STRING,
 176             $UNDEF,
 177         ],
 178         reject => [
 179             $INT,
 180             $NEG_INT,
 181             $NUM,
 182             $NEG_NUM,
 183             $STRING,
 184             $NUM_IN_STRING,
 185             $SCALAR_REF,
 186             $SCALAR_REF_REF,
 187             $ARRAY_REF,
 188             $HASH_REF,
 189             $CODE_REF,
 190             $GLOB,
 191             $GLOB_REF,
 192             $FH,
 193             $FH_OBJECT,
 194             $REGEX,
 195             $REGEX_OBJ,
 196             $OBJECT,
 197         ],
 198     },
 199     Maybe => {
 200         accept => [
 201             $ZERO,
 202             $ONE,
 203             $INT,
 204             $NEG_INT,
 205             $NUM,
 206             $NEG_NUM,
 207             $EMPTY_STRING,
 208             $STRING,
 209             $NUM_IN_STRING,
 210             $SCALAR_REF,
 211             $SCALAR_REF_REF,
 212             $ARRAY_REF,
 213             $HASH_REF,
 214             $CODE_REF,
 215             $GLOB,
 216             $GLOB_REF,
 217             $FH,
 218             $FH_OBJECT,
 219             $REGEX,
 220             $REGEX_OBJ,
 221             $OBJECT,
 222             $UNDEF,
 223         ],
 224     },
 225     Value => {
 226         accept => [
 227             $ZERO,
 228             $ONE,
 229             $INT,
 230             $NEG_INT,
 231             $NUM,
 232             $NEG_NUM,
 233             $EMPTY_STRING,
 234             $STRING,
 235             $NUM_IN_STRING,
 236             $GLOB,
 237         ],
 238         reject => [
 239             $SCALAR_REF,
 240             $SCALAR_REF_REF,
 241             $ARRAY_REF,
 242             $HASH_REF,
 243             $CODE_REF,
 244             $GLOB_REF,
 245             $FH,
 246             $FH_OBJECT,
 247             $REGEX,
 248             $REGEX_OBJ,
 249             $OBJECT,
 250             $UNDEF,
 251         ],
 252     },
 253     Ref => {
 254         accept => [
 255             $SCALAR_REF,
 256             $SCALAR_REF_REF,
 257             $ARRAY_REF,
 258             $HASH_REF,
 259             $CODE_REF,
 260             $GLOB_REF,
 261             $FH,
 262             $FH_OBJECT,
 263             $REGEX,
 264             $REGEX_OBJ,
 265             $OBJECT,
 266         ],
 267         reject => [
 268             $ZERO,
 269             $ONE,
 270             $INT,
 271             $NEG_INT,
 272             $NUM,
 273             $NEG_NUM,
 274             $EMPTY_STRING,
 275             $STRING,
 276             $NUM_IN_STRING,
 277             $GLOB,
 278             $UNDEF,
 279         ],
 280     },
 281     Num => {
 282         accept => [
 283             $ZERO,
 284             $ONE,
 285             $INT,
 286             $NEG_INT,
 287             $NUM,
 288             $NEG_NUM,
 289         ],
 290         reject => [
 291             $EMPTY_STRING,
 292             $STRING,
 293             $NUM_IN_STRING,
 294             $SCALAR_REF,
 295             $SCALAR_REF_REF,
 296             $ARRAY_REF,
 297             $HASH_REF,
 298             $CODE_REF,
 299             $GLOB,
 300             $GLOB_REF,
 301             $FH,
 302             $FH_OBJECT,
 303             $REGEX,
 304             $REGEX_OBJ,
 305             $OBJECT,
 306             $UNDEF,
 307         ],
 308     },
 309     Int => {
 310         accept => [
 311             $ZERO,
 312             $ONE,
 313             $INT,
 314             $NEG_INT,
 315         ],
 316         reject => [
 317             $NUM,
 318             $NEG_NUM,
 319             $EMPTY_STRING,
 320             $STRING,
 321             $NUM_IN_STRING,
 322             $SCALAR_REF,
 323             $SCALAR_REF_REF,
 324             $ARRAY_REF,
 325             $HASH_REF,
 326             $CODE_REF,
 327             $GLOB,
 328             $GLOB_REF,
 329             $FH,
 330             $FH_OBJECT,
 331             $REGEX,
 332             $REGEX_OBJ,
 333             $OBJECT,
 334             $UNDEF,
 335         ],
 336     },
 337     Str => {
 338         accept => [
 339             $ZERO,
 340             $ONE,
 341             $INT,
 342             $NEG_INT,
 343             $NUM,
 344             $NEG_NUM,
 345             $EMPTY_STRING,
 346             $STRING,
 347             $NUM_IN_STRING,
 348         ],
 349         reject => [
 350             $SCALAR_REF,
 351             $SCALAR_REF_REF,
 352             $ARRAY_REF,
 353             $HASH_REF,
 354             $CODE_REF,
 355             $GLOB,
 356             $GLOB_REF,
 357             $FH,
 358             $FH_OBJECT,
 359             $REGEX,
 360             $REGEX_OBJ,
 361             $OBJECT,
 362             $UNDEF,
 363         ],
 364     },
 365     ScalarRef => {
 366         accept => [
 367             $SCALAR_REF,
 368             $SCALAR_REF_REF,
 369         ],
 370         reject => [
 371             $ZERO,
 372             $ONE,
 373             $INT,
 374             $NEG_INT,
 375             $NUM,
 376             $NEG_NUM,
 377             $EMPTY_STRING,
 378             $STRING,
 379             $NUM_IN_STRING,
 380             $ARRAY_REF,
 381             $HASH_REF,
 382             $CODE_REF,
 383             $GLOB,
 384             $GLOB_REF,
 385             $FH,
 386             $FH_OBJECT,
 387             $REGEX,
 388             $REGEX_OBJ,
 389             $OBJECT,
 390             $UNDEF,
 391         ],
 392     },
 393     ArrayRef => {
 394         accept => [
 395             $ARRAY_REF,
 396         ],
 397         reject => [
 398             $ZERO,
 399             $ONE,
 400             $INT,
 401             $NEG_INT,
 402             $NUM,
 403             $NEG_NUM,
 404             $EMPTY_STRING,
 405             $STRING,
 406             $NUM_IN_STRING,
 407             $SCALAR_REF,
 408             $SCALAR_REF_REF,
 409             $HASH_REF,
 410             $CODE_REF,
 411             $GLOB,
 412             $GLOB_REF,
 413             $FH,
 414             $FH_OBJECT,
 415             $REGEX,
 416             $REGEX_OBJ,
 417             $OBJECT,
 418             $UNDEF,
 419         ],
 420     },
 421     HashRef => {
 422         accept => [
 423             $HASH_REF,
 424         ],
 425         reject => [
 426             $ZERO,
 427             $ONE,
 428             $INT,
 429             $NEG_INT,
 430             $NUM,
 431             $NEG_NUM,
 432             $EMPTY_STRING,
 433             $STRING,
 434             $NUM_IN_STRING,
 435             $SCALAR_REF,
 436             $SCALAR_REF_REF,
 437             $ARRAY_REF,
 438             $CODE_REF,
 439             $GLOB,
 440             $GLOB_REF,
 441             $FH,
 442             $FH_OBJECT,
 443             $REGEX,
 444             $REGEX_OBJ,
 445             $OBJECT,
 446             $UNDEF,
 447         ],
 448     },
 449     CodeRef => {
 450         accept => [
 451             $CODE_REF,
 452         ],
 453         reject => [
 454             $ZERO,
 455             $ONE,
 456             $INT,
 457             $NEG_INT,
 458             $NUM,
 459             $NEG_NUM,
 460             $EMPTY_STRING,
 461             $STRING,
 462             $NUM_IN_STRING,
 463             $SCALAR_REF,
 464             $SCALAR_REF_REF,
 465             $ARRAY_REF,
 466             $HASH_REF,
 467             $GLOB,
 468             $GLOB_REF,
 469             $FH,
 470             $FH_OBJECT,
 471             $REGEX,
 472             $REGEX_OBJ,
 473             $OBJECT,
 474             $UNDEF,
 475         ],
 476     },
 477     RegexpRef => {
 478         accept => [
 479             $REGEX,
 480             $REGEX_OBJ,
 481         ],
 482         reject => [
 483             $ZERO,
 484             $ONE,
 485             $INT,
 486             $NEG_INT,
 487             $NUM,
 488             $NEG_NUM,
 489             $EMPTY_STRING,
 490             $STRING,
 491             $NUM_IN_STRING,
 492             $SCALAR_REF,
 493             $SCALAR_REF_REF,
 494             $ARRAY_REF,
 495             $HASH_REF,
 496             $CODE_REF,
 497             $GLOB,
 498             $GLOB_REF,
 499             $FH,
 500             $FH_OBJECT,
 501             $OBJECT,
 502             $UNDEF,
 503         ],
 504     },
 505     GlobRef => {
 506         accept => [
 507             $GLOB_REF,
 508             $FH,
 509         ],
 510         reject => [
 511             $ZERO,
 512             $ONE,
 513             $INT,
 514             $NEG_INT,
 515             $NUM,
 516             $NEG_NUM,
 517             $EMPTY_STRING,
 518             $STRING,
 519             $NUM_IN_STRING,
 520             $SCALAR_REF,
 521             $SCALAR_REF_REF,
 522             $ARRAY_REF,
 523             $HASH_REF,
 524             $CODE_REF,
 525             $GLOB,
 526             $FH_OBJECT,
 527             $OBJECT,
 528             $REGEX,
 529             $REGEX_OBJ,
 530             $UNDEF,
 531         ],
 532     },
 533     FileHandle => {
 534         accept => [
 535             $FH,
 536             $FH_OBJECT,
 537         ],
 538         reject => [
 539             $ZERO,
 540             $ONE,
 541             $INT,
 542             $NEG_INT,
 543             $NUM,
 544             $NEG_NUM,
 545             $EMPTY_STRING,
 546             $STRING,
 547             $NUM_IN_STRING,
 548             $SCALAR_REF,
 549             $SCALAR_REF_REF,
 550             $ARRAY_REF,
 551             $HASH_REF,
 552             $CODE_REF,
 553             $GLOB,
 554             $GLOB_REF,
 555             $OBJECT,
 556             $REGEX,
 557             $REGEX_OBJ,
 558             $UNDEF,
 559         ],
 560     },
 561     Object => {
 562         accept => [
 563             $FH_OBJECT,
 564             $REGEX,
 565             $REGEX_OBJ,
 566             $OBJECT,
 567         ],
 568         reject => [
 569             $ZERO,
 570             $ONE,
 571             $INT,
 572             $NEG_INT,
 573             $NUM,
 574             $NEG_NUM,
 575             $EMPTY_STRING,
 576             $STRING,
 577             $NUM_IN_STRING,
 578             $SCALAR_REF,
 579             $SCALAR_REF_REF,
 580             $ARRAY_REF,
 581             $HASH_REF,
 582             $CODE_REF,
 583             $GLOB,
 584             $GLOB_REF,
 585             $FH,
 586             $UNDEF,
 587         ],
 588     },
 589     ClassName => {
 590         accept => [
 591             $CLASS_NAME,
 592             $ROLE_NAME,
 593         ],
 594         reject => [
 595             $ZERO,
 596             $ONE,
 597             $INT,
 598             $NEG_INT,
 599             $NUM,
 600             $NEG_NUM,
 601             $EMPTY_STRING,
 602             $STRING,
 603             $NUM_IN_STRING,
 604             $SCALAR_REF,
 605             $SCALAR_REF_REF,
 606             $ARRAY_REF,
 607             $HASH_REF,
 608             $CODE_REF,
 609             $GLOB,
 610             $GLOB_REF,
 611             $FH,
 612             $FH_OBJECT,
 613             $REGEX,
 614             $REGEX_OBJ,
 615             $OBJECT,
 616             $UNDEF,
 617         ],
 618     },
 619     RoleName => {
 620         accept => [
 621             $ROLE_NAME,
 622         ],
 623         reject => [
 624             $CLASS_NAME,
 625             $ZERO,
 626             $ONE,
 627             $INT,
 628             $NEG_INT,
 629             $NUM,
 630             $NEG_NUM,
 631             $EMPTY_STRING,
 632             $STRING,
 633             $NUM_IN_STRING,
 634             $SCALAR_REF,
 635             $SCALAR_REF_REF,
 636             $ARRAY_REF,
 637             $HASH_REF,
 638             $CODE_REF,
 639             $GLOB,
 640             $GLOB_REF,
 641             $FH,
 642             $FH_OBJECT,
 643             $REGEX,
 644             $REGEX_OBJ,
 645             $OBJECT,
 646             $UNDEF,
 647         ],
 648     },
 649 );
 650
 651 for my $name ( sort keys %tests ) {
 652     test_constraint( $name, $tests{$name} );
 653 }
 654
 655 {
 656     my $class_tc = class_type('Thing');
 657
 658     test_constraint(
 659         $class_tc, {
 660             accept => [
 661                 ( bless {}, 'Thing' ),
 662             ],
 663             reject => [
 664                 'Thing',
 665                 $ZERO,
 666                 $ONE,
 667                 $INT,
 668                 $NEG_INT,
 669                 $NUM,
 670                 $NEG_NUM,
 671                 $EMPTY_STRING,
 672                 $STRING,
 673                 $NUM_IN_STRING,
 674                 $SCALAR_REF,
 675                 $SCALAR_REF_REF,
 676                 $ARRAY_REF,
 677                 $HASH_REF,
 678                 $CODE_REF,
 679                 $GLOB,
 680                 $GLOB_REF,
 681                 $FH,
 682                 $FH_OBJECT,
 683                 $REGEX,
 684                 $REGEX_OBJ,
 685                 $OBJECT,
 686                 $UNDEF,
 687             ],
 688         }
 689     );
 690 }
 691
 692 {
 693     package Duck;
 694
 695     sub quack {}
 696     sub flap {}
 697 }
 698
 699 {
 700     package DuckLike;
 701
 702     sub quack {}
 703     sub flap {}
 704 }
 705
 706 {
 707     package Bird;
 708
 709     sub flap {}
 710 }
 711
 712 {
 713     my @methods = qw( quack flap );
 714     duck_type 'Duck' => @methods;
 715
 716     test_constraint(
 717         'Duck', {
 718             accept => [
 719                 ( bless {}, 'Duck' ),
 720                 ( bless {}, 'DuckLike' ),
 721             ],
 722             reject => [
 723                 $ZERO,
 724                 $ONE,
 725                 $INT,
 726                 $NEG_INT,
 727                 $NUM,
 728                 $NEG_NUM,
 729                 $EMPTY_STRING,
 730                 $STRING,
 731                 $NUM_IN_STRING,
 732                 $SCALAR_REF,
 733                 $SCALAR_REF_REF,
 734                 $ARRAY_REF,
 735                 $HASH_REF,
 736                 $CODE_REF,
 737                 $GLOB,
 738                 $GLOB_REF,
 739                 $FH,
 740                 $FH_OBJECT,
 741                 $REGEX,
 742                 $REGEX_OBJ,
 743                 $OBJECT,
 744                 ( bless {}, 'Bird' ),
 745                 $UNDEF,
 746             ],
 747         }
 748     );
 749 }
 750
 751 {
 752     my @allowed = qw( bar baz quux );
 753     enum 'Enumerated' => @allowed;
 754
 755     test_constraint(
 756         'Enumerated', {
 757             accept => \@allowed,
 758             reject => [
 759                 $ZERO,
 760                 $ONE,
 761                 $INT,
 762                 $NEG_INT,
 763                 $NUM,
 764                 $NEG_NUM,
 765                 $EMPTY_STRING,
 766                 $STRING,
 767                 $NUM_IN_STRING,
 768                 $SCALAR_REF,
 769                 $SCALAR_REF_REF,
 770                 $ARRAY_REF,
 771                 $HASH_REF,
 772                 $CODE_REF,
 773                 $GLOB,
 774                 $GLOB_REF,
 775                 $FH,
 776                 $FH_OBJECT,
 777                 $REGEX,
 778                 $REGEX_OBJ,
 779                 $OBJECT,
 780                 $UNDEF,
 781             ],
 782         }
 783     );
 784 }
 785
 786 {
 787     my $union = Moose::Meta::TypeConstraint::Union->new(
 788         type_constraints => [
 789             find_type_constraint('Int'),
 790             find_type_constraint('Object'),
 791         ],
 792     );
 793
 794     test_constraint(
 795         $union, {
 796             accept => [
 797                 $ZERO,
 798                 $ONE,
 799                 $INT,
 800                 $NEG_INT,
 801                 $FH_OBJECT,
 802                 $REGEX,
 803                 $REGEX_OBJ,
 804                 $OBJECT,
 805             ],
 806             reject => [
 807                 $NUM,
 808                 $NEG_NUM,
 809                 $EMPTY_STRING,
 810                 $STRING,
 811                 $NUM_IN_STRING,
 812                 $SCALAR_REF,
 813                 $SCALAR_REF_REF,
 814                 $ARRAY_REF,
 815                 $HASH_REF,
 816                 $CODE_REF,
 817                 $GLOB,
 818                 $GLOB_REF,
 819                 $FH,
 820                 $UNDEF,
 821             ],
 822         }
 823     );
 824 }
 825
 826 {
 827     package DoesRole;
 828
 829     use Moose;
 830
 831     with 'Role';
 832 }
 833
 834 # Test how $_ is used in XS implementation
 835 {
 836     local $_ = qr/./;
 837     ok(
 838         Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
 839         '$_ is RegexpRef'
 840     );
 841     ok(
 842         !Moose::Util::TypeConstraints::Builtins::_RegexpRef(1),
 843         '$_ is not read when param provided'
 844     );
 845
 846     $_ = bless qr/./, 'Blessed';
 847
 848     ok(
 849         Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
 850         '$_ is RegexpRef'
 851     );
 852
 853     $_ = 42;
 854     ok(
 855         !Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
 856         '$_ is not RegexpRef'
 857     );
 858     ok(
 859         Moose::Util::TypeConstraints::Builtins::_RegexpRef(qr/./),
 860         '$_ is not read when param provided'
 861     );
 862 }
 863
 864 close $FH
 865     or warn "Could not close the filehandle $0 for test";
 866 $FH_OBJECT->close
 867     or warn "Could not close the filehandle $0 for test";
 868
 869 done_testing;
 870
 871 sub test_constraint {
 872     my $type  = shift;
 873     my $tests = shift;
 874
 875     local $Test::Builder::Level = $Test::Builder::Level + 1;
 876
 877     unless ( blessed $type ) {
 878         $type = Moose::Util::TypeConstraints::find_type_constraint($type)
 879             or BAIL_OUT("No such type $type!");
 880     }
 881
 882     my $name = $type->name;
 883
 884     my $unoptimized
 885         = $type->has_parent
 886         ? $type->_compile_subtype( $type->constraint )
 887         : $type->_compile_type( $type->constraint );
 888
 889     my $inlined;
 890     if ( $type->has_inlined_type_constraint ) {
 891         local $@;
 892         $inlined = eval 'sub { ( ' . $type->_inline_check('$_[0]') . ' ) }';
 893         die $@ if $@;
 894     }
 895
 896     for my $accept ( @{ $tests->{accept} || [] } ) {
 897         my $described = describe($accept);
 898         ok(
 899             $type->check($accept),
 900             "$name accepts $described using ->check"
 901         );
 902         ok(
 903             $unoptimized->($accept),
 904             "$name accepts $described using unoptimized constraint"
 905         );
 906         if ($inlined) {
 907             ok(
 908                 $inlined->($accept),
 909                 "$name accepts $described using inlined constraint"
 910             );
 911         }
 912     }
 913
 914     for my $reject ( @{ $tests->{reject} || [] } ) {
 915         my $described = describe($reject);
 916         ok(
 917             !$type->check($reject),
 918             "$name rejects $described using ->check"
 919         );
 920         ok(
 921             !$unoptimized->($reject),
 922             "$name rejects $described using unoptimized constraint"
 923         );
 924         if ($inlined) {
 925             ok(
 926                 !$inlined->($reject),
 927                 "$name rejects $described using inlined constraint"
 928             );
 929         }
 930     }
 931 }
 932
 933 sub describe {
 934     my $val = shift;
 935
 936     return 'undef' unless defined $val;
 937
 938     if ( !ref $val ) {
 939         return q{''} if $val eq q{};
 940     }
 941
 942     return $val unless ref $val;
 943
 944     return 'open filehandle'
 945         if openhandle $val && !blessed $val;
 946
 947     return blessed $val
 948         ? ( ref $val ) . ' object'
 949         : ( ref $val ) . ' reference';
 950 }