Permalink
Browse files

[dotnet] add defined method to Mu

add substr Ops and substr method to a barebones Match class
oh, and, the rest of the initial accessors implementation
added 56-accessors.t - basic tests of accessors & (fluent) mutators
  • Loading branch information...
1 parent 24494b3 commit 39ec4eca37e1e51c1994d2ade7e476066e60fdcb @diakopter diakopter committed Nov 17, 2010
Showing with 77 additions and 7 deletions.
  1. +41 −7 common/NQP/NQPSetting.pm
  2. +21 −0 common/NQP/P6Objects.pm
  3. +15 −0 t/nqp/56-accessors.t
@@ -408,6 +408,10 @@ sub die($message) {
nqp::throw_dynamic(NQPException.new($message), 0)
}
+sub substr(NQPStr $str, NQPInt $offset, NQPInt $length?) {
+ nqp::substr($str, $offset, $length)
+}
+
# For tests.
my $count := NQPInt.new();
sub plan($n) {
@@ -553,7 +557,8 @@ my knowhow NQPClassHOW {
# Publish type cache.
self.publish_type_cache($obj);
- # XXX TODO: Compose attributes.
+ # Compose attributes.
+ for @!attributes { $_.compose($obj) }
$obj
}
@@ -698,7 +703,7 @@ my knowhow NQPClassHOW {
while $i != $mro_length {
my %meths := @!mro[$i].HOW.method_table($obj);
my $found := %meths{$name};
- if $found.defined {
+ if nqp::repr_defined($found) {
return $found;
}
$i := $i + 1;
@@ -710,17 +715,46 @@ my knowhow NQPClassHOW {
# A simple attribute meta-object.
my knowhow NQPAttribute {
has $!name;
- method new(:$name) {
- my $obj := nqp::instance_of(self);
- $obj.BUILD(:name($name));
+ has $!has_accessor;
+ has $!has_mutator;
+ method new(:$name, :$has_accessor, :$has_mutator) {
+ my $obj := nqp::instance_of(self.WHAT);
+ $obj.BUILD(:name($name), :has_accessor($has_accessor),
+ :has_mutator($has_mutator));
$obj
}
- method BUILD(:$name) {
- $!name := $name
+
+ method BUILD(:$name, :$has_accessor, :$has_mutator) {
+ $!name := $name;
+ $!has_accessor := $has_accessor;
+ $!has_mutator := $has_mutator;
}
method name() {
$!name
}
+ method has_accessor() {
+ $!has_accessor
+ }
+ method has_mutator() {
+ $!has_mutator
+ }
+ method compose($obj) {
+ my $long_name := $!name;
+ my $short_name := nqp::substr($!name, 2);
+ if $!has_accessor {
+ if $!has_mutator {
+ $obj.HOW.add_method($obj, $short_name, method ($val?) {
+ return nqp::repr_defined($val)
+ ?? nqp::bind_attr(self, $obj.WHAT, $long_name, $val)
+ !! nqp::get_attr(self, $obj.WHAT, $long_name);
+ });
+ } else {
+ $obj.HOW.add_method($obj, nqp::substr($short_name, 2), method () {
+ nqp::get_attr(self, $obj.WHAT, $long_name);
+ });
+ }
+ }
+ }
}
# GLOBAL stash.
@@ -16,4 +16,25 @@ class Mu {
multi method ACCEPTS(Mu:U $self: $topic) {
nqp::type_check($topic, self.WHAT)
}
+ method defined() {
+ nqp::repr_defined(self)
+ }
+}
+
+class Capture is Mu {
+ has $.target is rw;
+}
+
+class Match is Mu {
+ has $.target;
+ has $.from;
+ has $.pos;
+
+ method chars() {
+ $!pos - $!from;
+ }
+
+ multi method Str() {
+ substr($!target.Str, $!from, $!pos - $!from)
+ }
}
View
@@ -0,0 +1,15 @@
+# auto-generatored accessors & mutators
+# but not lvalue as in Perl 6, just "fluent" mutator methods
+
+plan(2);
+
+class Foo3 { has $.bar is rw }
+
+my $foo := Foo3.new();
+
+# doesn't work yet; no viviself for attributes :(
+#ok(!$foo.bar());
+
+ok($foo.bar("baz") eq "baz");
+
+ok($foo.bar eq "baz");

0 comments on commit 39ec4ec

Please sign in to comment.