Merge pull request #186 from frenetic-lang/compilekat

Compilekat

Author: arjunguha

.travis-ci.sh

@@ -1,15 +1,8 @@
 language: c
-script: bash -ex .travis-ci.sh
+install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh
+script: bash -ex .travis-opam.sh
 env:
-  global:
-    - OPAM_DEPENDS="cstruct quickcheck ounit pa_ounit core async sexplib"
-    - CONFIG_FLAGS="--enable-tests --enable-quickcheck --enable-async"
-    - FRENETIC_DEPENDS="ocaml-packet"
-  matrix:
-    - OCAML_VERSION=4.01.0 OPAM_VERSION=1.1.0
-    - OCAML_VERSION=4.01.0 OPAM_VERSION=1.2.0
-    - OCAML_VERSION=4.02.0 OPAM_VERSION=1.1.0
-    - OCAML_VERSION=4.02.0 OPAM_VERSION=1.2.0
+  - OCAML_VERSION=latest PACKAGE=openflow
 notifications:
   irc:
     channels:

.travis.yml

@@ -1,31 +1,41 @@
-all: build
+# OASIS_START
+# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954)
 
-ASYNC ?= $(shell if ocamlfind query async >/dev/null 2>&1; then echo --enable-async; else echo --disable-async; fi)
-# Implies --enable-quickcheck
-TESTS ?= $(shell if ocamlfind query quickcheck >/dev/null 2>&1; then echo --enable-tests; else echo --disable-tests; fi)
+SETUP = ocaml setup.ml
 
-NAME=openflow
-J=4
+build: setup.data
+	$(SETUP) -build $(BUILDFLAGS)
 
-setup.ml: _oasis
-	oasis setup
+doc: setup.data build
+	$(SETUP) -doc $(DOCFLAGS)
 
-setup.data: setup.ml
-	ocaml setup.ml -configure $(ASYNC) $(TESTS)
+test: setup.data build
+	$(SETUP) -test $(TESTFLAGS)
 
-build: setup.data setup.ml
-	ocaml setup.ml -build -j $(J)
+all:
+	$(SETUP) -all $(ALLFLAGS)
 
-install: setup.data setup.ml
-	ocaml setup.ml -install
+install: setup.data
+	$(SETUP) -install $(INSTALLFLAGS)
 
-test: setup.ml build
-	_build/test/Test.byte inline-test-runner openflow
+uninstall: setup.data
+	$(SETUP) -uninstall $(UNINSTALLFLAGS)
 
-reinstall: setup.ml
-	ocamlfind remove $(NAME) || true
-	ocaml setup.ml -reinstall
+reinstall: setup.data
+	$(SETUP) -reinstall $(REINSTALLFLAGS)
 
 clean:
-	ocamlbuild -clean
-	rm -f setup.data setup.log
+	$(SETUP) -clean $(CLEANFLAGS)
+
+distclean:
+	$(SETUP) -distclean $(DISTCLEANFLAGS)
+
+setup.data:
+	$(SETUP) -configure $(CONFIGUREFLAGS)
+
+configure:
+	$(SETUP) -configure $(CONFIGUREFLAGS)
+
+.PHONY: build doc test all install uninstall reinstall clean distclean configure
+
+# OASIS_STOP

Makefile

@@ -1,22 +1,14 @@
 OASISFormat: 0.3
 OCamlVersion:     >= 4.01.0
 Name:        openflow
-Version:     0.7.0
+Version:     0.8.0
 Synopsis:    Serialization library for OpenFlow
 Authors:     https://github.com/frenetic-lang/ocaml-openflow/contributors
 License:     LGPL
-Plugins:     META (0.3)
+Plugins:     META (0.3), DevFiles (0.3)
 BuildTools:
   ocamlbuild
 
-Flag quickcheck
-    Description: build the openflow.quickcheck library
-    Default: false
-
-Flag async
-    Description: build the openflow.async library
-    Default: false
-
 Library openflow
   Path: lib
   BuildDepends:
@@ -50,7 +42,6 @@ Library async
   Findlibparent: openflow
   Findlibname: async
   Path: async
-  Build$: flag(async)
   BuildDepends:
     async,
     openflow,
@@ -74,7 +65,6 @@ Library quickcheck
     Findlibparent: openflow
     Findlibname: quickcheck
     Path: quickcheck
-    Build$: flag(tests) || flag(quickcheck)
     BuildDepends:
       quickcheck,
       openflow,
@@ -103,19 +93,19 @@ Executable testtool
 Executable ping_test
   Path: ping-test
   Install: false
