Replaced Array::new with [ ]
[kakapo:kakapo.git] / t / Pmc / common-methods.nqp
1 # Copyright 2010, Austin Hastings. See accompanying LICENSE file, or 
2 # http://www.opensource.org/licenses/artistic-license-2.0.php for license.
3
4 INIT {
5         # Load the Kakapo library
6         pir::load_language('parrot');
7         my $env := pir::new__PS('Env');
8         my $root_dir := $env<HARNESS_ROOT_DIR> || '.';
9         pir::load_bytecode($root_dir ~ '/library/kakapo_full.pbc');
10 }
11
12 class Test::Pmc::COMMON
13         is UnitTest::Testcase ;
14
15 has $!class;
16         
17 INIT {
18         use(    'UnitTest::Testcase' );
19         use(    'UnitTest::Assertions' );       
20 }
21
22 MAIN();
23
24 sub MAIN() {
25         my $proto := Opcode::get_root_global(pir::get_namespace__P().get_name);
26         $proto.suite.run;
27 }
28
29 method set_up() {
30         my $nsp := P6metaclass.get_parrotclass(self).get_namespace;
31         my $name := $nsp.get_name.pop;
32
33         if $name eq 'COMMON' {
34                 $name := 'Float';       # Fix up so this class runs stand-alone.
35         }
36
37         $!class := P6metaclass.get_proto($name);
38 }
39
40 method test_can() {
41         verify_that( "A 'can' method exists, and returns known results" );
42         my $object := $!class.new;
43         
44         unless Opcode::can($object, 'can') { fail("No 'can' method"); }
45         
46         my @methods := <can clone defined does isa new>;
47         
48         for @methods {
49                 unless $object.can(~ $_) { fail( "No can($_)" ); }
50         }
51 }
52
53 method test_clone() {
54         verify_that( "Clone returns a different, valid object" );
55         my $object := $!class.new;              
56         my $other := $object.clone;
57
58         if $object =:= $other { fail( "Clone returns same object" ); }
59 }
60
61 method test_defined() {
62         verify_that( "Defined returns correct result" );
63         my $object := $!class.new;
64         
65         unless $object.defined { fail( "Object reports not defined" ); }
66 }
67
68 method test_isa() {
69         verify_that( "'isa' returns correct results" );
70         my $object := $!class.new;
71         
72         unless $object.isa($!class) { fail( "Object reports not isa(class)" ); }
73         if $object.isa('Exception') { fail( "Object reports isa(Exception)" ); }
74         if $object.isa('No::Such::Class') { fail( "isa true for bogus class" ); }
75 }
76
77 method test_new() {
78         verify_that( "'new' returns an object of the right type" );             
79         my $object := $!class.new;
80         
81         if Opcode::isnull($object) { fail( "New returned null" ); }
82         unless Opcode::defined($object) { fail( "New returned undef" ); }
83         unless pir::isa($object, Opcode::typeof($!class)) { fail("New returned wrong type"); }
84 }
85