#!perl
# Copyright (C) 2001-2005, The Perl Foundation.
# $Id: objects.t 23187 2007-11-28 15:34:28Z kjs $

use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
use Parrot::Config;
use Parrot::Test tests => 11;

##############################
# Parrot Calling Conventions

pir_output_is( <<'CODE', <<'OUT', "meth call syntax" );

.sub test :main
    .local pmc class
    .local pmc obj
    newclass class, "Foo"
    obj = new "Foo"
    obj._meth()
    print "done\n"
    end
.end

.namespace [ "Foo" ]
.sub _meth :method
    print "in meth\n"
.end
CODE
in meth
done
OUT

pir_output_is( <<'CODE', <<'OUT', "meth call syntax m.o(arg)" );
.sub test :main
    .local pmc class
    .local pmc obj
    newclass class, "Foo"
    obj = new "Foo"
    $P0 = new 'String'
    $P0 = "ok\n"
    obj._meth($P0)
    print "done\n"
    end
.end

.namespace [ "Foo" ]
.sub _meth :method
    .param pmc s
    print "in meth\n"
    print s
.end
CODE
in meth
ok
done
OUT

pir_output_is( <<'CODE', <<'OUT', "meth call ret = o.m(arg)" );
.sub test :main
    .local pmc class
    .local pmc obj
    newclass class, "Foo"
    obj = new "Foo"
    $P0 = new 'String'
    $P0 = "ok\n"
    $S0 = obj._meth($P0)
    print $S0
    end
.end

.namespace [ "Foo" ]
.sub _meth :method
    .param pmc s
    print "in meth\n"
    print s
    .begin_return
    .return "done\n"
    .end_return
.end
CODE
in meth
ok
done
OUT

pir_output_is( <<'CODE', <<'OUT', "meth call syntax, string" );
.sub test :main
    .local pmc class
    .local pmc obj
    .local string meth
    meth = "_meth"
    newclass class, "Foo"
    obj = new "Foo"
    obj."_meth"()
    obj._meth()
    set S10, "_meth"
    obj.S10()
    set $S10, "_meth"
    obj.$S10()
    print "done\n"
    end
.end
.namespace [ "Foo" ]
.sub _meth :method
    print "in meth\n"
.end
CODE
in meth
in meth
in meth
in meth
done
OUT

pir_output_is( <<'CODE', <<'OUT', "initializer" );
.sub test :main
    newclass P1, "Foo"
    subclass P2, P1, "Bar"
    subclass P3, P2, "Baz"
    P3 = new "Baz"
    find_global P0, "_sub"
    invokecc P0
    print "done\n"
    end
.end

.namespace ["Foo"]
.sub init :vtable :method
    print "foo_init\n"
.end

.namespace ["Bar"]
.sub init :vtable :method
    print "bar_init\n"
.end

.namespace ["Baz"]
.sub init :vtable :method
    print "baz_init\n"
.end

.namespace  # main again
.sub _sub
    print "in sub\n"
.end
CODE
foo_init
bar_init
baz_init
in sub
done
OUT

pir_output_is( <<'CODE', <<'OUT', "meth call syntax - method, self" );

.sub test :main
    .local pmc class
    .local pmc obj
    newclass class, "Foo"
    obj = new "Foo"
    obj._meth()
    print "done\n"
    end
.end

.namespace [ "Foo" ]
.sub _meth :method
    print "in meth\n"
    isa $I0, self, "Foo"
    if $I0, ok
    print "not "
ok:
    print "ok\n"
.end
CODE
in meth
ok
done
OUT

pir_output_is( <<'CODE', <<'OUT', "explicit meth call syntax" );

.sub test :main
    .local pmc class
    .local pmc obj
    newclass class, "Foo"
    obj = new "Foo"
    .begin_call
    .invocant obj
    .meth_call "_meth"
    .end_call
    print "done\n"
    end
.end

.namespace [ "Foo" ]
.sub _meth :method
    print "in meth\n"
.end
CODE
in meth
done
OUT

pir_output_is( <<'CODE', <<'OUT', "explicit meth call syntax, meth var" );

.sub test :main
    .local pmc class
    .local pmc obj
    .local string meth
    newclass class, "Foo"
    obj = new "Foo"
    meth = "_me"
    meth = meth . "th"  # test concat to
    .begin_call
    .invocant obj
    .meth_call meth
    .end_call
    print "done\n"
    end
.end

.namespace [ "Foo" ]
.sub _meth :method
    print "in meth\n"
.end
CODE
in meth
done
OUT
pir_output_is( <<'CODE', <<'OUT', "explicit meth call syntax, args" );

.sub test :main
    .local pmc class
    .local pmc obj
    newclass class, "Foo"
    obj = new "Foo"
    .begin_call
    .arg "hello"
    .arg "\n"
    .invocant obj
    .meth_call "_meth"
    .result $S0
    .end_call
    print $S0
    print "done\n"
    end
.end

.namespace [ "Foo" ]
.sub _meth :method
    .param string p1
    .param string p2
    print "in meth\n"
    print p1
    print p2
    .begin_return
    .return "ok\n"
    .end_return
.end
CODE
in meth
hello
ok
done
OUT

pir_output_is( <<'CODE', <<'OUT', "explicit meth call syntax" );

.sub test :main
    .local pmc class
    .local pmc obj
    newclass class, "Foo"
    obj = new "Foo"
    .begin_call
    .invocant obj
    .meth_call "_meth"
    .end_call
    print "done\n"
    end
.end

.namespace [ "Foo" ]
.sub _meth :method
    print "in meth\n"
.end
CODE
in meth
done
OUT

pir_output_is( <<'CODE', <<'OUT', "meth call syntax - reserved word" );

.sub test :main
    .local pmc class
    .local pmc obj
    newclass class, "Foo"
    obj = new "Foo"
    obj.open()
    print "done\n"
    end
.end

.namespace [ "Foo" ]
.sub open :method
    print "in meth\n"
.end
CODE
in meth
done
OUT

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4: