Changeset 18104 for ext

Timestamp:

09/23/07 09:01:31 (16 months ago)

Author:

Darren_Duncan

Message:

ext/Muldis-DB/ : added does_ok() to Validator.pm ; fixed an Example.pm bug and temp commented-out any .WHERE

Location:

ext/Muldis-DB

Files:

• Changes (modified) (1 diff)
• lib/Muldis/DB/Engine/Example.pm (modified) (3 diffs)
• lib/Muldis/DB/Validator.pm (modified) (5 diffs)

ext/Muldis-DB/Changes

@@ -106 +106 @@
     The SYNOPSIS, plus the MDB_50_Validate_Example.t, were minor updated.
 
+    * (Validator.pm)  Added a &does_ok to Validator.pm, which in the Perl 6
+    Validator.pm is a modified copy of the &isa_ok of Test.pm but it tests
+    with .does rather than .isa; in the Perl 5 Validator.pm, the new
+    &does_ok is just a symbolic alias for the Test::More &isa_ok; in any
+    event, the rest of both versions of Validator.pm now invokes &does_ok
+    rather than &isa_ok, to keep their code bases more similar.
+
     * (SeeAlso.pod)  Updated the PROSPECTIVE MULDIS DB EXTENSIONS section
     mainly to bring various names, terminology, and references up to date

ext/Muldis-DB/lib/Muldis/DB/Engine/Example.pm

@@ -111 +111 @@
 
     my $result = ::Muldis::DB::Engine::Example::Public::Var.new(
-        :dbms(self), 'sys.Core.Universal.Universal' );
+        :dbms(self), :decl_type('sys.Core.Universal.Universal') );
 
 #    $f.bind_func( :func_name($func_name) );
@@ -191 +191 @@
 
     $!dbms = $dbms;
-    $dbms!assoc_vars.{self.WHERE} = self;
+#    $dbms!assoc_vars.{self.WHERE} = self;
+#    weaken $dbms!assoc_vars.{self.WHERE};
 
 #    $!var = ::Muldis::DB::Engine::Example::VM::Var.new(
@@ -200 +201 @@
 
 submethod DESTROY () {
-    $!dbms!assoc_vars.delete( self.WHERE );
+#    $!dbms!assoc_vars.delete( self.WHERE );
     return;
 }

ext/Muldis-DB/lib/Muldis/DB/Validator.pm

@@ -21 +21 @@
     my Muldis::DB::Interface::DBMS $dbms = Muldis::DB::Interface::new_dbms(
         :engine_name($engine_name), :dbms_config($dbms_config) );
-    isa_ok( $dbms, 'Muldis::DB::Interface::DBMS' );
+    does_ok( $dbms, 'Muldis::DB::Interface::DBMS' );
 
     _scenario_foods_suppliers_shipments_v1( $dbms );
@@ -39 +39 @@
     my $src_suppliers
         = $dbms.new_var( :decl_type('sys.Core.Relation.Relation') );
-    isa_ok( $src_suppliers, 'Muldis::DB::Interface::Var' );
+    does_ok( $src_suppliers, 'Muldis::DB::Interface::Var' );
     my $src_foods
         = $dbms.new_var( :decl_type('sys.Core.Relation.Relation') );
-    isa_ok( $src_foods, 'Muldis::DB::Interface::Var' );
+    does_ok( $src_foods, 'Muldis::DB::Interface::Var' );
     my $src_shipments
         = $dbms.new_var( :decl_type('sys.Core.Relation.Relation') );
-    isa_ok( $src_shipments, 'Muldis::DB::Interface::Var' );
+    does_ok( $src_shipments, 'Muldis::DB::Interface::Var' );
 
     # Load our example literal source data sets into said Perl-lexicals.
@@ -138 +138 @@
 
     my $desi_colour = $dbms.new_var( :decl_type('sys.Core.Text.Text') );
-    isa_ok( $desi_colour, 'Muldis::DB::Interface::Var' );
+    does_ok( $desi_colour, 'Muldis::DB::Interface::Var' );
     $desi_colour.store_ast( :ast([ 'NEText', 'orange' ]) );
     pass( 'no death from loading desired colour into VM' );
@@ -164 +164 @@
     );
     pass( 'no death from executing search query' );
-    isa_ok( $matched_suppl, 'Muldis::DB::Interface::Var' );
+    does_ok( $matched_suppl, 'Muldis::DB::Interface::Var' );
 
     my $matched_suppl_ast = $matched_suppl.fetch_ast();
@@ -183 +183 @@
 
     say "# debug: orange food suppliers found:";
-    say "# " ~ $matched_suppl_ast.as_perl();
+    say "# " ~ $matched_suppl_ast.perl();
 
     return;
+}
+
+###########################################################################
+
+# Modified clone of isa_ok from ext/Test/lib/Test.pm,
+# since we actually want to test with does() rather than isa().
+
+sub does_ok (Any|Junction|Pair $ref is rw, Str $expected_type, Str $desc?,
+        :$todo, :$depends) returns Bool is export {
+    my $out
+        := defined($desc) ?? $desc !! "The object does '$expected_type'";
+    my $test := $ref.does($expected_type);
+    Test::proclaim(
+        $test, $out, $todo, ~($ref.WHAT), $expected_type, $depends );
 }