tests/stability-tests.lisp

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;;                                                                  ;;;
   3 ;;; Free Software published under an MIT-like license. See LICENSE   ;;;
   4 ;;;                                                                  ;;;
   5 ;;; Copyright (c) 2012 Google, Inc.  All rights reserved.            ;;;
   6 ;;;                                                                  ;;;
   7 ;;; Original author: Scott McKay                                     ;;;
   8 ;;;                                                                  ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package "PROTO-TEST")
  12
  13
  14 ;;; .lisp <-> .proto stability unit tests
  15
  16 (proto:define-schema stable-color-wheel
  17     (:package proto_test)
  18   (proto:define-message stable-color-wheel ()
  19     (proto:define-enum version-status ()
  20       deprecated
  21       unready)
  22     (proto:define-message stable-metadata ()
  23       (author :type (or null string))
  24       (revision :type (or null string))
  25       (date :type (or null string))
  26       (status :type version-status :default :unready))
  27     (name :type string)
  28     (colors :type (vector-of stable-color))
  29     (metadata1 :type (or null stable-metadata)))
  30   (proto:define-message stable-color ()
  31     (name :type (or null string) :default "black")
  32     (r-value :type integer :default 0)
  33     (g-value :type integer :default 0)
  34     (b-value :type integer :default 0))
  35   (proto:define-message stable-add-color ()
  36     (wheel :type stable-color-wheel)
  37     (color :type stable-color))
  38   (proto:define-message string-primitive ()
  39     (string :type string))
  40   (proto:define-service stable-color-wheel ()
  41     (get-stable-color (string-primitive => stable-color))
  42     (set-stable-color (stable-color => stable-color)
  43                       :options (:deadline 1.0))))
  44
  45 (defvar *color-wheel-proto*
  46   "syntax = \"proto2\";
  47
  48 package proto_test;
  49
  50 message StableColorWheel {
  51   enum VersionStatus {
  52     DEPRECATED = 0;
  53     UNREADY = 1;
  54   }
  55   message StableMetadata {
  56     optional string author = 1;
  57     optional string revision = 2;
  58     optional string date = 3;
  59     required VersionStatus status = 4 [default = UNREADY];
  60   }
  61   required string name = 1;
  62   repeated StableColor colors = 2;
  63   optional StableMetadata metadata1 = 3;
  64 }
  65
  66 message StableColor {
  67   optional string name = 1 [default = \"black\"];
  68   required int64 r_value = 2 [default = 0];
  69   required int64 g_value = 3 [default = 0];
  70   required int64 b_value = 4 [default = 0];
  71 }
  72
  73 message StableAddColor {
  74   required StableColorWheel wheel = 1;
  75   required StableColor color = 2;
  76 }
  77
  78 message StringPrimitive {
  79   required string string = 1;
  80 }
  81
  82 service StableColorWheel {
  83   rpc GetStableColor (StringPrimitive) returns (StableColor);
  84   rpc SetStableColor (StableColor) returns (StableColor) {
  85     option deadline = 1.0;
  86   }
  87 }")
  88
  89 (define-test color-wheel-stability ()
  90   (let* ((schema1 (find-schema 'stable-color-wheel))
  91          (schema2 (with-input-from-string (s *color-wheel-proto*)
  92                     (parse-schema-from-stream s
  93                       ;; Parsing from a string doesn't produce a name, so supply it
  94                       :name (proto-name schema1)
  95                       :class (proto-class schema1)
  96                       :conc-name nil))))
  97     (assert-true (schemas-equal schema1 schema2))
  98     (assert-true (string=
  99                    (with-output-to-string (s)
 100                      (write-schema schema1 :type :proto :stream s))
 101                    (with-output-to-string (s)
 102                      (write-schema schema2 :type :proto :stream s))))
 103     (assert-true (string=
 104                    (with-output-to-string (s)
 105                      (write-schema schema1 :type :lisp :stream s))
 106                    (with-output-to-string (s)
 107                      (write-schema schema2 :type :lisp :stream s))))))
 108
 109 (define-test-suite stability-tests ()
 110   (color-wheel-stability))
 111
 112 (register-test 'stability-tests)