changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/net/tests.lisp

changeset 364: 76c4c4c4a7c1
parent: ee8a3a0c57b8
child: 386d51cf61ca
author: Richard Westhaver <ellis@rwest.io>
date: Thu, 23 May 2024 20:59:01 -0400
permissions: -rw-r--r--
description: big rt fix 
     1 (defpackage :net/tests
     2   (:use :rt :std :cl :net :sb-concurrency :sb-thread))
     3 
     4 (in-package :net/tests)
     5 
     6 (defsuite :net)
     7 (in-suite :net)
     8 (in-readtable :std)
     9 (deftest sanity ())
    10 
    11 (deftest sans-io (:disabled t)
    12   (defclass mock-transport-config (transport-config)
    13     (max-bidi-streams
    14      max-uni-streams
    15      max-idle-timeout
    16      rx-window
    17      tx-window
    18      (packet-threshold :initform 3)
    19      (time-threshold :initform (/ 9 8))
    20      (initial-rtt :initform 333)
    21      initial-mtu
    22      min-mtu
    23      (datagram-rx-buffer-size :initform 1250000)
    24      (datagram-tx-buffer-size :initform (* 1024 1024))))
    25   (defclass mock-server-config (server-config)
    26     ((port :initarg :port :initform 0))
    27     (:default-initargs
    28      :transport (make-instance 'mock-transport-config)))
    29   (defclass mock-client-config (client-config)
    30     ((port :initarg :port :initform 0))
    31     (:default-initargs
    32      :transport (make-instance 'mock-transport-config)))
    33   (defclass mock-endpoint (endpoint)
    34     ((tx :initarg :tx)
    35      (rx :initarg :rx))
    36     (:default-initargs
    37      :server (make-instance 'mock-server-config)))
    38   (let ((ent (make-instance 'mock-endpoint)))
    39     (is (equal (class-name (class-of ent)) 'mock-endpoint))))
    40 
    41 (deftest dns ())
    42 
    43 (deftest tcp ())
    44 
    45 (deftest udp ())
    46 
    47 (deftest tlv ())
    48 
    49 (deftest osc ())
    50 
    51 (deftest crew (:disabled t)
    52   (let ((pool (make-worker-pool (make-instance 'crew-connection-info :host-name "localhost" :port 9999)
    53                                 (list (make-instance 'crew-connection-info :host-name "localhost" :port 10000))
    54                                 #'connect-worker)))
    55     (let* ((worker-count (if (null pool) 1 (worker-count pool)))
    56            (work '(cons 1 2))
    57            (expected-result (make-list worker-count :initial-element '(1 . 2)))
    58            (count 0)
    59            (count-lock (make-mutex :name "count")))
    60       (flet ((result-done (position element)
    61                (with-mutex (count-lock)
    62                  (incf count)
    63                  (is (equal (nth position expected-result) element)))))
    64         (is (equal (eval-form-all-workers pool work :replay-required nil) expected-result))
    65         (is (equal (eval-form-all-workers pool work :result-done #'result-done :replay-required nil)
    66                    expected-result))
    67         (is (= count worker-count))))))
    68 
    69 ;; (defun test-eval-form-repeatedly (pool)
    70 ;;   (let ((worker-count (if (null pool) 1 (worker-count pool))))
    71 ;;     (is (equal (eval-form-repeatedly pool 0 '(constantly 42)) '()))
    72 ;;     (is (equal (eval-form-repeatedly pool 10 '(constantly (cons 1 2)))
    73 ;;                (make-list 10 :initial-element (cons 1 2))))
    74 ;;     (is (equal (eval-form-repeatedly pool 20 '(constantly (cons 3 4))
    75 ;;                                      :worker-count (floor (/ worker-count 2)))
    76 ;;                (make-list 20 :initial-element (cons 3 4))))
    77 ;;     (is (equal (eval-form-repeatedly pool 30 '(constantly (cons 5 6)) :worker-count 0)
    78 ;;                (make-list 30 :initial-element (cons 5 6))))))
    79 
    80 ;; (defun test-parallel-mapcar (pool)
    81 ;;   (let ((input '(100 200 300))
    82 ;;         (expected-result '((100 . 1) (200 . 1) (300 . 1)))
    83 ;;         (count 0))
    84 ;;     (flet ((result-done (position element)
    85 ;;              (incf count)
    86 ;;              (is (equal (nth position expected-result) element))))
    87 ;;       (is (equal (parallel-mapcar pool (lambda (x) `(cons ,x 1)) input) expected-result))
    88 ;;       (is (equal (parallel-mapcar pool (lambda (x) `(cons ,x 1)) input #'result-done)
    89 ;;                  expected-result))
    90 ;;       (is (= count (length expected-result))))))
    91 
    92 ;; (defun test-parallel-reduce (pool)
    93 ;;   (is (equal (parallel-reduce pool
    94 ;;                               (lambda (x) `(list ,x 1))
    95 ;;                               '(100 200 300)
    96 ;;                               '(a b c)
    97 ;;                               #'append)
    98 ;;              '(a b c 100 1 200 1 300 1))))
    99 
   100 ;; (defun test-eval-repeatedly-async-state (pool)
   101 ;;   (let ((expected-state 10)
   102 ;;         (update-count 0)
   103 ;;         (work-form '(lambda (state)
   104 ;;                      ;; Return results slowly so we don't create huge result lists.
   105 ;;                      (sleep 0.1)
   106 ;;                      (* state state))))
   107 ;;     (flet ((update-state (state results)
   108 ;;              (is (= state expected-state))
   109 ;;              (is (not (null results)))
   110 ;;              (dolist (result results)
   111 ;;                (is (or (= result (expt state 2))
   112 ;;                        (= result (expt (1- state) 2))
   113 ;;                        (= result (expt (- state 2) 2)))))
   114 ;;              ;; Allow time for several results to accumulate.
   115 ;;              (sleep 0.5)
   116 ;;              (values (incf expected-state) (> (incf update-count) 3) t)))
   117 ;;       (eval-repeatedly-async-state pool work-form 10 #'update-state :worker-count 0)
   118 ;;       (setf expected-state 10
   119 ;;             update-count 0)
   120 ;;       (eval-repeatedly-async-state pool work-form 10 #'update-state))))
   121 
   122 (deftest http ()
   123   (let ((req (make-http-request))
   124       (cb (make-callbacks)))
   125   (parse-request
   126    req cb
   127    (sb-ext:string-to-octets #"GET /cookies HTTP/1.1
   128 Host: 127.0.0.1:8080
   129 Connection: keep-alive
   130 Cache-Control: max-age=0Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
   131 User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.17 (KHTML, like Gecko) Chrome/24.0.1312.56 Safari/537.17
   132 Accept-Encoding: gzip,deflate,sdch
   133 Accept-Language: en-US,en;q=0.8
   134 Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.3
   135 Cookie: name=wookie
   136 
   137 "#))
   138     (is cb)
   139     (is req)))