Add Racket syntax

This commit is contained in:
Georgy Komarov
2021-10-03 17:09:56 +03:00
committed by David Peter
parent b622a4d890
commit d04a83de7b
6 changed files with 169 additions and 0 deletions

View File

@ -0,0 +1,56 @@
#lang racket
(require "main.rkt" rackunit)
;; Helper for test cases with multiple outputs
;; See: https://stackoverflow.com/questions/41081395/unit-testing-in-racket-with-multiple-outputs
(define-syntax check-values-equal?
 (syntax-rules ()
 [(_ a b) (check-equal? (call-with-values (thunk a) list) b)]))
;; Named POSIX semaphores
(test-begin
 (define test-sem-name "/test-nix-1")
 ;; Unlink if already exists
 (sem-unlink test-sem-name)
 ;; Open and unlink
 (define test-sem-p (sem-open test-sem-name (+ O_CREAT O_EXCL)))
 (check-not-false test-sem-p)
 (check-not-equal? test-sem-p (void))
 (check-exn exn:fail?
 (lambda () (sem-open test-sem-name (+ O_CREAT O_EXCL)))
 "Permission denied")
 (check-exn exn:fail?
 (lambda () (sem-open test-sem-name (+ O_CREAT O_EXCL))))
 ;; Change values
 (check-equal? (sem-getvalue test-sem-p) 0)
 (sem-post test-sem-p)
 (check-equal? (sem-getvalue test-sem-p) 1)
 (sem-wait test-sem-p)
 (check-equal? (sem-getvalue test-sem-p) 0)
 (sem-post test-sem-p)
 (check-equal? (sem-getvalue test-sem-p) 1)
 (sem-post test-sem-p)
 (check-equal? (sem-getvalue test-sem-p) 2)
 (sem-trywait test-sem-p)
 (check-equal? (sem-getvalue test-sem-p) 2)
 ;; Can't unlink twice
 (check-not-false (sem-unlink test-sem-name))
 (check-false (sem-unlink test-sem-name)))
;; Named POSIX shared memory
(test-begin
 (define test-shm-name "test-nix-mem-1")
 ;; Open and unlink
 (shm-unlink test-shm-name)
 (define test-shm-fd (shm-open test-shm-name (+ O_EXCL O_CREAT O_RDWR) #o644))
 (check > test-shm-fd 0)
 (check-not-false (shm-unlink test-shm-name))
 (check-false (shm-unlink test-shm-name)))

View File

@ -0,0 +1,56 @@
#lang racket
(require "main.rkt" rackunit)
;; Helper for test cases with multiple outputs
;; See: https://stackoverflow.com/questions/41081395/unit-testing-in-racket-with-multiple-outputs
(define-syntax check-values-equal?
(syntax-rules ()
[(_ a b) (check-equal? (call-with-values (thunk a) list) b)]))
;; Named POSIX semaphores
(test-begin
(define test-sem-name "/test-nix-1")
;; Unlink if already exists
(sem-unlink test-sem-name)
;; Open and unlink
(define test-sem-p (sem-open test-sem-name (+ O_CREAT O_EXCL)))
(check-not-false test-sem-p)
(check-not-equal? test-sem-p (void))
(check-exn exn:fail?
(lambda () (sem-open test-sem-name (+ O_CREAT O_EXCL)))
"Permission denied")
(check-exn exn:fail?
(lambda () (sem-open test-sem-name (+ O_CREAT O_EXCL))))
;; Change values
(check-equal? (sem-getvalue test-sem-p) 0)
(sem-post test-sem-p)
(check-equal? (sem-getvalue test-sem-p) 1)
(sem-wait test-sem-p)
(check-equal? (sem-getvalue test-sem-p) 0)
(sem-post test-sem-p)
(check-equal? (sem-getvalue test-sem-p) 1)
(sem-post test-sem-p)
(check-equal? (sem-getvalue test-sem-p) 2)
(sem-trywait test-sem-p)
(check-equal? (sem-getvalue test-sem-p) 2)
;; Can't unlink twice
(check-not-false (sem-unlink test-sem-name))
(check-false (sem-unlink test-sem-name)))
;; Named POSIX shared memory
(test-begin
(define test-shm-name "test-nix-mem-1")
;; Open and unlink
(shm-unlink test-shm-name)
(define test-shm-fd (shm-open test-shm-name (+ O_EXCL O_CREAT O_RDWR) #o644))
(check > test-shm-fd 0)
(check-not-false (shm-unlink test-shm-name))
(check-false (shm-unlink test-shm-name)))