add 'fs-change mode to `system-type'

Report whether `filesyste-change-evt' is supported, works
at the granularity of files, etc.

pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl

@@ -528,7 +528,9 @@ is called.
 A @tech{filesystem change event} is placed under the management of the
 @tech{current custodian} when it is created. If the @tech{custodian}
 is shut down, @racket[filesystem-change-evt-cancel] is applied to the
-event.}
+event.
+
+See also @racket[system-type] in @racket['fs-change] mode.}
 
 
 @defproc[(filesystem-change-evt-cancel [evt filesystem-change-evt?])

pkgs/racket-pkgs/racket-doc/scribblings/reference/runtime.scrbl

@@ -3,9 +3,10 @@
 
 @title[#:tag "runtime"]{Environment and Runtime Information}
 
-@defproc[(system-type [mode (or/c 'os 'word 'gc 'link 'so-suffix 'so-mode 'machine)
+@defproc[(system-type [mode (or/c 'os 'word 'gc 'link 'machine
+                                  'so-suffix 'so-mode 'fs-change)
                             'os])
-         (or/c symbol? string? bytes? exact-positive-integer?)]{
+         (or/c symbol? string? bytes? exact-positive-integer? vector?)]{
 
 Returns information about the operating system, build mode, or machine
 for a running Racket.
@@ -43,6 +44,10 @@ In @indexed-racket['link] mode, the possible symbol results are:
 Future ports of Racket may expand the list of @racket['os],
 @racket['gc], and @racket['link] results.
 
+In @indexed-racket['machine] mode, then the result is a string, which
+contains further details about the current machine in a
+platform-specific format.
+
 In @indexed-racket['so-suffix] mode, then the result is a byte string
 that represents the file extension used for shared objects on the
 current platform. The byte string starts with a period, so it is
@@ -53,9 +58,29 @@ if foreign libraries should be opened in ``local'' mode by default
 (as on most platforms) or @racket['global] if foreign libraries
 should be opened in ``global'' mode.
 
-In @indexed-racket['machine] mode, then the result is a string, which
-contains further details about the current machine in a
-platform-specific format.}
+In @indexed-racket['fs-change] mode, the result is an immutable vector
+of four elements. Each element is either @racket[#f] or a symbol,
+where a symbol indicates the presence of a property and @racket[#f]
+indicates the absence of a property. The possible symbols, in order,
+are:
+
+@itemize[
+@item{@indexed-racket['supported] --- @racket[filesystem-change-evt]
+ can produce a @tech{filesystem change event} to monitor filesystem changes;
+ if this symbol is not first in the vector, all other vector elements
+ are @racket[#f]}
+@item{@indexed-racket['scalable] --- resources consumed by a
+ @tech{filesystem change event} are effectively limited only by
+ available memory, as opposed to file-descriptor limits; this property
+ is @racket[#f] on Mac OS X and BSD variants of Unix}
+@item{@indexed-racket['low-latency] --- creation and checking of a
+ @tech{filesystem change event} is practically instantaneous; this
+ property is @racket[#f] on Linux}
+@item{@indexed-racket['file-level] --- a @tech{filesystem change
+ event} can track changes at the level of a file, as opposed to the
+ file's directory; this property is @racket[#f] on Windows}
+]
+}
 
 
 @defproc[(system-language+country) string?]{

pkgs/racket-pkgs/racket-test/tests/racket/file.rktl

@@ -1384,15 +1384,8 @@
 (test #f filesystem-change-evt? 'evt)
 
 (let ([dir (make-temporary-file "change~a" 'directory)])
-  (define known-file-supported?
-    (case (system-type)
-      [(macosx) #t]
-      [else #f]))
-  (define known-supported?
-    (or known-file-supported?
-        (case (system-type)
-          [(windows) #t]
-          [else #f])))
+  (define known-supported? (vector-ref (system-type 'fs-change) 0))
+  (define known-file-supported? (vector-ref (system-type 'fs-change) 3))
   (define (check-supported evt file?)
     (when (if file?
               known-file-supported?

racket/lib/collects/racket/HISTORY.txt

@@ -1,5 +1,6 @@
 Version 5.3.900.7
 Changed equal? to work on module path index values
+Added 'fs-change mode to system-type
 
 Version 5.3.900.6
 Added identifier-binding-symbol

racket/src/racket/src/port.c

@@ -6272,6 +6272,33 @@ void scheme_release_inotify()
 #endif
 }
 
+void scheme_fs_change_properties(int *_supported, int *_scalable, int *_low_latency, int *_file_level)
+{
+#ifdef NO_FILESYSTEM_CHANGE_EVTS
+  *_supported = 0;
+  *_scalable = 0;
+  *_low_latency = 0;
+  *_file_level = 0;
+#else
+  *_supported = 1;
+# if defined(HAVE_KQUEUE_SYSCALL)  
+  *_scalable = 0;
+# else
+  *_scalable = 1;
+# endif
+# if defined(HAVE_INOTIFY_SYSCALL)
+  *_low_latency = 0;
+# else
+  *_low_latency = 1;
+# endif
+# if defined(DOS_FILE_SYSTEM)
+  *_file_level = 0;
+# else
+  *_file_level = 1;
+# endif
+#endif
+}
+
 /*========================================================================*/
 /*                          FILE input ports                              */
 /*========================================================================*/

racket/src/racket/src/schpriv.h

@@ -3823,6 +3823,8 @@ void scheme_init_kqueue(void);
 void scheme_release_kqueue(void);
 void scheme_release_inotify(void);
 
+void scheme_fs_change_properties(int *_supported, int *_scalable, int *_low_latency, int *_file_level);
+
 THREAD_LOCAL_DECL(extern struct mz_fd_set *scheme_semaphore_fd_set);
 THREAD_LOCAL_DECL(extern Scheme_Hash_Table *scheme_semaphore_fd_mapping);
 

racket/src/racket/src/string.c

@@ -352,7 +352,7 @@ static char *string_to_from_locale(int to_bytes,
 ROSYM static Scheme_Object *sys_symbol;
 ROSYM static Scheme_Object *link_symbol, *machine_symbol, *gc_symbol;
 ROSYM static Scheme_Object *so_suffix_symbol, *so_mode_symbol, *word_symbol;
-ROSYM static Scheme_Object *os_symbol;
+ROSYM static Scheme_Object *os_symbol, *fs_change_symbol;
 ROSYM static Scheme_Object *platform_3m_path, *platform_cgc_path;
 READ_ONLY static Scheme_Object *zero_length_char_string;
 READ_ONLY static Scheme_Object *zero_length_byte_string;
@@ -363,6 +363,8 @@ SHARED_OK static char *embedding_banner;
 SHARED_OK static Scheme_Object *vers_str;
 SHARED_OK static Scheme_Object *banner_str;
 
+SHARED_OK static Scheme_Object *fs_change_props;
+
 READ_ONLY static Scheme_Object *complete_symbol, *continues_symbol, *aborts_symbol, *error_symbol;
 
 void
@@ -380,6 +382,7 @@ scheme_init_string (Scheme_Env *env)
   REGISTER_SO(so_mode_symbol);
   REGISTER_SO(word_symbol);
   REGISTER_SO(os_symbol);
+  REGISTER_SO(fs_change_symbol);
   link_symbol = scheme_intern_symbol("link");
   machine_symbol = scheme_intern_symbol("machine");
   gc_symbol = scheme_intern_symbol("gc");
@@ -387,6 +390,7 @@ scheme_init_string (Scheme_Env *env)
   so_mode_symbol = scheme_intern_symbol("so-mode");
   word_symbol = scheme_intern_symbol("word");
   os_symbol = scheme_intern_symbol("os");
+  fs_change_symbol = scheme_intern_symbol("fs-change");
 
   REGISTER_SO(zero_length_char_string);
   REGISTER_SO(zero_length_byte_string);
@@ -423,6 +427,31 @@ scheme_init_string (Scheme_Env *env)
   REGISTER_SO(vers_str);
   REGISTER_SO(banner_str);
 
+  REGISTER_SO(fs_change_props);
+  {
+    int supported, scalable, low_latency, file_level;
+    Scheme_Object *s;
+    scheme_fs_change_properties(&supported, &scalable, &low_latency, &file_level);
+    fs_change_props = scheme_make_vector(4, scheme_false);
+    if (supported) {
+      s = scheme_intern_symbol("supported");
+      SCHEME_VEC_ELS(fs_change_props)[0] = s;
+    }
+    if (scalable) {
+      s = scheme_intern_symbol("scalable");
+      SCHEME_VEC_ELS(fs_change_props)[1] = s;
+    }
+    if (low_latency) {
+      s = scheme_intern_symbol("low-latency");
+      SCHEME_VEC_ELS(fs_change_props)[2] = s;
+    }
+    if (file_level) {
+      s = scheme_intern_symbol("file-level");
+      SCHEME_VEC_ELS(fs_change_props)[3] = s;
+    }
+    SCHEME_SET_IMMUTABLE(fs_change_props);
+  }
+
   vers_str = scheme_make_utf8_string(scheme_version());
   SCHEME_SET_CHAR_STRING_IMMUTABLE(vers_str);
   banner_str = scheme_make_utf8_string(scheme_banner());
@@ -2711,8 +2740,12 @@ static Scheme_Object *system_type(int argc, Scheme_Object *argv[])
       return scheme_make_integer(sizeof(void*)*8);
     }
 
+    if (SAME_OBJ(argv[0], fs_change_symbol)) {
+      return fs_change_props;
+    }
+
     if (!SAME_OBJ(argv[0], os_symbol)) {
-      scheme_wrong_contract("system-type", "(or/c 'os 'word 'link 'machine 'gc 'so-suffix 'so-mode 'word)", 0, argc, argv);
+      scheme_wrong_contract("system-type", "(or/c 'os 'word 'link 'machine 'gc 'so-suffix 'so-mode 'word 'fs-change)", 0, argc, argv);
       return NULL;
     }
   }