WIP: tests

src/StandardPatterns/Active.jl

@@ -24,29 +24,37 @@ function active_def(P, body, mod::Module, line::LineNumberNode)
     else
         :(struct $t end)
     end
-    parametric = isempty(type_args) ? :(::Nothing) : Expr(:tuple, type_args...)
-    token = QuoteNode(gensym(:mlstyle))
+    parametric = isempty(type_args) ? [] : type_args
     prepr = "$P"
+    token = gensym(prepr)
+    v_ty = Val{(view, token)}
+    v_val = Val((view, token))
 
     quote
         $definition
-        (::Val{($Base.view, $token)})($parametric, $arg) = $body
+        (::$v_ty)($(parametric...), ) = $arg -> $body
         $line
-        function $MatchImpl.pattern_uncall(t::typeof($t), self::Function, type_params, type_args, args)
+        function $MatchImpl.pattern_uncall(t::($t isa Function ? typeof($t) : Type{$t}), self::Function, type_params, type_args, args)
             $line
             isempty(type_params) || error("A ($t) pattern requires no type params.")
-            parametric = isempty(type_args) ? nothing : Expr(:tuple, type_args...)
+            parametric = isempty(type_args) ? [] : type_args
             n_args = length(args)
+
             function trans(expr)
-                f = Val(($Base.view, $token))
-                Expr(:call, f, parametric, expr)
+                Expr(:call, Expr(:call, $v_val, parametric...), expr)
             end
 
             function guard2(expr)
-                :($expr !== nothing)
+                if n_args === 0
+                    :($expr isa Bool && $expr)
+                elseif n_args === 1
+                    :($expr isa Some && $expr !== nothing)
+                else
+                    :($expr isa $Tuple && length($expr) === $n_args)
+                end
             end
 
-            extract = if length(args) === 1
+            extract = if n_args <= 1
                 function (expr::Any, i::Int, ::Any, ::Any)
                     expr
                 end
@@ -55,14 +63,22 @@ function active_def(P, body, mod::Module, line::LineNumberNode)
                     :($expr[$i])
                 end
             end
+
             type_infer(_...) = Any
 
             comp = $PComp(
                 $prepr, type_infer;
                 view=$SimpleCachablePre(trans),
                 guard2=$NoncachablePre(guard2)
             )
-            $decons(comp, extract, [self(arg) for arg in args])
+            ps = if n_args === 0
+                []
+            elseif n_args === 1
+                [self(Expr(:call, Some, args[1]))]
+            else
+                [self(e) for e in args]
+            end    
+            $decons(comp, extract, ps)
         end
     end
 end

test/active_patterns.jl

@@ -1,27 +1,32 @@
-@testset "active pattern" begin
+@testcase "active pattern" begin
     @testset "regular case" begin
-        @active LessThan0(x) begin
+        @lift @active LessThan0(x) begin
             if x > 0
                 nothing
             else
-                x
+                Some(x)
             end
         end
 
-        @test (@match 15 begin
+        b = (@match 15 begin
             LessThan0(_) => :a
             _ => :b
-        end) === :b
+        end)
+
+
+        @test b === :b
 
         @test (@match -15 begin
             LessThan0(a) => a
             _ => 0
         end) == -15
     end
+
     @testset "parametric case" begin
 
