Fix string model but something is requiring test order and to type at…

…tributes
FCO · Nov 7, 2021 · 2a4e086 · 2a4e086
1 parent 8d2e3fd
commit 2a4e086
Show file tree

Hide file tree

Showing 4 changed files with 52 additions and 3 deletions.
diff --git a/lib/MetamodelX/Red/Model.pm6 b/lib/MetamodelX/Red/Model.pm6
@@ -547,7 +547,6 @@ multi method create(\mo where *.DEFINITE, *%orig-pars, :$with where not .defined
                 $obj.^clean-up;
                 $obj.^populate-ids;
             }
-
             my %should-set = |mo.^join-on(mo.^parent).should-set.Hash if mo.HOW.?join-on: mo;
             my $p = mo.^parent;
             my %attrs = |$p.^columns.map: { .name.substr(2) => .self }

diff --git a/lib/Red/Attr/Relationship.pm6 b/lib/Red/Attr/Relationship.pm6
@@ -15,7 +15,7 @@ unit role Red::Attr::Relationship[
     Red::Model  :$model-type,
 ];
 
-has Mu:U $!type;
+#has Mu:U $!type;
 
 has Bool $.has-lazy-relationship = ?$model;
 

diff --git a/lib/Red/Column.pm6 b/lib/Red/Column.pm6
@@ -163,7 +163,7 @@ method comment { .Str with self.attr.WHY }
 
 #| Returns a function that will return a column that is referenced by this column
 method references(--> Callable) is rw {
-    &!actual-references = do {
+    &!actual-references //= do {
         if &!references {
             if $!model-name {
                 ReferencesProxy.new(:&!references, :$!model-name, :$!require, :$!model-type);

diff --git a/t/35-create.t b/t/35-create.t
@@ -33,6 +33,55 @@ subtest "Create on has-one", {
     is $ble.bla.gist, $bla.gist;
 }
 
+subtest "belogs-to using types", {
+    model Blo { ... }
+    model Bli {
+        has UInt $.id      is serial;
+        has Str  $.value   is column;
+        has Blo  @.blos    is relationship(*.bli-id, :model(Blo));
+        has Blo  $.one-blo is relationship(*.bli-id, :model(Blo), :has-one);
+    }
+
+    model Blo {
+        has UInt $.id     is serial;
+        has Str  $.value  is column;
+        has UInt $.bli-id is referencing(*.id, :model(Bli));
+        has Bli  $.bli    is relationship(*.bli-id, :model(Bli));
+    }
+
+    schema(Bli, Blo).create;
+
+    my $blo = Blo.^create(:value<blo>);
+    my $bli = $blo.bli.^create: :value<bli>;
+    is $bli.blos.head.gist, $blo.gist;
+    is $blo.bli.gist, $bli.gist;
+}
+
+# TODO: make this work
+#subtest "belogs-to using types not using it on attrs", {
+#    model Blu { ... }
+#    model Blb {
+#        has UInt $.id      is serial;
+#        has Str  $.value   is column;
+#        has      @.blus    is relationship(*.blb-id, :model(Blu));
+#        has      $.one-blu is relationship(*.blb-id, :model(Blu), :has-one);
+#    }
+#
+#    model Blu {
+#        has UInt $.id     is serial;
+#        has Str  $.value  is column;
+#        has UInt $.blb-id is referencing(*.id, :model(Blb));
+#        has      $.blb    is relationship(*.blb-id, :model(Blb));
+#    }
+#
+#    schema(Blb, Blu).create;
+#
+#    my $blu = Blu.^create(:value<blu>);
+#    my $blb = $blu.blb.^create: :value<blb>;
+#    is $blb.blus.head.gist, $blu.gist;
+#    is $blu.blb.gist, $blb.gist;
+#}
+
 subtest "Simple create and fk id", {
     my $bla = Bla.^create: :value<test1>;
     my $ble = Ble.^create: :value<test2>, :bla-id($bla.id);
@@ -114,4 +163,5 @@ subtest "Simple create and creating by array", {
     isa-ok    $bla.bles,                    Ble::ResultSeq;
     is        $bla.bles.map(*.value),       <test3 test4>;
 };
+
 done-testing;