1# $Id: 03scalar.t,v 0.19 2006/10/08 03:37:29 ray Exp $ 2# Before `make install' is performed this script should be runnable with 3# `make test'. After `make install' it should work as `perl test.pl' 4 5######################### We start with some black magic to print on failure. 6 7# Change 1..1 below to 1..last_test_to_print . 8# (It may become useful if the test is moved to ./t subdirectory.) 9 10BEGIN { $| = 1; print "1..10\n"; } 11END {print "not ok 1\n" unless $loaded;} 12use Clone qw( clone ); 13use Data::Dumper; 14$loaded = 1; 15print "ok 1\n"; 16 17######################### End of black magic. 18 19# Insert your test code below (better if it prints "ok 13" 20# (correspondingly "not ok 13") depending on the success of chunk 13 21# of the test code): 22 23package Test::Scalar; 24 25use vars @ISA; 26 27@ISA = qw(Clone); 28 29sub new 30 { 31 my $class = shift; 32 my $self = shift; 33 bless \$self, $class; 34 } 35 36sub DESTROY 37 { 38 my $self = shift; 39 # warn "DESTROYING $self"; 40 } 41 42package main; 43 44sub ok { print "ok $test\n"; $test++ } 45sub not_ok { print "not ok $test\n"; $test++ } 46 47$^W = 0; 48$test = 2; 49 50my $a = Test::Scalar->new(1.0); 51my $b = $a->clone(1); 52 53$$a == $$b ? ok : not_ok; 54$a != $b ? ok : not_ok; 55 56my $c = \"test 2 scalar"; 57my $d = Clone::clone($c, 2); 58 59$$c == $$d ? ok : not_ok; 60$c != $d ? ok : not_ok; 61 62my $circ = undef; 63$circ = \$circ; 64$aref = clone($circ); 65Dumper($circ) eq Dumper($aref) ? ok : not_ok; 66 67# the following used to produce a segfault, rt.cpan.org id=2264 68undef $a; 69$b = clone($a); 70$$a == $$b ? ok : not_ok; 71 72# used to get a segfault cloning a ref to a qr data type. 73my $str = 'abcdefg'; 74my $qr = qr/$str/; 75my $qc = clone( $qr ); 76$qr eq $qc ? ok : not_ok; 77$str =~ /$qc/ ? ok : not_ok; 78 79# test for unicode support 80{ 81 my $a = \( chr(256) ); 82 my $b = clone( $a ); 83 ord($$a) == ord($$b) ? ok : not_ok; 84} 85