-  Build$: flag(tests) && flag(async)
+  Build$: flag(tests)
   MainIs: PingTest.ml
   BuildDepends: packet,openflow,openflow.async,oUnit,pa_ounit,pa_ounit.syntax
 
 Test all_tests
   Command: $testtool inline-test-runner openflow
-  Run$:  flag(quickcheck) && flag(tests)
+  Run$:  flag(tests)
   TestTools: testtool
 
 Executable learning_switch
   Path: examples
   MainIs: Learning_Switch.ml
-  Build$: flag(async)
+  Build$: flag(tests)
   Install: false
   BuildDepends:
     threads,
@@ -129,7 +119,7 @@ Executable learning_switch
 Executable learning_switch0x04
   Path: examples
   MainIs: Learning_Switch0x04.ml
-  Build$: flag(async)
+  Build$: flag(tests)
   Install: false
   BuildDepends:
     threads,

_oasis

@@ -3,23 +3,8 @@ open Async.Std
 
 
 (** By default, displays untagged info messages on stderr. *)
-module Log : sig
+module Log : Log.Global_intf
 
-  include Log.Global_intf
-
-  val of_lazy
-    :  ?level:[ `Debug | `Info | `Error ]
-    -> ?time:Time.t
-    -> ?tags:(string * string) list
-    -> string Lazy.t
-    -> unit
-
-  val make_filtered_output : (string * string) list ->
-    Log.Output.t
-
-  val add_output : Log.Output.t list -> unit
-
-end
 
 module type Message = sig
   type t with sexp

async/Async_OpenFlow.mli

@@ -175,9 +175,9 @@ module Controller = struct
             Hash_set.remove t.shakes c_id;
             return [`Connect(switch_id, fs)]
           | _ ->
-            Log.of_lazy ~tags ~level:`Debug (lazy
-              (Printf.sprintf "Dropped message during handshake: %s"
-                (Message.to_string (xid, msg))));
+            Log.printf ~tags ~level:`Debug
+              "Dropped message during handshake: %s"
+                (Message.to_string (xid, msg));
             return []
         end
       | `Message (c_id, msg) ->

async/Async_OpenFlow0x01.ml

@@ -205,9 +205,9 @@ module Controller = struct
           return [`Connect(sw_id, (fs, ps'))]
         end
       | _, _ ->
-        Log.of_lazy ~tags ~level:`Debug (lazy
-          (Printf.sprintf "Dropped message during handshake: %s"
-            (Message.to_string (xid, msg))));
+        Log.printf ~tags ~level:`Debug
+          "Dropped message during handshake: %s"
+            (Message.to_string (xid, msg));
         return []
       end
     | `Message (c_id, msg) ->

async/Async_OpenFlow0x04.ml

@@ -1,89 +1,5 @@
 open Core.Std
 open Async.Std
 
-module TagSet = Set.Make(struct
-  type t = string * string with sexp
-  let compare = Pervasives.compare
-end)
-
-let filter_by_tags (enabled_tags : (string * string) list) =
-  let enabled_tags = TagSet.of_list enabled_tags in
-  (fun msgs ->
-    Queue.filter_map msgs (fun msg ->
-      match Log.Message.tags msg with
-      | [] -> Some msg (* untagged messages are printed indiscriminately *)
-      | msg_tags ->
-        if List.exists ~f:(TagSet.mem enabled_tags) msg_tags then
-          Some msg
-        else
-          None))
-
-let label_severity msg =
-  let debug, info, error = [`Dim], [`Blue], [`Red] in
-  let style, prefix = match Log.Message.level msg with
-    | None -> info, ""
-    | Some `Debug -> debug, "[DEBUG]"
-    | Some `Info  -> info,  " [INFO]"
-    | Some `Error -> error, "[ERROR]" in
-  String.concat ~sep:" "
-    [ prefix
-    ; Log.Message.message msg ]
-
-let make_filtered_output (tags : (string * string) list) 
-  : Log.Output.t =
-  let filter = filter_by_tags tags in
-  Log.Output.create
-    (fun msgs ->
-      let writer = Lazy.force (Writer.stderr) in
-       return (Queue.iter (filter msgs) ~f:(fun msg ->
-         Writer.write writer (label_severity msg);
-         Writer.newline writer)))
-
-let current_outputs = ref []
-
-let stderr : Log.Output.t =
-  make_filtered_output [("openflow", "")]
-
-let log = lazy (Log.create ~level:`Info ~output:[stderr])
-
-let level () = Log.level (Lazy.force log)
-let set_level = Log.set_level (Lazy.force log)
-
-let set_output outputs = current_outputs := outputs;
-  Log.set_output (Lazy.force log) outputs
-
-let add_output outputs =
-  let outputs = outputs @ !current_outputs in
-  current_outputs := outputs;
-  set_output outputs
-
-let raw ?time ?(tags=[]) fmt = Log.raw (Lazy.force log) ?time ~tags fmt
-
-let info ?time ?(tags=[]) fmt = Log.info (Lazy.force log) ?time ~tags fmt
-
-let error ?time ?(tags=[]) fmt = Log.error (Lazy.force log) ?time ~tags fmt
-
-let debug ?time ?(tags=[]) fmt = Log.debug (Lazy.force log) ?time ~tags fmt
-
-let flushed () =
-  Log.flushed (Lazy.force log)
-
-let printf ?(level=`Debug) ?time ?(tags=[]) fmt =
-  Log.printf (Lazy.force log) ~tags ~level fmt
-
-let of_lazy ?(level=`Debug) ?time ?(tags=[]) lazy_str =
-  (* As of core/async.111.25.00, `Log.of_lazy` is no longer part of that
-   * package's public API. In 111.28.00, the `Log.level` call was added,
-   * allowing users of the package to implement `of_lazy` without having to
-   * manage the log level manually.
-   * *)
-  if level = Log.level (Lazy.force log) then
-    Log.printf (Lazy.force log) ~tags ~level "%s" (Lazy.force lazy_str)
-
-let sexp ?(level=`Debug) ?time ?(tags=[]) msg =
-  Log.sexp (Lazy.force log) ~tags ~level msg
-
-let string ?(level=`Debug) ?time ?(tags=[]) str =
-  Log.string (Lazy.force log) ~tags ~level str
-
-let message = Log.message (Lazy.force log)
+module Log = Log.Make_global ()
+include Log

