Item14237: Introducing support of Type::Tiny

- added Foswiki::Types module
- added -types option for Foswiki::Class
- added support for 'assert' option of Moo's 'has' sugar – same as 'isa'
  but activated when Assert::DEBUG is true only.
- initial tests for types and Foswiki::Class.

UnitTestContrib/lib/Foswiki/Contrib/UnitTestContrib/MANIFEST

@@ -30,6 +30,7 @@ test/unit/AdminOnlyAccessControlTests.pm 0644
 test/unit/AttrsTests.pm 0644
 test/unit/CacheTests.pm 0644
 test/unit/CallbackTests.pm 0644
+test/unit/ClassTests.pm 0644
 test/unit/ClientTests.pm 0644
 test/unit/ConfigTests.pm 0644
 test/unit/ConfigureQueryTests.pm 0644
@@ -120,6 +121,7 @@ test/unit/TestExtensions/Foswiki/Extension/Empty.pm 0644
 test/unit/TestExtensions/Foswiki/Extension/Sample.pm 0644
 test/unit/TestExtensions/Foswiki/Extension/Sample/Config.pm 0644
 test/unit/TimeTests.pm 0644
+test/unit/TypesTests.pm 0644
 test/unit/UIFnCompileTests.pm 0644
 test/unit/UTF8Tests.pm 0644
 test/unit/UnitTestContrib/EavesdropTests.pm 0644

UnitTestContrib/lib/Unit/TestCase.pm

@@ -1,6 +1,5 @@
 # See bottom of file for license and copyright
 package Unit::TestCase;
-use v5.14;
 
 =begin TML
 
@@ -18,7 +17,6 @@ Foswiki.
 use Try::Tiny;
 use Carp;
 use Unit::HTMLDiffer;
-use Unit::TestRunner();
 use Foswiki::Exception ();
 use Text::Diff         ();
 require File::Temp;
@@ -830,6 +828,29 @@ sub encode_wide_chars {
     return join( '', @s );
 }
 
+=begin TML
+
+---+++ ObjectMethod compileTestPackage($pkgName, $pkgBody)
+
+Builds complete package source using package name from =$pkgName= and its
+source code from =$pkgBody=. Reports failure using =assert()= if compilation
+fails.
+
+=cut
+
+sub compilePackage {
+    my $this = shift;
+    my ( $pkgName, $pkgBody ) = @_;
+
+    my $rc = eval <<PKG;
+package ${pkgName};
+#line 0 "${pkgName}"
+$pkgBody
+1;
+PKG
+    $this->assert( $rc, "Compilation of ${pkgName} failed: " . $@ );
+}
+
 1;
 
 __DATA__

UnitTestContrib/test/unit/ClassTests.pm

