Modify MLBs to build and test on polymlb as well

Makefile

@@ -25,6 +25,12 @@ clean:
 src/smlpkg:
 	$(MAKE) -C src all
 
+.PHONY: test-all-supported-compilers
+test-all-supported-compilers:
+	$(MAKE) clean ; $(MAKE) test MLCOMP=mlton
+	$(MAKE) clean ; $(MAKE) test MLCOMP=mlkit
+	$(MAKE) clean ; $(MAKE) test MLCOMP=polymlb
+
 # -----------------------------------------------------
 # Target for building binary distribution for smlpkg
 # -----------------------------------------------------

src/Makefile

@@ -1,6 +1,11 @@
 PKGVERSION=$(shell cat ../version.txt)
 
 MLCOMP ?= mlkit
+MLCOMP_FLAGS ?=
+
+ifeq ($(MLCOMP), polymlb)
+MLCOMP_FLAGS=-ann 'ignoreFiles call-main-smlpkg.sml,call-main-futpkg.sml'
+endif
 
 SMLFILES=$(shell find . -name '*.sml') $(shell find . -name '*.sig') $(shell find . -name '*.mlb')
 
@@ -10,10 +15,10 @@ GITVERSION=$(shell git describe --abbrev --dirty --always --tags)
 all: smlpkg futpkg
 
 smlpkg: smlpkg.mlb $(SMLFILES) version.gen.sml
-	$(MLCOMP) -output $@ $<
+	$(MLCOMP) $(MLCOMP_FLAGS) -output $@ $<
 
 futpkg: futpkg.mlb $(SMLFILES)
-	$(MLCOMP) -output $@ $<
+	$(MLCOMP) $(MLCOMP_FLAGS) -output $@ $<
 
 .PHONY: test
 test:

src/call-main-futpkg.sml

@@ -0,0 +1 @@
+val _ = main ()

src/call-main-smlpkg.sml

@@ -0,0 +1 @@
+val _ = main ()

src/futpkg.mlb

@@ -1,2 +1,3 @@
 pkg.mlb
 futpkg.sml
+call-main-futpkg.sml

src/futpkg.sml

@@ -1,2 +1,2 @@
 
-val () = Pkg.main "futhark.pkg"
+fun main () = Pkg.main "futhark.pkg"

src/manifest/Makefile

@@ -1,10 +1 @@
-MLCOMP ?= mlkit
-
-.PHONY: test
-test:
-	$(MLCOMP) -output test.exe test.mlb
-	./test.exe
-
-.PHONY: clean
-clean:
-	rm -rf *~ MLB run *.exe
+include ../test/test.mk

src/manifest/test.mlb

@@ -1,4 +1,6 @@
 local $(SML_LIB)/basis/basis.mlb
       manifest.mlb
-in test.sml
+      ../test/testSuite.mlb
+in
+   test.sml
 end

src/manifest/test.sml

@@ -1,25 +1,25 @@
 
-open Manifest
 
-fun test s f =
-    (if f() then print ("OK : " ^ s ^ "\n")
-     else print ("ERR: " ^ s ^ "\n"))
-    handle Fail e => print ("EXN: " ^ s ^ " raised Fail \"" ^ e ^ "\"\n")
+open Manifest
+structure T = TestSuite (); open T
+val () = println "Testing Manifest"
 
 val m = "require {}"
 
-val () = test "empty-m" (fn () => null(requires(fromString "str" m)))
+val () = testf "empty-m" (fn () => null(requires(fromString "str" m)))
 
 val mp = "package github.com/owner/repo require {}"
