RakuAST: add deparse/raku/tests for RakuAST::Type::Capture

rakudo · Mar 23, 2023 · 36b6244 · 36b6244
1 parent 3a9c154
commit 36b6244
Show file tree

Hide file tree

Showing 4 changed files with 92 additions and 5 deletions.
diff --git a/src/core.c/RakuAST/Deparse.pm6 b/src/core.c/RakuAST/Deparse.pm6
@@ -661,17 +661,21 @@ class RakuAST::Deparse {
     multi method deparse(RakuAST::Parameter:D $ast --> Str:D) {
         return .raku with $ast.value;
 
-        my $target := $ast.target;
+        my $target   := $ast.target;
+        my @captures := $ast.type-captures;
         my str @parts;
-        if $ast.type -> $type {
+        if !@captures && $ast.type -> $type {
             my str $deparsed = self.deparse($type);
             if $deparsed ne 'SETTING::<Any>' {
                 @parts.push($deparsed);
                 @parts.push(' ') if $target;
             }
         }
 
-        if $target {
+        if $ast.type-captures -> @captures {
+            @parts.push(self.deparse($_)) for @captures;
+        }
+        elsif $target {
             my str $var = self.deparse($target, :slurpy($ast.slurpy));
 
             # named parameter
@@ -1849,6 +1853,10 @@ class RakuAST::Deparse {
 
 #- Type ------------------------------------------------------------------------
 
+    multi method deparse(RakuAST::Type::Capture:D $ast --> Str:D) {
+        '::' ~ self.deparse($ast.name)
+    }
+
     multi method deparse(RakuAST::Type::Coercion:D $ast --> Str:D) {
         my str $constraint = self.deparse($ast.constraint);
         $constraint = "" if $constraint eq 'SETTING::<Any>';

diff --git a/src/core.c/RakuAST/Raku.pm6 b/src/core.c/RakuAST/Raku.pm6
@@ -1226,6 +1226,10 @@ augment class RakuAST::Node {
 
 #- Type ------------------------------------------------------------------------
 
+    multi method raku(RakuAST::Type::Capture:D: --> Str:D) {
+        self!positional(self.name)
+    }
+
     multi method raku(RakuAST::Type::Coercion:D: --> Str:D) {
         self!nameds: (try self.constraint.name.canonicalize eq 'Any')
           ?? <base-type>

diff --git a/t/12-rakuast/TODO b/t/12-rakuast/TODO
@@ -38,7 +38,6 @@ RakuAST::Statement::Require
 RakuAST::SubstitutionReplacementThunk
 RakuAST::Trait::Hides
 RakuAST::TraitTarget::Variable
-RakuAST::Type::Capture
 RakuAST::UndeclaredSymbolDescription
 RakuAST::UndeclaredSymbolDescription::Routine
 RakuAST::Var::Lexical::Setting

diff --git a/t/12-rakuast/role.rakutest b/t/12-rakuast/role.rakutest
@@ -1,7 +1,7 @@
 use v6.e.PREVIEW;
 use Test;
 
-plan 5;
+plan 6;
 
 my $ast;
 my $deparsed;
@@ -194,4 +194,80 @@ subtest 'creating a parameterized role' => {
     }
 }
 
+subtest 'creating a parameterized role with a type capture' => {
+    # my role E[::T] { method a (T:D $a) { $a } }
+    ast RakuAST::Package.new(
+      scope      => 'my',
+      declarator => 'role',
+      name       => RakuAST::Name.from-identifier('E'),
+      body       => RakuAST::Block.new(
+        body => RakuAST::Blockoid.new(
+          RakuAST::StatementList.new(
+            RakuAST::Statement::Expression.new(
+              expression => RakuAST::Method.new(
+                name      => RakuAST::Name.from-identifier("a"),
+                signature => RakuAST::Signature.new(
+                  parameters => (
+                    RakuAST::Parameter.new(
+                      type => RakuAST::Type::Definedness.new(
+                        base-type => RakuAST::Type::Simple.new(
+                          RakuAST::Name.from-identifier("T")
+                        ),
+                        definite  => True
+                      ),
+                      target => RakuAST::ParameterTarget::Var.new("\$a")
+                    ),
+                  )
+                ),
+                body      => RakuAST::Blockoid.new(
+                  RakuAST::StatementList.new(
+                    RakuAST::Statement::Expression.new(
+                      expression => RakuAST::Var::Lexical.new("\$a")
+                    )
+                  )
+                )
+              )
+            )
+          )
+        )
+      ),
+      parameterization => RakuAST::Signature.new(
+        parameters => (
+          RakuAST::Parameter.new(
+            type-captures => (
+              RakuAST::Type::Capture.new(
+                RakuAST::Name.from-identifier("T")
+              ),
+            ),
+            default       => RakuAST::Type::Simple.new(
+              RakuAST::Name.from-identifier("Str")
+            )
+          ),
+        )
+      )
+    );
+    is-deeply
+      $deparsed,
+      'my role E[::T = Str] { method a (T:D $a) { $a } }',
+      'deparsed';
+
+    for 'AST', $ast, 'Str', $deparsed, 'Raku', EVAL($raku) -> $type, $it {
+        my $role := EVAL($it);
+        is $role.^name, 'E', "$type: role gets correct name";
+        is-deeply $role.^roles, (), "$type: can we see the roles it does";
+        my $none := $role.new;
+        isa-ok $none, $role, "$type: does the role auto-pun (1)";
+        is-deeply $none.a("foo"), "foo", "$type: value returned (1)";
+        todo ":D not yet being applied in type check";
+        dies-ok { $none.a(Str) }, "$type: does uninstantiated type die (1)";
+        dies-ok { $none.a(666) }, "$type: does incorrect type die (1)";
+        my $one := $role.^parameterize(Int).new;
+        isa-ok $one, $role, "$type: does the role auto-pun (2)";
+        is-deeply $one.a(42), 42, "$type: value returned (2)";
+        todo ":D not yet being applied in type check";
+        dies-ok { $one.a(Int) }, "$type: does uninstantiated type die (2)";
+        dies-ok { $one.a("foo") }, "$type: does incorrect type die (2)";
+    }
+}
+
 # vim: expandtab shiftwidth=4