diff --git a/src/classes/String.c b/src/classes/String.c index 8db56ed..8ccfeb4 100644 --- a/src/classes/String.c +++ b/src/classes/String.c @@ -36,6 +36,7 @@ #include #include #include +#include #include #include #include @@ -88,6 +89,30 @@ static int boolean_from_value(LT_Value value, const char* message){ return LT_Value_boolean_value(value); } +static LT_Value string_fnmatch_result(LT_String* string, + LT_String* pattern, + int flags){ + int result; + + errno = 0; + result = fnmatch( + LT_String_value_cstr(pattern), + LT_String_value_cstr(string), + flags + ); + if (result == 0){ + return LT_TRUE; + } + if (result == FNM_NOMATCH){ + return LT_FALSE; + } + if (errno != 0){ + LT_system_error("Could not match filename pattern", errno); + } + LT_error(LT_sprintf("Could not match filename pattern (fnmatch returned %d)", result)); + return LT_FALSE; +} + static size_t String_byte_offset_for_codepoint_index(LT_String* string, size_t index){ const char* cursor = string->str; @@ -988,6 +1013,42 @@ LT_DEFINE_PRIMITIVE( ); } +LT_DEFINE_PRIMITIVE( + string_method_fn_match, + "String>>fnMatch?:", + "(self pattern)", + "Return true when the string matches a POSIX filename pattern." +){ + LT_Value cursor = arguments; + LT_String* self; + LT_String* pattern; + (void)tail_call_unwind_marker; + + LT_GENERIC_ARG(cursor, self, LT_String*, LT_String_from_value); + LT_GENERIC_ARG(cursor, pattern, LT_String*, LT_String_from_value); + LT_ARG_END(cursor); + + return string_fnmatch_result(self, pattern, 0); +} + +LT_DEFINE_PRIMITIVE( + string_method_fn_match_pathname, + "String>>fnMatchPathname?:", + "(self pattern)", + "Return true when the string matches a POSIX filename pattern without wildcards matching slashes." +){ + LT_Value cursor = arguments; + LT_String* self; + LT_String* pattern; + (void)tail_call_unwind_marker; + + LT_GENERIC_ARG(cursor, self, LT_String*, LT_String_from_value); + LT_GENERIC_ARG(cursor, pattern, LT_String*, LT_String_from_value); + LT_ARG_END(cursor); + + return string_fnmatch_result(self, pattern, FNM_PATHNAME); +} + LT_DEFINE_PRIMITIVE( string_method_match, "String>>match:", @@ -1702,6 +1763,8 @@ static LT_Method_Descriptor String_methods[] = { {"append:", &string_method_append}, {"replace:with:", &string_method_replace_with}, {"replaceFirst:with:", &string_method_replace_first_with}, + {"fnMatch?:", &string_method_fn_match}, + {"fnMatchPathname?:", &string_method_fn_match_pathname}, {"match:", &string_method_match}, {"matches?:", &string_method_matches}, {"substitute:with:", &string_method_substitute}, diff --git a/src/modules/os.c b/src/modules/os.c index 8412ca6..0467e6d 100644 --- a/src/modules/os.c +++ b/src/modules/os.c @@ -3,6 +3,10 @@ * Copyright (c) 2023 - 2026 Ales Hakl */ +#ifndef _GNU_SOURCE +#define _GNU_SOURCE +#endif + #include #include #include @@ -16,6 +20,8 @@ #include #include +#include +#include #include #include #include @@ -178,6 +184,109 @@ static void bind_os_primitive(LT_Environment* environment, #define OS_STAT_ARG(cursor, name) \ LT_GENERIC_ARG(cursor, name, LT_OS_Stat*, LT_OS_Stat_from_value) +struct OS_Flag { + const char* name; + int value; +}; + +static int os_flags_from_keywords(const struct OS_Flag* available, + size_t available_count, + LT_Value keywords, + const char* operation){ + int flags = 0; + + while (keywords != LT_NIL){ + LT_Value keyword; + LT_Symbol* symbol; + size_t index; + + if (!LT_Pair_p(keywords)){ + LT_error(LT_sprintf("%s flags must be a proper list", operation)); + } + keyword = LT_car(keywords); + symbol = LT_Symbol_from_value(keyword); + if (LT_Symbol_package(symbol) != LT_PACKAGE_KEYWORD){ + LT_error(LT_sprintf("%s flags must be keywords", operation)); + } + for (index = 0; index < available_count; index++){ + if (strcmp(LT_Symbol_name(symbol), available[index].name) == 0){ + flags |= available[index].value; + break; + } + } + if (index == available_count){ + LT_error(LT_sprintf( + "Unknown %s flag: %s", + operation, + LT_Symbol_name(symbol) + )); + } + keywords = LT_cdr(keywords); + } + return flags; +} + +static const struct OS_Flag fnmatch_flags[] = { + {"pathname", FNM_PATHNAME}, + {"noescape", FNM_NOESCAPE}, + {"period", FNM_PERIOD}, +#ifdef FNM_LEADING_DIR + {"leading-dir", FNM_LEADING_DIR}, +#endif +#ifdef FNM_CASEFOLD + {"casefold", FNM_CASEFOLD}, +#endif +#ifdef FNM_EXTMATCH + {"extmatch", FNM_EXTMATCH}, +#endif +}; + +static const struct OS_Flag glob_flags[] = { + {"err", GLOB_ERR}, + {"mark", GLOB_MARK}, + {"nocheck", GLOB_NOCHECK}, + {"noescape", GLOB_NOESCAPE}, + {"nosort", GLOB_NOSORT}, +#ifdef GLOB_PERIOD + {"period", GLOB_PERIOD}, +#endif +#ifdef GLOB_BRACE + {"brace", GLOB_BRACE}, +#endif +#ifdef GLOB_NOMAGIC + {"nomagic", GLOB_NOMAGIC}, +#endif +#ifdef GLOB_TILDE + {"tilde", GLOB_TILDE}, +#endif +#ifdef GLOB_TILDE_CHECK + {"tilde-check", GLOB_TILDE_CHECK}, +#endif +#ifdef GLOB_ONLYDIR + {"onlydir", GLOB_ONLYDIR}, +#endif +}; + +static LT_Value os_fnmatch_result(const char* pattern, + const char* string, + int flags){ + int result; + + errno = 0; + result = fnmatch(pattern, string, flags); + if (result == 0){ + return LT_TRUE; + } + if (result == FNM_NOMATCH){ + return LT_FALSE; + } + if (errno != 0){ + LT_system_error("Could not match filename pattern", errno); + } + LT_error(LT_sprintf("Could not match filename pattern (fnmatch returned %d)", result)); + return LT_FALSE; +} + #define DEFINE_OS_STAT_PREDICATE_METHOD(c_name, selector, predicate, description) \ LT_DEFINE_PRIMITIVE( \ c_name, \ @@ -787,6 +896,71 @@ LT_DEFINE_PRIMITIVE( return (LT_Value)(uintptr_t)LT_ByteVector_new(bytes, length); } +LT_DEFINE_PRIMITIVE( + primitive_os_fnmatch_p, + "fnmatch?", + "(pattern string :rest flag)", + "Return true when string matches a POSIX filename pattern with keyword flags." +){ + LT_Value cursor = arguments; + LT_String* pattern; + LT_String* string; + LT_Value flag_keywords; + int flags; + + OS_STRING_ARG(cursor, pattern); + OS_STRING_ARG(cursor, string); + LT_ARG_REST(cursor, flag_keywords); + flags = os_flags_from_keywords( + fnmatch_flags, + sizeof(fnmatch_flags) / sizeof(fnmatch_flags[0]), + flag_keywords, + "fnmatch" + ); + return os_fnmatch_result( + LT_String_value_cstr(pattern), + LT_String_value_cstr(string), + flags + ); +} + +LT_DEFINE_PRIMITIVE( + primitive_os_glob, + "glob", + "(pattern :rest flag)", + "Return paths matching a POSIX glob pattern; glob errors produce an empty list." +){ + LT_Value cursor = arguments; + LT_String* pattern; + LT_Value flag_keywords; + glob_t matches = {0}; + LT_ListBuilder* builder; + size_t index; + int flags; + int result; + + OS_STRING_ARG(cursor, pattern); + LT_ARG_REST(cursor, flag_keywords); + flags = os_flags_from_keywords( + glob_flags, + sizeof(glob_flags) / sizeof(glob_flags[0]), + flag_keywords, + "glob" + ); + result = glob(LT_String_value_cstr(pattern), flags, NULL, &matches); + builder = LT_ListBuilder_new(); + if (result == 0){ + for (index = 0; index < matches.gl_pathc; index++){ + LT_ListBuilder_append( + builder, + (LT_Value)(uintptr_t)LT_String_new_cstr(matches.gl_pathv[index]) + ); + } + } + globfree(&matches); + return LT_ListBuilder_value(builder); +} + LT_DEFINE_PRIMITIVE( primitive_os_list_directory, "list-directory", @@ -862,6 +1036,8 @@ void ListTalk_os_load(LT_Environment* environment){ bind_os_primitive(environment, package, &primitive_os_readlink); bind_os_primitive(environment, package, &primitive_os_symlink); bind_os_primitive(environment, package, &primitive_os_getentropy); + bind_os_primitive(environment, package, &primitive_os_fnmatch_p); + bind_os_primitive(environment, package, &primitive_os_glob); bind_os_primitive(environment, package, &primitive_os_list_directory); LT_loader_provide(environment, "os"); } diff --git a/tests/eval-modules-os.lt b/tests/eval-modules-os.lt index 4d2e046..959c4d2 100644 --- a/tests/eval-modules-os.lt +++ b/tests/eval-modules-os.lt @@ -41,6 +41,17 @@ (check (null? (ListTalk:OS:getenv "__LISTTALK_EVAL_TEST_MISSING_ENV__")) "getenv returns nil for missing variable") (check (string? (ListTalk:OS:getpwd)) "getpwd returns current directory") +(check (ListTalk:OS:fnmatch? "*.c" "module.c") "fnmatch? matches a pattern") +(check (not (ListTalk:OS:fnmatch? "*.c" "module.h")) + "fnmatch? rejects a non-match") +(check (not (ListTalk:OS:fnmatch? "*.c" "src/module.c" :pathname)) + "fnmatch? maps rest keywords to POSIX flags") +(check (null? (ListTalk:OS:glob "__listtalk_missing_glob_*")) + "glob returns an empty list and ignores no-match errors") +(let ((matches (ListTalk:OS:glob + (string-append (ListTalk:OS:getpwd) "/*")))) + (check (and (pair? matches) (string? (car matches))) + "glob returns matching path strings")) (let ((bytes (ListTalk:OS:getentropy 300))) (check (eq? (type-of bytes) ByteVector) "getentropy returns ByteVector") (check (= (bytevector-length bytes) 300) "getentropy returns requested length")) diff --git a/tests/eval-objects.lt b/tests/eval-objects.lt index e7a71b3..ba9d34b 100644 --- a/tests/eval-objects.lt +++ b/tests/eval-objects.lt @@ -799,6 +799,16 @@ (check (= ['() length] 0) "Nil as empty List>>length") (check (= ['(1 2 3) at: 1] 2) "List>>at: dispatches correctly") (check (= ["hello" length] 5) "String>>length") +(check ["src/classes/String.c" fnMatch?: "src/*/*.c"] + "String>>fnMatch?: matches with default POSIX behavior") +(check (not ["src/classes/String.h" fnMatch?: "*.c"]) + "String>>fnMatch?: rejects a non-match") +(check ["src/classes/String.c" fnMatch?: "src/*.c"] + "String>>fnMatch?: allows wildcards to match slashes by default") +(check (not ["src/classes/String.c" fnMatchPathname?: "src/*.c"]) + "String>>fnMatchPathname?: prevents wildcards from matching slashes") +(check ["src/classes/String.c" fnMatchPathname?: "src/classes/*.c"] + "String>>fnMatchPathname?: matches within pathname components") (check (eq? ["hello" at: 1] (string-ref "hello" 1)) "String>>at: dispatches correctly") (check (equal? ["aλ" append: "😀z"] "aλ😀z") "String>>append: concatenates") (check (equal? ["aλ😀z" from: 1 to: 3] "λ😀")