-val () = test "empty-mp" (fn () => null(requires(fromString "str" mp)))
-val () = test "empty-mp-host" (fn () => SOME "github.com" = Option.map #host (package(fromString "str" mp)))
-val () = test "empty-mp-owner" (fn () => SOME "owner" = Option.map #owner (package(fromString "str" mp)))
-val () = test "empty-mp-repo" (fn () => SOME "repo" = Option.map #repo (package(fromString "str" mp)))
+val () = testf "empty-mp" (fn () => null(requires(fromString "str" mp)))
+val () = testf "empty-mp-host" (fn () => SOME "github.com" = Option.map #host (package(fromString "str" mp)))
+val () = testf "empty-mp-owner" (fn () => SOME "owner" = Option.map #owner (package(fromString "str" mp)))
+val () = testf "empty-mp-repo" (fn () => SOME "repo" = Option.map #repo (package(fromString "str" mp)))
 
 val mr1 = "require { github.com/owner/repo 1.2.3 #asdefsde }"
-val () = test "empty-mr1-len" (fn () => 1 = length(requires(fromString "str" mr1)))
-val () = test "empty-mr1" (fn () => SOME "asdefsde" = #3(List.hd(requires(fromString "str" mr1))))
+val () = testf "empty-mr1-len" (fn () => 1 = length(requires(fromString "str" mr1)))
+val () = testf "empty-mr1" (fn () => SOME "asdefsde" = #3(List.hd(requires(fromString "str" mr1))))
 
 val mr2 = "require { github.com/owner/repo 1.2.3 #asdefsde github.com/owner2/repo8 43.3.2-alpha #523424abcd }"
-val () = test "empty-mr2" (fn () => 2 = length(requires(fromString "str" mr2)))
-val () = test "empty-mr2-version" (fn () => "1.2.3" = SemVer.toString(#2(List.hd(requires(fromString "str" mr2)))))
+val () = testf "empty-mr2" (fn () => 2 = length(requires(fromString "str" mr2)))
+val () = testf "empty-mr2-version" (fn () => "1.2.3" = SemVer.toString(#2(List.hd(requires(fromString "str" mr2)))))
+
+val _ = reportAndExit();

src/semver/Makefile

@@ -1,10 +1 @@
-MLCOMP ?= mlkit
-
-.PHONY: test
-test:
-	$(MLCOMP) -output test.exe test.mlb
-	./test.exe
-
-.PHONY: clean
-clean:
-	rm -rf *~ MLB run *.exe
+include ../test/test.mk

src/semver/test.mlb

@@ -1,4 +1,6 @@
 local $(SML_LIB)/basis/basis.mlb
+      ../test/testSuite.mlb
       semver.mlb
-in test.sml
+in
+   test.sml
 end

src/semver/test.sml

@@ -1,15 +1,5 @@
-
 open SemVer
-
-fun test s b =
-    if b then print ("OK : " ^ s ^ "\n")
-    else print ("ERR: " ^ s ^ "\n")
-
-fun testf s f =
-    (if f() then print ("OK : " ^ s ^ "\n")
-     else print ("ERR: " ^ s ^ "\n"))
-    handle Fail e => print ("EXN: " ^ s ^ " raised Fail \"" ^ e ^ "\"\n")
-         | Overflow => print ("EXN: " ^ s ^ " raised Overflow\n")
+structure T = TestSuite (); open T
 
 fun test_major_minor_patch s (z,a,b) =
     let val () = test ("major0" ^ s) (Option.map major (fromString z) = SOME 0)
@@ -140,3 +130,5 @@ val () = testf "ovf" (fn () =>
                          let val t = fromString "0.0.0-20180801102532+b70028521e4dbcc286834b32ce82c1d2721a6209"
                          in Option.map major t = SOME 0
                          end)
+
+val _ = reportAndExit();

src/smlpkg.mlb

@@ -1,2 +1,3 @@
 pkg.mlb
 smlpkg.sml
+call-main-smlpkg.sml

src/smlpkg.sml

@@ -1,2 +1,2 @@
 
-val () = Pkg.main "sml.pkg"
+fun main () = Pkg.main "sml.pkg"

src/solve/Makefile

@@ -1,10 +1 @@
-MLCOMP ?= mlkit
-
-.PHONY: test
-test:
-	$(MLCOMP) -output test.exe test.mlb
-	./test.exe
-
-.PHONY: clean
-clean:
-	rm -rf *~ MLB run *.exe
+include ../test/test.mk

src/solve/test.mlb

@@ -2,7 +2,9 @@ local $(SML_LIB)/basis/basis.mlb
       ../semver/semver.mlb
       ../manifest/manifest.mlb
       ../util/util.mlb
+      ../test/testSuite.mlb
       solve.sig
       solve.sml
-in test.sml
+in
+  test.sml
 end

src/solve/test.sml

@@ -1,13 +1,6 @@
-
-fun println s = print (s ^ "\n")
-
+structure T = TestSuite (); open T
 val () = println "Testing Solve"
 
-fun test s f =
-    (if f() then print ("OK : " ^ s ^ "\n")
-     else print ("ERR: " ^ s ^ "\n"))
-    handle Fail e => print ("EXN: " ^ s ^ " raised Fail \"" ^ e ^ "\"\n")
-
 fun no_version p v =
     raise Fail ("cannot find version " ^ v ^ " for package " ^ p ^ ".")
 
@@ -74,28 +67,31 @@ fun solveManifest (m:Manifest.t) : string =
     in Solve.buildListToString bl
     end
 
-val () = test "solve1" (fn () => solveManifest m_repo10_0_1_0 = "{}")
+val () = testf "solve1" (fn () => solveManifest m_repo10_0_1_0 = "{}")
 
-val () = test "solve2" (fn () =>
+val () = testf "solve2" (fn () =>
                            let val res = solveManifest m_repo20_0_2_0
                                val () = println ("   result = " ^ res)
                            in res = "{github.com/owner1/repo10:0.1.0}"
                            end)
 
-val () = test "solve3" (fn () =>
+val () = testf "solve3" (fn () =>
                            let val res = solveManifest m_repo20_0_2_1
                                val () = println ("   result = " ^ res)
                            in res = "{github.com/owner1/repo10:0.1.1}"
                            end)
 
-val () = test "solve4" (fn () =>
+val () = testf "solve4" (fn () =>
                            let val res = solveManifest m_repo30_0_3_0
                                val () = println ("   result = " ^ res)
                            in res = "{github.com/owner2/repo20:0.2.0,github.com/owner1/repo10:0.1.0}"
                            end)
 
-val () = test "solve5" (fn () =>
+val () = testf "solve5" (fn () =>
                            let val res = solveManifest m_repo30_0_3_1
                                val () = println ("   result = " ^ res)
                            in res = "{github.com/owner2/repo20:0.2.1,github.com/owner1/repo10:0.1.1}"
                            end)
+
+
+val _ = reportAndExit();

src/test/test.mk

@@ -0,0 +1,15 @@
+MLCOMP ?= mlkit
+MLCOMP_FLAGS ?=
+
+ifeq ($(MLCOMP), polymlb)
+MLCOMP_FLAGS=-main reportAndExit
+endif
+
+.PHONY: test
+test:
+	$(MLCOMP) $(MLCOMP_FLAGS) -output test.exe test.mlb
+	./test.exe
+
+.PHONY: clean
+clean:
+	rm -rf *~ MLB run *.exe

src/test/testSuite.mlb

@@ -0,0 +1,5 @@
+local
+  $(SML_LIB)/basis/basis.mlb
+in
+  testSuite.sml
+end

src/test/testSuite.sml

@@ -0,0 +1,32 @@
+functor TestSuite () =
+struct
+
+val errors = ref 0;
+
+fun println s = print (s ^ "\n")
+
+fun reportOk s = println ("OK: " ^ s)
+
+fun reportErr s = (errors := !errors + 1; println ("ERR: " ^ s))
+
+fun reportExn s e = (errors := !errors + 1;
+                     println ("EXN: " ^ s ^ " raised Fail \"" ^ e ^ "\""))
+
+fun reportExn' s exn_name = (errors := !errors + 1;
+                             println ("EXN: " ^ s ^ " raised " ^ exn_name))
+
+fun test s b = (if b then reportOk s else reportErr s)
+               handle Fail e => reportExn s e
+
+fun testf s f =
+    (if f() then reportOk s else reportErr s)
+    handle Fail e => reportExn s e
+         | Overflow => reportExn' s "Overflow"
+         | _ => reportExn' s "Other"
+
+fun reportAndExit () =
+    if !errors > 0
+    then OS.Process.exit OS.Process.failure
+    else () (* Do not exit on success, for polymlb *)
+
+end;

src/util/Makefile

@@ -1,10 +1 @@
-MLCOMP ?= mlkit
-
-.PHONY: test
-test:
-	$(MLCOMP) -output test.exe test.mlb
-	./test.exe
-
-.PHONY: clean
-clean:
-	rm -rf *~ MLB run *.exe
+include ../test/test.mk

src/util/test.mlb

@@ -1,5 +1,6 @@
 local $(SML_LIB)/basis/basis.mlb
+      ../test/testSuite.mlb
       util.mlb
-in test.sml
-   test_system.sml
+in
+   test.sml
 end

src/util/test.sml

@@ -1,12 +1,7 @@
-fun println s = print (s ^ "\n")
+structure T = TestSuite (); open T
 
 val () = println "Testing FinMapEq"
-
-fun test s b =
-    println(if b then ("OK : " ^ s)
-            else ("ERR: " ^ s))
-
-open FinMapEq
+local open FinMapEq in
 
 val m : (int,string)t = empty_eq()
 
@@ -18,3 +13,26 @@ val toS : (int,string)t -> string = toString (Int.toString,fn s=>s)
 val () = test "empty-toString" (toS m = "{}")
 val () = test "add1-toString" (toS m1 = "{5:five}")
 val () = test "add2-toString" (toS m2 = "{8:eight,5:five}")
+end
+
+
+val () = println "Testing System"
+local open System in
+
+val cmd = "cat testfile.txt"
+val (status,out,err) = command cmd
+
+val () = test "system.ok.out" (out = "Hi there\n")
+val () = test "system.ok.err" (err = "")
+val () = test "system.ok.status" (OS.Process.isSuccess status)
+
+val cmd_err = "cat doesnotexist.txt"
+val (status_err,out_err,err_err) = command cmd_err
+
+val () = test "system.err.out" (out_err = "")
+val () = test "system.err.err" (err_err = "cat: doesnotexist.txt: No such file or directory\n")
+val () = test "system.err.status" (not(OS.Process.isSuccess status_err))
+end
+
+
+val _ = reportAndExit ()