@@ -0,0 +1,87 @@
+# Tests for Foswiki::Class functionality.
+
+package ClassTests;
+
+use Try::Tiny;
+
+use Foswiki::Class -types;
+extends qw<Unit::TestCase>;
+
+sub _unexpectedExceptionMsg {
+    my $this  = shift;
+    my $excpt = shift;
+    return
+        "Unexpected exception of type "
+      . ( ref($excpt) // 'SCALAR' ) . ": "
+      . $excpt;
+}
+
+sub test_hasWithAssertOption {
+    my $this = shift;
+
+    local $Foswiki::Class::HAS_WITH_ASSERT = 1;
+
+    $this->compilePackage(
+        "__FCT::HasClassDebug",
+        <<SHC
+use Foswiki::Class -types;
+extends qw<Foswiki::Object>;
+
+has attr => (
+    is => 'rw',
+    assert => Num,
+);
+
+has [qw<a1 a2 a3>] => (
+    is => 'rw',
+    assert => Int,
+);
+SHC
+    );
+
+    my $obj = __FCT::HasClassDebug->new;
+
+    foreach my $attr (qw<attr a1 a2 a3>) {
+        try {
+            $obj->$attr("abc");
+            $this->assert( 0,
+                "Must have failed due to type mismatch (attribute $attr)" );
+        }
+        catch {
+            $this->assert( TypeException->check($_),
+                $this->_unexpectedExceptionMsg($_) . " (attribute $attr)" );
+        };
+    }
+}
+
+sub test_hasWithoutAssertOption {
+    my $this = shift;
+
+    local $Foswiki::Class::HAS_WITH_ASSERT = 0;
+
+    $this->compilePackage(
+        "__FCT::HasClassNoDebug",
+        <<SHC
+use Foswiki::Class -types;
+extends qw<Foswiki::Object>;
+
+has attr => (
+    is => 'rw',
+    assert => Num,
+);
+SHC
+    );
+
+    my $obj = __FCT::HasClassNoDebug->new;
+
+    try {
+        $obj->attr("abc");
+    }
+    catch {
+        $this->assert( !TypeException->check($_),
+            "Type check failed though it should have passed" );
+        $this->assert( $_, $this->_unexpectedExceptionMsg($_) );
+    };
+}
+
+1;

UnitTestContrib/test/unit/TypesTests.pm

@@ -0,0 +1,218 @@
+# Tests for Foswiki::Types
+
+package TypesTests;
+
+use Assert;
+use Try::Tiny;
+
+use Foswiki::Class;
+extends qw<FoswikiTestCase>;
+
+sub test_ClassOption {
+    my $this = shift;
+
+    my $rc;
+
+    $rc = eval <<TYPEDCLASS;
+package __FCT::Typed;
+
+use Foswiki::Class -types;
+extends qw<Foswiki::Object>;
+
+has attr => (
+    is => 'rw',
+    isa => Str,  
+);
+
+1;
+TYPEDCLASS
+
+    $this->assert( !$@, "Failed to import types into a test class: $@" );
+    $this->assert( $rc, "Class code did not compile correctly" );
+
+    my $obj = __FCT::Typed->new;
+
+    try {
+        $obj->attr(undef);
+        $this->assert( 0,
+            "Setting attribute must have raised typeee constraint exception" );
+    }
+    catch {
+        $this->assert( $_->isa('Error::TypeTiny::Assertion'),
+                "Invalid exception, expected Error::TypeTiny::Assertion, got "
+              . ref($_)
+              . ":\n{{{"
+              . $_
+              . "}}}" );
+        $this->assert_matches( qr/Undef did not pass type constraint "Str"/,
+            $_, "" );
+    };
+
+    # This will fail upon compile-tyime.
+    $rc = eval <<UNTYPEDCLASS;
+package __FCT::UnTypedClass;
+
+use Foswiki::Class;
+extends qw<Foswiki::Object>;
+
+has attr => (
+    is => 'rw',
+    isa => Str,
+);
+
+1;
+UNTYPEDCLASS
+
+    $this->assert( !$rc, "Class compilation must have failed" );
+    $this->assert_matches(
+        qr/Bareword "Str" not allowed while "strict subs" in use/, $@ );
+}
+
+sub test_AnyOf {
+    my $this = shift;
+
+    my $rc = eval <<ANYCLASS;
+package __FCT::AnyClass;
+
+use Foswiki::Class -types;
+extends qw<Foswiki::Object>;
+
+has multiAttr => (
+    is => 'rw',
+    isa => AnyOf[Num, HashRef, InstanceOf['Foswiki::Object'], ],
+);
+
+1;
+ANYCLASS
+
+    $this->assert( $rc, "Class compilation failed: " . $@ );
+
+    my $obj = __FCT::AnyClass->new;
+
+    my $type;
+    try {
+        my %typeVals = (
+            Num        => 3.1415926,
+            HashRef    => { e => 2.71828, },
+            InstanceOf => $obj,
+        );
+
+        foreach my $t ( keys %typeVals ) {
+            $obj->multiAttr( $typeVals{ $type = $t } );
+        }
+    }
+    catch {
+        $this->assert( 0, "Unexpected failure on a valid type $type" );
+    };
+
+    try {
+        $obj->multiAttr(undef);
+    }
+    catch {
+        $this->assert(
+            UNIVERSAL::isa( $_, "Error::TypeTiny::Assertion" ),
+            "Bad exception class, excpected Error::TypeTiny::Assertion"
+        );
+        $this->assert_matches( qr/Undef did not pass type constraint "AnyOf\[/,
+            $_->message );
+    };
+}
+
+sub test_AllOf {
+    my $this = shift;
+
+    eval <<TSTROLE;
+package __FCT::TstRole;
+
+use Foswiki::Role;
+
+TSTROLE
+
+    eval <<TSTCLASS1;
+package __FCT::TstClass1;
+
+use Foswiki::Class;
+extends qw<Foswiki::Object>;
+with qw<__FCT::TstRole>;
+
+sub mandatory {
+    my \$this = shift;
+    return 3.1415926;
+}
+TSTCLASS1
+
+    eval <<TSTCLASS2;
+package __FCT::TstClass2;
+
+use Foswiki::Class;
+extends qw<Foswiki::Object>;
+with qw<__FCT::TstRole>;
+
+TSTCLASS2
+
+    eval <<TSTCLASS3;
+package __FCT::TstClass3;
+
+use Foswiki::Class;
+extends qw<Foswiki::Object>;
+
+sub mandatory {
+    my \$this = shift;
+    return 3.1415926;
+}
+
+TSTCLASS3
+
+    my $rc = eval <<ALLOFCLASS;
+package __FCT::AllOfClass;
+
+use Foswiki::Class -types;
+extends qw<Foswiki::Object>;
+
+has objRef => (
+    is => 'rw',
+    isa => AllOf[
+            InstanceOf['Foswiki::Object'],
+            ConsumerOf['__FCT::TstRole'],
+            HasMethods['mandatory']
+    ],
+);
+
+1;
+ALLOFCLASS
+
+    $this->assert( $rc, "Compilation of test class failed: " . $@ );
+
+    my $obj = __FCT::AllOfClass->new;
+
+    try {
+        $obj->objRef( __FCT::TstClass1->new );
+    }
+    catch {
+        $this->assert( 0, "Unexpected failure on a valid object: " . $_ );
+    };
+
+    my %badClasses = (
+        '__FCT::TstClass2' =>
+qr/did not pass type constraint "AllOf\[.*The reference cannot "mandatory"/s,
+        '__FCT::TstClass3' =>
+qr/did not pass type constraint "AllOf\[.*The reference .*doesn't __FCT::TstRole/s,
+    );
+    foreach my $class ( keys %badClasses ) {
+
+        try {
+            $obj->objRef( $class->new );
+            $this->assert( 0, "$class erroneously passed type constraint" );
+        }
+        catch {
+            $this->assert(
+                UNIVERSAL::isa( $_, "Error::TypeTiny::Assertion" ),
+                "Bad exception class, excpected Error::TypeTiny::Assertion"
+            );
+            $this->assert_matches( $badClasses{$class}, $_ );
+        };
+    }
+
+}
+
+1;