Loris  Check-in [f246cdf6ff]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add random-integer procedure to the platform module, and use it in dot-locking instead of using srfi 27. The srfi 27 egg is broken on Windows/MSYS2. The random procedure of Chickens extras module is good enough for our purposes here.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:f246cdf6fffe7cb4ce04f02de7172ba5dfba3f08
User & Date: jesper 2016-08-01 10:01:57
Context
2016-08-01
10:23
Unbreak import of DELETE-FILE and cleanup. The DELETE-FILE procedure should be imported from the module chicken. There is no need to import (scheme process-context) twice. Also, imported Chicken-specific procedures used only within the platform module have been prefixed with "chicken:" check-in: d9a974c943 user: jesper tags: trunk
10:01
Add random-integer procedure to the platform module, and use it in dot-locking instead of using srfi 27. The srfi 27 egg is broken on Windows/MSYS2. The random procedure of Chickens extras module is good enough for our purposes here. check-in: f246cdf6ff user: jesper tags: trunk
2016-04-18
18:28
Since R7RS is now mandatory, use #\null check-in: 4c3f253883 user: jesper tags: trunk
Changes

Changes to dot-locking.scm.

57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
(use r7rs)

(define-library (loris dot-locking)
  (import (scheme base)
          (scheme file)
          (scheme time)
          (scheme write)
          (srfi 27)
          (srfi 18)
          (loris convenience)
          (loris platform))
  (export release-dot-lock
          break-dot-lock
          obtain-dot-lock
          with-dot-lock







<







57
58
59
60
61
62
63

64
65
66
67
68
69
70
(use r7rs)

(define-library (loris dot-locking)
  (import (scheme base)
          (scheme file)
          (scheme time)
          (scheme write)

          (srfi 18)
          (loris convenience)
          (loris platform))
  (export release-dot-lock
          break-dot-lock
          obtain-dot-lock
          with-dot-lock

Changes to platform.scm.

13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28
29
30




31
32
33
34
35
36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
..
60
61
62
63
64
65
66














67
68
69
70
71
72
73
;;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

(use r7rs)

(define-library (loris platform)
  (import (scheme base)
          (scheme char)		; XXX: "not unicode-aware" / r7rs egg ref

          (scheme process-context)
          (scheme file)
          (scheme process-context)
          (srfi 1)
          (srfi 13)
          (srfi 14)
          (loris convenience)
          (loris output)
          (prefix (loris version) version:)

          ;; XXX: Chicken-specific




          (only (posix) process process-wait ; used here, not exported
                file-modification-time file-link current-directory) ; reexported only
          (only (files) 	; all these are reexported
                make-absolute-pathname absolute-pathname? normalize-pathname
                delete-file))	; reexported and used here for delete-filename*
  (export program-name
          stderr-to-null
          platform-dir-slashes
          program-available?
          ref
          init
          allowed-in-filename?
          delete-file*


          ;; reexport from posix module
          file-modification-time file-link current-directory

          ;; reexport from files module
          make-absolute-pathname absolute-pathname? normalize-pathname delete-file)
  (begin
................................................................................
                        (equal? needle feature))
                      available-features))
              needles)))
    (define (software-type) (feature-find '(posix unix windows)))
    (define (operating-system) (feature-find '(aix sunos solaris haiku dragonflybsd dragonfly
                                                   hpux macosx openbsd netbsd freebsd linux ecos
                                                   unix android windows unknown)))















    (define (stderr-to-null cmd)
      (if (eq? (software-type) 'windows)
          (conc cmd " 2> NUL")
          (conc cmd " 2> /dev/null")))

    (define (platform-dir-slashes str)







>











>
>
>
>
|












>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
..
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
;;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

(use r7rs)

(define-library (loris platform)
  (import (scheme base)
          (scheme char)		; XXX: "not unicode-aware" / r7rs egg ref
          (scheme case-lambda)
          (scheme process-context)
          (scheme file)
          (scheme process-context)
          (srfi 1)
          (srfi 13)
          (srfi 14)
          (loris convenience)
          (loris output)
          (prefix (loris version) version:)

          ;; XXX: Chicken-specific
          (prefix (only (extras)
                        randomize random)	; used here, not exported
                  chicken:)
          (only (posix)
                process process-wait ; used here, not exported
                file-modification-time file-link current-directory) ; reexported only
          (only (files) 	; all these are reexported
                make-absolute-pathname absolute-pathname? normalize-pathname
                delete-file))	; reexported and used here for delete-filename*
  (export program-name
          stderr-to-null
          platform-dir-slashes
          program-available?
          ref
          init
          allowed-in-filename?
          delete-file*
          random-integer

          ;; reexport from posix module
          file-modification-time file-link current-directory

          ;; reexport from files module
          make-absolute-pathname absolute-pathname? normalize-pathname delete-file)
  (begin
................................................................................
                        (equal? needle feature))
                      available-features))
              needles)))
    (define (software-type) (feature-find '(posix unix windows)))
    (define (operating-system) (feature-find '(aix sunos solaris haiku dragonflybsd dragonfly
                                                   hpux macosx openbsd netbsd freebsd linux ecos
                                                   unix android windows unknown)))
    (chicken:randomize)
    ;; RANDOM-INTEGER returns a (pseudo)-random integer >= 0. If the
    ;; optional integer parameter ROOF is supplied, the procedure will
    ;; evaluate to an integer less than the value of this parameter.
    ;; The default value of ROOF is 32768. If the user tries to set
    ;; ROOF higher than 32768, this procedure will throw an error.
    (define random-integer
      (case-lambda
        ;; The maximum integer returned by the RANDOM procedure from
        ;; Chicken's extras is 32767 on Windows and Solaris. For
        ;; platform interoperability, it is therefor reasonable to
        ;; limit this procedure to returning integers below that.
        (() (random-integer 32768))
        ((roof) (chicken:random roof))))

    (define (stderr-to-null cmd)
      (if (eq? (software-type) 'windows)
          (conc cmd " 2> NUL")
          (conc cmd " 2> /dev/null")))

    (define (platform-dir-slashes str)