t/dynpmc/foo.t

   1 #! perl
   2 # Copyright (C) 2005, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More;
   9 use Parrot::Test tests => 9;
  10 use Parrot::Config;
  11
  12 =head1 NAME
  13
  14 t/dynpmc/foo.t - Test for a very simple dynamic PMC
  15
  16 =head1 SYNOPSIS
  17
  18         % prove t/dynpmc/foo.t
  19
  20 =head1 DESCRIPTION
  21
  22 Tests the Foo PMC.
  23
  24 =cut
  25
  26 pir_output_is( << 'CODE', << 'OUTPUT', "get_integer" );
  27
  28 .sub main :main
  29     loadlib $P1, "foo_group"
  30     $P1 = new "Foo"
  31
  32     $I1 = $P1
  33     print $I1
  34     print "\n"
  35 .end
  36 CODE
  37 42
  38 OUTPUT
  39
  40 pir_output_is( << 'CODE', << 'OUTPUT', "loadlib with relative pathname, no ext" );
  41 .sub main :main
  42     ## load a relative pathname without the extension.  loadlib will convert the
  43     ## '/' characters to '\\' on windows.
  44     $S0 = "runtime/parrot/dynext/foo_group"
  45     loadlib $P1, $S0
  46
  47     ## ensure that we can still make Foo instances.
  48     $P1 = new "Foo"
  49     $I1 = $P1
  50     print $I1
  51     print "\n"
  52 .end
  53 CODE
  54 42
  55 OUTPUT
  56
  57 pir_output_is( << 'CODE', << 'OUTPUT', "loadlib with absolute pathname, no ext" );
  58 .sub main :main
  59     ## get cwd in $S0.
  60     .include "iglobals.pasm"
  61     $P11 = getinterp
  62     $P12 = $P11[.IGLOBALS_CONFIG_HASH]
  63     $S0 = $P12["prefix"]
  64
  65     ## convert cwd to an absolute pathname without the extension, and load it.
  66     ## this should always find the version in the build directory, since that's
  67     ## the only place "make test" will work.
  68     $S0 = concat "/runtime/parrot/dynext/foo_group"
  69     loadlib $P1, $S0
  70
  71     ## ensure that we can still make Foo instances.
  72     $P1 = new "Foo"
  73     $I1 = $P1
  74     print $I1
  75     print "\n"
  76 .end
  77 CODE
  78 42
  79 OUTPUT
  80
  81 pir_output_is( << 'CODE', << 'OUTPUT', "loadlib with relative pathname & ext" );
  82 .sub main :main
  83     ## get load_ext in $S0.
  84     .include "iglobals.pasm"
  85     $P11 = getinterp
  86     $P12 = $P11[.IGLOBALS_CONFIG_HASH]
  87     $S0 = $P12["load_ext"]
  88
  89     ## load a relative pathname with an extension.
  90     $S0 = concat "runtime/parrot/dynext/foo_group", $S0
  91     loadlib $P1, $S0
  92
  93     ## ensure that we can still make Foo instances.
  94     $P1 = new "Foo"
  95     $I1 = $P1
  96     print $I1
  97     print "\n"
  98 .end
  99 CODE
 100 42
 101 OUTPUT
 102
 103 pir_output_is( << 'CODE', << 'OUTPUT', "loadlib with absolute pathname & ext" );
 104 .sub main :main
 105     ## get cwd in $S0, load_ext in $S1.
 106     .include "iglobals.pasm"
 107     $P11 = getinterp
 108     $P12 = $P11[.IGLOBALS_CONFIG_HASH]
 109     $S0 = $P12["prefix"]
 110     $S1 = $P12["load_ext"]
 111
 112     ## convert $S0 to an absolute pathname with extension, and load it.
 113     ## this should always find the version in the build directory, since that's
 114     ## the only place "make test" will work.
 115     $S0 = concat $S0, "/runtime/parrot/dynext/foo_group"
 116     $S0 = concat $S0, $S1
 117     loadlib $P1, $S0
 118
 119     ## ensure that we can still make Foo instances.
 120     $P1 = new "Foo"
 121     $I1 = $P1
 122     print $I1
 123     print "\n"
 124 .end
 125 CODE
 126 42
 127 OUTPUT
 128
 129 SKIP: {
 130     skip( "No BigInt Lib configured", 1 ) if !$PConfig{gmp};
 131
 132     pir_output_is( << 'CODE', << 'OUTPUT', "inherited add" );
 133 .sub _main :main
 134     .local pmc d, l, r
 135     $P0 = loadlib "foo_group"
 136     print "ok\n"
 137     l = new "Foo"
 138     l = 42
 139     r = new 'BigInt'
 140     r = 0x7ffffff
 141     d = new 'Undef'
 142     add d, l, r
 143     print d
 144     print "\n"
 145     $S0 = typeof d
 146     print $S0
 147     print "\n"
 148 .end
 149 CODE
 150 ok
 151 134217769
 152 BigInt
 153 OUTPUT
 154
 155 }
 156
 157 pir_output_is( <<'CODE', <<'OUTPUT', "Foo subclass isa Integer" );
 158 .sub main :main
 159     .local pmc F, f, d, r
 160     loadlib F, "foo_group"
 161     f = new "Foo"
 162     f = 1
 163     d = new 'Integer'
 164     r = new 'Integer'
 165     r = 2
 166     d = f - r
 167     print d
 168     print "\n"
 169 .end
 170 CODE
 171 144
 172 OUTPUT
 173
 174 pir_output_is( << 'CODE', << 'OUTPUT', ".HLL 1" );
 175 # load our Foo test (pseudo) language
 176 # it defines one PMC type "Foo"
 177 .HLL "Fool"
 178 .loadlib "foo_group"
 179 .sub main :main
 180     new $P1, "Foo"      # load by name
 181     $I1 = $P1
 182     print $I1
 183     print "\n"
 184 .end
 185 CODE
 186 42
 187 OUTPUT
 188
 189 pir_output_is( << 'CODE', << 'OUTPUT', ".HLL 2" );
 190 .HLL "Fool"
 191 .loadlib "foo_group"
 192 .sub main :main
 193     new $P1, 'Foo'       # load by index
 194     $I1 = $P1
 195     print $I1
 196     print "\n"
 197 .end
 198 CODE
 199 42
 200 OUTPUT
 201
 202 # Local Variables:
 203 #   mode: cperl
 204 #   cperl-indent-level: 4
 205 #   fill-column: 100
 206 # End:
 207 # vim: expandtab shiftwidth=4: