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