1*5759b3d2Safresh1#!/usr/bin/perl -w 2*5759b3d2Safresh1 3*5759b3d2Safresh1use strict; 4*5759b3d2Safresh1 5*5759b3d2Safresh1use Test::More tests => 13; 6*5759b3d2Safresh1 7*5759b3d2Safresh1{ 8*5759b3d2Safresh1 package Bar; 9*5759b3d2Safresh1 10*5759b3d2Safresh1 sub new { 11*5759b3d2Safresh1 my $class = shift; 12*5759b3d2Safresh1 return bless {@_}, $class; 13*5759b3d2Safresh1 } 14*5759b3d2Safresh1 15*5759b3d2Safresh1 16*5759b3d2Safresh1 package Foo; 17*5759b3d2Safresh1 our @ISA = qw(Bar); 18*5759b3d2Safresh1} 19*5759b3d2Safresh1 20*5759b3d2Safresh1{ 21*5759b3d2Safresh1 my $obj = new_ok("Foo"); 22*5759b3d2Safresh1 is_deeply $obj, {}; 23*5759b3d2Safresh1 isa_ok $obj, "Foo"; 24*5759b3d2Safresh1 25*5759b3d2Safresh1 $obj = new_ok("Bar"); 26*5759b3d2Safresh1 is_deeply $obj, {}; 27*5759b3d2Safresh1 isa_ok $obj, "Bar"; 28*5759b3d2Safresh1 29*5759b3d2Safresh1 $obj = new_ok("Foo", [this => 42]); 30*5759b3d2Safresh1 is_deeply $obj, { this => 42 }; 31*5759b3d2Safresh1 isa_ok $obj, "Foo"; 32*5759b3d2Safresh1 33*5759b3d2Safresh1 $obj = new_ok("Foo", [], "Foo"); 34*5759b3d2Safresh1 is_deeply $obj, {}; 35*5759b3d2Safresh1 isa_ok $obj, "Foo"; 36*5759b3d2Safresh1} 37*5759b3d2Safresh1 38*5759b3d2Safresh1# And what if we give it nothing? 39*5759b3d2Safresh1eval { 40*5759b3d2Safresh1 new_ok(); 41*5759b3d2Safresh1}; 42*5759b3d2Safresh1is $@, sprintf "new_ok() must be given at least a class at %s line %d.\n", $0, __LINE__ - 2; 43