-        @active Re{r :: Regex}(x) begin
-             match(r, x)
+        @lift @active Re{r :: Regex}(x) begin
+            ret = match(r, x)
+            ret === nothing || return Some(ret)
         end
 
         @test (@match "123" begin
@@ -38,16 +43,17 @@
     @testset "custom pattern for given structs" begin
         @eval struct Interval end
 
-        @active internal Interval{a, b}(arg) begin
+        @lift @active internal Interval{a, b}(arg) begin
             a <= arg <= b
         end
 
         @use Enum
 
-        @active visible in (@__MODULE__) IsEven(a) begin
+        @lift @active visible in (@__MODULE__) IsEven(a) begin
             a % 2 === 0
         end
 
+        @lift MLStyle.is_enum(::Type{IsEven}) = true
         function parity(x)
             @match x begin
                 IsEven => :even

test/adt.jl

@@ -1,22 +1,19 @@
-module ADTSubTyping
-    using MLStyle
-    using Test
-    abstract type A{a} end
-    abstract type B{a} <: A{a} end
+@testcase "subtyping" begin
+    @lift abstract type A{a} end
+    @lift abstract type B{a} <: A{a} end
 
     @testset "adt subtying" begin
-        @data C{A} <: B{A} begin
+        @lift @data C{A} <: B{A} begin
             C1(A, Int)
         end
 
         @test C1(1, 2) isa C{Int}
     end
-
 end
 
-@testset "adt List" begin
-    # 1. define List
-    @data List{T} begin
+@testcase "adt list" begin
+    # 1. define the List data type
+    @lift @data List{T} begin
         Nil()
         Cons(head :: T, tail :: List{T})
     end
@@ -25,14 +22,16 @@ end
         Nil{T}() => 0
         Cons{T}(_, tail) => 1 + len(tail)
     end
-
-    @test len(Nil{Any}()) == 0
-    xs = Cons(3,Cons(2, Cons(1, Nil{Int}())))
-    @test len(xs) == 3
+    @testset "adt List" begin
+        @test len(Nil{Any}()) == 0
+        xs = Cons(3,Cons(2, Cons(1, Nil{Int}())))
+        @test len(xs) == 3
+    end
 end
-@testset "adt Arith" begin
+
+@testcase "adt arith" begin
     # 1. define Arith
-    @data Arith begin
+    @lift @data Arith begin
         Num(v :: Int)
         Minus(fst :: Arith, snd :: Arith)
         Add(fst :: Arith, snd :: Arith)
@@ -49,43 +48,46 @@ end
             Divide(fst, snd) => eval_arith(fst) / eval_arith(snd)
         end
     end
-    Number = Num
-    @test eval_arith(
-        Add(Number(1),
-            Minus(Number(2),
-                Divide(Number(20),
-                        Mult(Number(2),
-                            Number(5)))))) == 1
-end
 
+    @testset "adt Arith" begin
+        Number = Num
+        @test eval_arith(
+            Add(Number(1),
+                Minus(Number(2),
+                    Divide(Number(20),
+                            Mult(Number(2),
+                                Number(5)))))) == 1
+    end
+end
 
 
-@testset "case" begin
-    @data CD begin
+@testcase "share data with several modules" begin
+    @lift @data CD begin
         D(a, b)
         C{T} :: (a :: Int, b::T) => CD
     end
-    @data A begin
+    @lift @data A begin
         E()
     end
-    @test E <: A
-    @test fieldnames(D) == (:a, :b)
-    @test_throws MethodError C(3.0, :abc)
-end
 
+    @testset "case" begin
+        @test E <: A
+        @test fieldnames(D) == (:a, :b)
+        @test_throws MethodError C(3.0, :abc)
+    end
 
-module ADummy
-    using MLStyle
-end
+    @lift module ADummy
+        using MLStyle
+    end
 
-module BDummy
-    using MLStyle
-end
+    @lift module BDummy
+        using MLStyle
+    end
 
-@testset "share data with several modules" begin
-    @data visible in [ADummy] SSS begin
+    @lift @data visible in [ADummy] SSS begin
         SSS_1(Int)
     end
+
     ADummy.eval(:(SSS_1 = $SSS_1; SSS = $SSS))
 
     @test ADummy.eval(quote
@@ -94,7 +96,6 @@ end
         end
     end) == :ok
 
-
     BDummy.eval(:(SSS_1 = $SSS_1; SSS = $SSS))
 
     @test_skip BDummy.eval(quote
@@ -103,5 +104,3 @@ end
         end
     end)
 end
-
-end

test/exception.jl

@@ -13,9 +13,6 @@ using MLStyle.Extension
         1 = 1
     end))
 
-
-    @test_throws UnknownExtension used(:FieldPuns, MODULE)
-
     @data Test_Ext_Data begin
         Test_Ext_Data_1 :: Int => Test_Ext_Data
     end

test/runtests.jl

@@ -3,28 +3,59 @@ module TestModule
 using Test
 using MLStyle
 
+liftsym = Symbol("@lift")
+
+function lift!(ex, lifted::Vector{Any})
+    @switch ex begin
+        @case Expr(:macrocall, &liftsym, _, arg)
+        push!(lifted, arg)
+        ex.args
+        ex.args[1] = Symbol("@static")
+        ex.args[3] = :(true ? true : true)
+        return
+        @case Expr(hd, args...)
+        for arg in args
+            lift!(arg, lifted)
+        end
+        return
+        @case _
+        return
+    end
+end
+
+macro testcase(name, ex)
+    lifted = []
+    lift!(ex, lifted)
+    m = gensym(name)
+    println(Expr(:block, lifted...))
+    __module__.eval(:(module $m
+    using MLStyle
+    using Test
+    $(lifted...)
+    @testset $name $ex
+    end))
+end
 
 macro test_macro_throws(errortype, m)
-    :(
-        @test_throws $errortype try
-                @eval $m
-            catch err
-                while err isa LoadError
-                    err = err.error
-                end
-                throw(err)
-            end
-    )
+    :(@test_throws $errortype try
+        @eval $m
+    catch err
+        while err isa LoadError
+            err = err.error
+        end
+        throw(err)
+    end)
 end
 
 MODULE = TestModule
 
 @use GADT
+include("active_patterns.jl")
 include("uncomp.jl")
 include("lambda.jl")
 include("as_record.jl")
 include("adt.jl")
-include("active_patterns.jl")
+
 include("exception.jl")
 include("expr_template.jl")
 include("gallery/simple.jl")
@@ -43,4 +74,4 @@ include("nothing.jl")
 
 include("when.jl")
 include("MQuery/test.jl")
-end
+end