async/Async_OpenFlow_Log.ml

@@ -24,13 +24,12 @@ module MakeSerializers (M : Message) = struct
     Digest.to_hex (Digest.string buf)
 
   let deserialize ?(tags : (string * string) list = []) ?(label : string = "")
-    (raw_reader : Reader.t) : [ `Eof | `Ok of M.t] Deferred.t = 
-    let log msg = Log.of_lazy ~level:`Debug ~tags:tags msg in
+    (raw_reader : Reader.t) : [ `Eof | `Ok of M.t] Deferred.t =
     let ofhdr_str = String.create Header.size in
     Reader.really_read raw_reader ofhdr_str
     >>= function
-    | `Eof _ -> 
-      log (lazy (sprintf "[%s] EOF reading header" label));
+    | `Eof _ ->
+      Log.printf "[%s] EOF reading header" label;
       return `Eof
     | `Ok ->
       let hdr = Header.parse (Cstruct.of_string ofhdr_str) in
@@ -39,16 +38,13 @@ module MakeSerializers (M : Message) = struct
       Reader.really_read raw_reader body_buf
       >>= function
       | `Eof _ ->
-        log (lazy (sprintf "[%s] EOF reading body (expected %d bytes)" 
-                     label body_len));
+        Log.printf "[%s] EOF reading body (expected %d bytes)" label body_len;
         return `Eof
       | `Ok ->
         let m = M.parse hdr (Cstruct.of_string body_buf) in
         (* extra space left so read and write align in the log *)
-        log (lazy (sprintf "[%s] read  %s hash=%s"
-                     label
-                     (Header.to_string hdr)
-                     (readable_md5 (ofhdr_str ^ body_buf))));
+        Log.printf "[%s] read  %s hash=%s" label (Header.to_string hdr)
+          (readable_md5 (ofhdr_str ^ body_buf));
         return (`Ok m)
 
   let serialize ?(tags : (string * string) list = []) ?(label : string = "")
@@ -58,8 +54,6 @@ module MakeSerializers (M : Message) = struct
     Header.marshal buf hdr;
     let _ = M.marshal m (Cstruct.shift buf Header.size) in
     Async_cstruct.schedule_write raw_writer buf;
-    Log.of_lazy ~level:`Debug ~tags:tags
-      (lazy (sprintf "[%s] wrote %s hash=%s" 
-               label (Header.to_string hdr)
-               (readable_md5 (Cstruct.to_string buf))))
+    Log.printf ~level:`Debug ~tags "[%s] wrote %s hash=%s"
+      label (Header.to_string hdr) (readable_md5 (Cstruct.to_string buf))
 end