Projects
Factory:RISC-V:Base
slang
Sign Up
Log In
Username
Password
We truncated the diff of some files because they were too big. If you want to see the full diff for every file,
click here
.
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
Expand all
Collapse all
Changes of Revision 3
View file
_service:tar_scm:slang.spec
Changed
@@ -1,8 +1,8 @@ %bcond_with oniguruma Name: slang -Version: 2.3.2 -Release: 9 +Version: 2.3.3 +Release: 1 Summary: An interpreted language and programing library License: GPLv2+ URL: https://www.jedsoft.org/slang/ @@ -11,8 +11,7 @@ Provides: %{name}-slsh = %{version}-%{release} Obsoletes: %{name}-slsh < %{version}-%{release} -Patch6000: slang-getkey-memmove.patch -Patch6001: slang-sighuptest.patch +Patch0: slang-sighuptest.patch BuildRequires: gcc libpng-devel pcre-devel zlib-devel @@ -84,6 +83,9 @@ %{_mandir}/man1/slsh.1* %changelog +* Wed Jan 18 2023 fuanan <fuanan3@h-partners.com> - 2.3.3-1 +- update version to 2.3.3 + * Mon Aug 02 2021 chenyanpanHW <chenyanpan@huawei.com> - 2.3.2-9 - DESC: delete -Sgit from %autosetup, and delete BuildRequires git
View file
_service:tar_scm:slang-getkey-memmove.patch
Deleted
@@ -1,31 +0,0 @@ -commit d338fd6e949ef62e7eac4eb5c024059e02158b06 -Author: Miroslav Lichvar <mlichvar@redhat.com> -Date: Wed Jul 25 13:07:42 2018 +0200 - - Replaced memcpy in SLang_getkey - - memcpy() is not defined for overlapping buffers, i.e. it may copy bytes - in any direction. As SLMEMMOVE is not defined in slang, replace the - SLMEMCPY call with a for loop. - -diff --git a/src/slgetkey.c b/src/slgetkey.c -index 86e7946..d9bc678 100644 ---- a/src/slgetkey.c -+++ b/src/slgetkey.c -@@ -40,13 +40,13 @@ unsigned int SLang_getkey (void) - - if (SLang_Input_Buffer_Len) - { -- unsigned int imax; -+ unsigned int i, imax; - ch = (unsigned int) *SLang_Input_Buffer; - SLang_Input_Buffer_Len--; - imax = SLang_Input_Buffer_Len; - -- SLMEMCPY ((char *) SLang_Input_Buffer, -- (char *) (SLang_Input_Buffer + 1), imax); -+ for (i = 0; i < imax; i++) -+ SLang_Input_Bufferi = SLang_Input_Bufferi + 1; - } - else if (SLANG_GETKEY_ERROR == (ch = _pSLsys_getkey ())) return ch; -
View file
_service:tar_scm:slang-2.3.2.tar.bz2/INSTALL.pc -> _service:tar_scm:slang-2.3.3.tar.bz2/INSTALL.pc
Changed
@@ -28,13 +28,14 @@ The final step installs the library and its components. The actual work is carried out by slsh, which was created in step 2. Please -note, if you make an changes the installation paths in the makefile +note, if you make any changes the installation paths in the makefile after completing step 2, then you will need to rebuild it. That is, run `mingw32-make clean', then go to step 2. Finally you will need to make sure that the $PREFIX/bin directory is -in your PATH. Assuming that this has been done, you should be able -to run `slsh' at the CMD prompt. +in your PATH. Here, $PREFIX refers to the value of the PREFIX +variable in the Makefile. Assuming that this has been done, you +should be able to run `slsh' at the CMD prompt. More information on the makefile generation process is available in src/mkfiles/README.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/NEWS -> _service:tar_scm:slang-2.3.3.tar.bz2/NEWS
Changed
@@ -1,4 +1,11 @@ -NEWS for version 2.3.x -*-text-*- +-*-text-*- + +See changes.txt for a detailed list of changes. The changes described +below are highlights. + +=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x= + +NEWS for version 2.3.x 24 bit color support (new for version 2.3.1) ============================================ @@ -8,18 +15,20 @@ available for 64 bit Unix/VMS systems to keep binary compatibility. Support for 32 bit systems will be added in version 3. - Since not all terminals support true color, and it is not supported - by terminfo, 24 bit color is disabled by default. A list of - terminals that support true color may be found at - <https://gist.github.com/XVilka/8346728>. + The library tries to detect the terminal's support for 24 bit true by + looking for the "RGB" terminfo flag. If this flag exists, and is + TRUE then true color will be enabled. Note that this this flag is a + relatively recent addition to terminfo and is defined by the + so-called user-defined terminfo extension. A list of terminals that + support true color may be found at <https://github.com/termstandard/colors>. - To indicate that a terminal supports true color, set the value of - the environment variable COLORTERM to either "24bit" or "truecolor", - e.g., + If the terminal supports 24 bit true color, but the library does not + detect it, then set the value of the environment variable COLORTERM + to either "24bit" or "truecolor", e.g., export COLORTERM=truecolor - Then to use 24 bit color in applications such as jed and slrn, use a + To use 24 bit color in applications such as jed and slrn, use a 24bit RGB value in the form "#RRGGBB" as the name of the color. For example, to set the color of the status line in jed to AliceBlue (#F0F8FF) on a SlateGray (#708090) background, use @@ -38,8 +47,7 @@ =========== 1. base64: A base64 encoder/decoder module - 2. chksum: A module for computing various checksums (currently md5 - and sha1) + 2. chksum: A module for computing various checksums (md5, sha1, ...) 3. stats: A statistics module 4. histogram: A histogram module 5. json: Encode/decode json structures @@ -48,7 +56,15 @@ ============== stats-module: Added Anderson-Darling normality and - k-sample tests (version 2.3.1) + k-sample tests (version 2.3.1) + Added a cumulant function (version 2.3.3) + + chksum-module: + 8, 16, and 32 bit CRCs were added (version 2.3.3) + sha224, sha256, sha384, and sha512 added (version 2.3.3) + HMAC added (version 2.3.3) + + Intrinsic Functions =================== @@ -92,8 +108,13 @@ _array_byteswap: used to convert the values of an array from one endianness to another (version 2.3.2) + fclock: Apply an advisory lock (version 2.3.3) + The following functions have been enhanced: + stat_file was modifed to accept an open file descriptor (version + 2.3.3) + array_map modified to support multiple return values. is_substrbytes: Added support for an optional offset into the @@ -102,6 +123,10 @@ _push_struct_field_values: An optional argument may be used to specify the fields to be pushed. (version 2.3.1) + fgetslines: Added support for a "trim" qualifier to indicate how + leading/trailing whitespace is to be handled (version 2.3.3) + + Interpreter Syntax ================== @@ -132,6 +157,13 @@ rearrange: Performs an in-place arrangement of values in an array or list (defined in arrayfuns.sl). + timestamp.sl: Parses timestamp strings such as Thu May 14 18:05:05 + 2020 and returns the number of seconds since the Unix epoch + (version 2.3.3) + + slcov: produces an LCOV compatible code coverage data for slang + scripts (version 2.3.3). See <http://jedsoft.org/slang/slcov/> + for some examples slsh ==== @@ -145,6 +177,12 @@ Note: The slang 2.3.x API is backward binary compatible with slang 2.y.z. + The size of the interpreter's runtime stack is now dynamically + allocated and can grow up to a maximum configured size (version + 2.3.3) + + Added support for TERMINFO_DIR (version 2.3.3) + Font attributes (italics, bold, underline, ...) may be enabled for terminals that support them by using a color name with a qualifier: @@ -214,8 +252,12 @@ Miscellaneous ============= - Support was added to support 32-bit terminfo database - entries introduced by ncurses 6.1 (version 2.3.2) + Support was added to support 32-bit terminfo database entries + introduced by ncurses 6.1 (version 2.3.2), and (in version 2.3.3) + for so-called user-defined terminfo extensions. In particular, if + the terminfo file defines RGB=true, then truecolor support will be + enabled. + =x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=
View file
_service:tar_scm:slang-2.3.2.tar.bz2/autoconf/aclocal.m4 -> _service:tar_scm:slang-2.3.3.tar.bz2/autoconf/aclocal.m4
Changed
@@ -1,4 +1,6 @@ dnl# -*- mode: sh; mode: fold -*- +dnl# 0.3.4.1: Added /{lib,etc}/terminfo to terminfo directory list +dnl# 0.3.4.0: Added $(CPPFLAGS) dnl# 0.3.3-1: Use INSTALL instead of INSTALL_DATA to install modules to get executable permissions dnl# 0.3.3-0: Added $(OBJ_O_DEPS) and $(ELF_O_DEPS) to PROGRAM_OBJECT_RULES dnl# 0.3.2-0: Add rpath support for freebsd @@ -352,7 +354,7 @@ AC_DEFUN(JD_GCC_WARNINGS, dnl#{{{ AC_ARG_ENABLE(warnings, - AC_HELP_STRING(--enable-warnings,turn on GCC compiler warnings), + AS_HELP_STRING(--enable-warnings,turn on GCC compiler warnings), gcc_warnings=$enableval) if test -n "$GCC" then @@ -511,7 +513,8 @@ /usr/lib/terminfo \ /usr/share/terminfo \ /usr/share/lib/terminfo \ - /usr/local/lib/terminfo" + /usr/local/lib/terminfo \ + /etc/terminfo /lib/terminfo" TERMCAP=-ltermcap for terminfo_dir in $JD_Terminfo_Dirs @@ -535,11 +538,12 @@ AC_DEFUN(JD_ANSI_CC, dnl#{{{ -AC_AIX +dnl# AC_AIX +AC_USE_SYSTEM_EXTENSIONS AC_REQUIRE(AC_PROG_CC) AC_REQUIRE(AC_PROG_CPP) AC_REQUIRE(AC_PROG_GCC_TRADITIONAL) -AC_ISC_POSIX +dnl# AC_ISC_POSIX dnl #This stuff came from Yorick config script dnl @@ -615,30 +619,30 @@ *linux*|*gnu*|k*bsd*-gnu ) DYNAMIC_LINK_FLAGS="-Wl,-export-dynamic" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ;; *solaris* ) if test "$GCC" = yes then DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-ztext -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-G -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" else DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -K PIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -K PIC" ELF_LINK="\$(CC) \$(LDFLAGS) -G -h\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-G -K PIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" fi ;; # osr5 or unixware7 with current or late autoconf @@ -647,20 +651,20 @@ then DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-G -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" else DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -K pic" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -K pic" # ELF_LINK="ld -G -z text -h#" ELF_LINK="\$(CC) \$(LDFLAGS) -G -z text -h\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-G -K pic" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" fi ;; *irix6.5* ) @@ -671,29 +675,29 @@ # not tested DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" else DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS)" # default anyhow + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS)" # default anyhow ELF_LINK="\$(CC) \$(LDFLAGS) -shared -o \$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-shared" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" fi ;; *darwin* ) DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fno-common" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fno-common" ELF_LINK="\$(CC) \$(LDFLAGS) -dynamiclib -install_name \$(install_lib_dir)/\$(ELFLIB_MAJOR) -compatibility_version \$(ELF_MAJOR_VERSION) -current_version \$(ELF_MAJOR_VERSION).\$(ELF_MINOR_VERSION)" ELF_DEP_LIBS="\$(LDFLAGS) \$(DL_LIB)" CC_SHARED_FLAGS="-bundle -flat_namespace -undefined suppress -fno-common" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ELFLIB="lib\$(THIS_LIB).dylib" ELFLIB_MAJOR="lib\$(THIS_LIB).\$(ELF_MAJOR_VERSION).dylib" ELFLIB_MAJOR_MINOR="lib\$(THIS_LIB).\$(ELF_MAJOR_VERSION).\$(ELF_MINOR_VERSION).dylib" @@ -701,7 +705,7 @@ ;; *freebsd* ) ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" #if test "X$PORTOBJFORMAT" = "Xelf" ; then # ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-soname,\$(ELFLIB_MAJOR)" #else @@ -710,19 +714,19 @@ ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-soname,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ;; *cygwin* ) DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" SLANG_DLL_CFLAGS="-DSLANG_DLL=1" - ELF_CFLAGS="\$(CFLAGS) -DBUILD_DLL=1" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -DBUILD_DLL=1" DLL_IMPLIB_NAME="lib\$(THIS_LIB)\$(ELFLIB_MAJOR_VERSION).dll.a" #ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR) -Wl,--out-implib=\$(DLL_IMPLIB_NAME) -Wl,-export-all-symbols -Wl,-enable-auto-import" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR) -Wl,--out-implib=\$(DLL_IMPLIB_NAME)" ELF_DEP_LIBS="\$(DL_LIB) -lm" CC_SHARED_FLAGS="-shared -DSLANG_DLL=1" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" dnl# CYGWIN prohibits undefined symbols when linking shared libs SLANG_LIB_FOR_MODULES="-L\$(ELFDIR) -lslang" INSTALL_MODULE="\$(INSTALL)" @@ -737,20 +741,20 @@ M_LIB="" DYNAMIC_LINK_FLAGS="-Wl,-export-dynamic" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB)" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ;; * ) echo "Note: ELF compiler for host_os=$host_os may be wrong" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" esac AC_SUBST(ELF_CC)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/autoconf/configure.ac -> _service:tar_scm:slang-2.3.3.tar.bz2/autoconf/configure.ac
Changed
@@ -182,6 +182,7 @@ ttyname ttyname_r \ newlocale strtod_l localeconv \ statvfs \ +flock \ ) if test x"$ac_cv_func_socketpair" != x"yes"; then
View file
_service:tar_scm:slang-2.3.2.tar.bz2/changes.txt -> _service:tar_scm:slang-2.3.3.tar.bz2/changes.txt
Changed
@@ -1,4 +1,187 @@ -*- mode: text; mode: fold -*- +Changes since 2.3.2 +1. src/slposdir.c: stat_file now support open file descriptors, in + addition to filenames. +2. src/sltoken.c: Ignore the \r character in multiline strings that + appear to have CRLF line terminators. (Manfred Hanke) +3. *.tm: minor documentation updates +4. src/slang.h: SLANG_VERSION_STRING was missing the "pre" prefix. +5. src/sltermin.c: Added support for TERMINFO_DIRS (based upon a patch + forwarded by Jörg Thalheim) +6. src/slarray.c: src/slarray.c: some integer overflow checks were + resulting undefined behavior (reported by Sergey) +7. modules/csv.sl: Strip leading/trailing whitespace from column names +8. src/slsmg.c,sldisply.c: Removed static buffers with sizes dependent + upon SLTT_MAX_SCREEN_ROWS/COLS in favor of dynamically allocated + ones. +9. modules/chksum-module: added CRC-8,16,32 checksums to the chksum module +10. modules/csv.sl: An error message in the form of a dollar-string + was not marked as such. +11. modules/csv.sl: Added support for empty CSV files +12. src/sltime.c: The timegm function will ignore the tm_wday and + tm_yday fields, and instead use the tm_mon and tm_mday fields. +13. modules/mkfiles/makefile.all: Added a target for chksum_crc.o for + win32/64 platforms (see change #9) +14. modules/chksum-module.c: The memset function was used with the + wrong structure size causing a buffer overflow on 32 bit systems. +15. src/terminfo/parsecaps.sl: Tweaked an auto-generated comment + produced by parsecaps.sl to produce a more deterministic build + (Ian Rogers). +16. src/slarray.c: Changed two instances of index errors to throw an + IndexError exception instead of InvalidParmError exception. +17. src/slposdir.c; The statvfs function was returning a struct with + duplicated f_bsize fields. +18. *.c: In switch statements, changed the /* drop */ comment to /* + fall through */ to avoid gcc-8 warnings. +19. modules/csv.sl: If a comment string appears at the start of a line + forming a multiline string, then treat it as part of the string. +20. slsh/lib/timestamp.sl: Added a function timestamp_parse that parses + strings such as `Thu May 14 18:05:05 2020` and returns the number + of seconds since the Unix epoch. +21. src/slregexp.c: Added \D (non-digit), \s (whitespace), and \S + (non-whitespace). +22. src/slstrops.c: Added a compiled regexp cache +23. src/slstdio.c: Added trim qualifier to the fgetlines intrinsic: + ;trim=1 ==> trim trailing whitespace + ;trim=2 ==> trim leading whitespace + ;trim=3 ==> trim leading and trailing whitespace +24. slsh/lib/timestamp.sl: When matching a regexp to a timestamp, + start with the RE that was used in the previous match. +25. Another timestamp RE tweak to pickup additional irregular forms +26. modules/csv.sl: If a CSV file has a byte-order mark (BOM), ignore it. +27. src/sldisply.c: Increased the buffer size for the SLtt_tgoto + function to allow for larger terminfo strings +28. modules/Makefile.in: Added STATS_OBJS to the clean target +29. src/slstrops.c: The is_substr function was not handling a NULL + argument +30. slsh/lib/timestamp.sl: Corrected a regular expression for a + timestamp with "Z" as the timezone. +31. modules/csv-module.c: Fields with an embedded \r were not being + properly handled. +32. src/slarray.c: Improved the speed of multi-dimensional array + indexing by about a factor of 2 +33. slsh/lib/timestamp.sl: The computation of leap days was incorrect + for some years +34. src/slang.h: Added `typedef void (*SLFVOID_STAR)(void)', which + will replace FVOID_STAR in version 3. The library code was + updated to use this. +35. slsh/lib/fswalk.sl: Added an optional callback argument to the + fswalk that is called when leaving a directory. +36. modules/termios-module.c: Avoid a potential problem with the + tcgetpgrp intrinsic in the unlikely case that sizeof(pid_t) is + larger than sizeof(int). +37. src/slarray.c: Simplified the range checking in the + linear_get_data_addr function and removed unused code. +38. Updated the copyright year +39. slsh/lib/fswalk.sl: Change #35 regression: The get_stat function + was being called with the wrong number of arguments. +40. src/slarith.c: Additional binary arithmetic optimizations involving + arrays of char and short. +41. src/slang.c,slarray.c: Added qualifier support to the array_map + function. +42. src/slang.c: Flagged the use of an uninitialized variable as soon + as it is accessed ("pushed") rather than waiting until it is used + ("popped"). Fixed a bug in slsh/lib/setfuns.sl:union that was + detected by this change. +43. src/sl-feat.h: Floating point support by the interpreter is now + required. The library has not compiled without it for a long + time. As such, this option is no longer available. +44. */test/*.sl: Surrounded regression test code that makes use of + complex numbers with `#ifexists Complex_Type' so that they run + when the interpreter is compiled without complex variable support. +45. src/slarray.c: The _pSLarray1d_push_elem needed to be exposed when + compiling the interpreter without optimization. +46. src/slarith.c,...: Rewrote the various macros used by this file to + simplify the code, permit better optimization, and easier + maintenance. Some of the loops were also unrolled. +47. src/slarray.c: Made the array bounds index checking code more + uniform for better readability. +48. src/slarray.c: The previous change introduced a bug that caused + array indexing with no (empty) indices to fail. +49. modules/chksum-module.c: When a CRC object went out of scope + without being closed, it would leave its value on the stack. +50. slsh/lib/process.sl: If the file descriptor that is used to + communicate messages from the child process back to the parent is + requested by the caller, then dup an unused one. To facilitate + testing, two additional hooks were added: exit_hook and exec_hook. +51. slsh/lib/cmdopt.sl: If a command line option is associated with a + callback function, and the value of the command line argument is + optional, pass the default value to the callback if not given on + the command line. +52. modules: Added cumulant function to the stats module; updated + regression scripts/unit tests for better code coverage; fixed a + bug in the _zlib_inflate_reset function where deflateReset was + being called instead of inflateReset. +53. slsh/lib: Updated unit/regression tests for better coverage +54. slsh/lib/print.sl: Use >= instead of > when comparing the number + of screen rows to determine if the pager should be used. +55. modules/chksum-module: Added sha224, sha256, sha384, and sha512 + algorithms kindly provided by Jakob Stierhof +56. modules/chksum-module: Added HMAC message authentication code + algorithm (Jakob Stierhof) +57. modules/mkfiles/makefile.all: Added chksum_sha2 to the non-Unix + makefile. +58. src/slgetkey.c: Use memmove instead of SLMEMCPY to avoid issues + with coping to an overlapping buffer. (William Ahern) +59. modules/pcre.sl: The options qualifier was not being properly + handled by the pcre_matches function. +60. src/_slang.h,etc: replaced the dependence of the internal + _pSLang_get_run_stack* functions, which return absolute pointers, + in favor of relative offsets. +61. src/slang.c: Made the run-time stack dynamically growable up to a + maximum configured size. +62. modules/: Documentation updates +63. src/: Added _set_bos/f_compile_hook functions to specify a + function to get called when a statement or function gets compiled. +64. src/sllimits.h: Reduced the initial stack size to a value similar + to what it was before change #61. +65. src/slarrfun.c: array_swap was returning a copy of the input array + when when swapping an array element with itself (bug reported by + Jakob Stierhof) +66. modules/csv.sl: If _csv_decode_row fails, include in the error + message the line number of the file where the error was detected +67. modules/socket-module.c: Corrected an error message for the bind + function +68. Updated the copyright year +69. Added slcov script which generates lcov-compatible code coverage + data +70. autoconf/aclocal.m4: Updated to v0.3.4.1 +71. slsh/Makefile.in: Changed the order of the linker flags to avoid a + linking problem on MacPorts (Ryan Schmidt) +72. slsh/lib/cmdopt.sl: Corrected a usage message +73. src/slposio.c: Added the flock function for the creation of + advisory locks +74. src/slcurses.h: Added 'extern "C"' to enable the file to be used + in C++ programs; also marked some variables as dynamically + exportable by using SL_EXTERN (Gisle Vanem) +75. src/slstrops.c: "%0*" was being flagged as invalid by the sprintf + function (Jakob Stierhof) +76. modules/csv.sl: When writing a CSV file with a single row, convert + any scalar data values to single element arrays. +77. src/Makefile.in, slsh/Makefile.in: Addressed some dependency + problems found by `make --shuffle` that were causing parallel + builds to fail (Sergei Trofimovich) +78. src/slarray.c: Flag out-of-range indexing of indefinite ranges + involving negative indexes, e.g., x = 1; y = x-2:; + Previousely this resulted in y = 1,1 instead of an error. +79. modules/csv.sl: Avoid indexing an empty array with a negative + index (detected by change #78) +80. src/slarray:c: #78 was flagging x:-2 as invalid instead of + producing an empty array for x=1 +81. src/slarray.c: Tweaked the handling of negative indices in + indefinite ranges such that x:-i will produce an empty array + wheneve i > length(x) +82. src/sltermin.c: Added support for so-called user-defined terminfo + extensions. In particular, if the terminfo file defines RGB=true, + then truecolor support will be enabled. +83. src/sldisply.c: The Has_True_Color variable was not defined for 32 + bit systems +84. modules/csv.sl: Improved read speed for large CSV files +85. src/test/posixio.sl: Do not test the flock function using an NFS + mounted direcory, which requires lockd to be running on the server + +{{{ Previous Versions + Changes since 2.3.1a 1. modules/stats_kendall.c: Updated to use Knight's O(NlogN) algorithm. This update was facilitating by separating out some @@ -60,8 +243,6 @@ 26. src/test/syntax.sl: The version number test required the use of isalpha and not isascii. -{{{ Previous Versions - Changes since 2.3.1 a. Some tests were failing when compiled with a compiler that defaults to using `unsigned char'. In the few places where a `signed char'
View file
_service:tar_scm:slang-2.3.2.tar.bz2/configure -> _service:tar_scm:slang-2.3.3.tar.bz2/configure
Changed
@@ -738,6 +738,7 @@ docdir oldincludedir includedir +runstatedir localstatedir sharedstatedir sysconfdir @@ -832,6 +833,7 @@ sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE}' @@ -1084,6 +1086,15 @@ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ @@ -1221,7 +1232,7 @@ for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir + libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. @@ -1374,6 +1385,7 @@ --sysconfdir=DIR read-only single-machine data PREFIX/etc --sharedstatedir=DIR modifiable architecture-independent data PREFIX/com --localstatedir=DIR modifiable single-machine data PREFIX/var + --runstatedir=DIR modifiable per-process data LOCALSTATEDIR/run --libdir=DIR object code libraries EPREFIX/lib --includedir=DIR C header files PREFIX/include --oldincludedir=DIR C header files for non-gcc /usr/include @@ -3881,62 +3893,6 @@ -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing strerror" >&5 -$as_echo_n "checking for library containing strerror... " >&6; } -if ${ac_cv_search_strerror+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_func_search_save_LIBS=$LIBS -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char strerror (); -int -main () -{ -return strerror (); - ; - return 0; -} -_ACEOF -for ac_lib in '' cposix; do - if test -z "$ac_lib"; then - ac_res="none required" - else - ac_res=-l$ac_lib - LIBS="-l$ac_lib $ac_func_search_save_LIBS" - fi - if ac_fn_c_try_link "$LINENO"; then : - ac_cv_search_strerror=$ac_res -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext - if ${ac_cv_search_strerror+:} false; then : - break -fi -done -if ${ac_cv_search_strerror+:} false; then : - -else - ac_cv_search_strerror=no -fi -rm conftest.$ac_ext -LIBS=$ac_func_search_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_strerror" >&5 -$as_echo "$ac_cv_search_strerror" >&6; } -ac_res=$ac_cv_search_strerror -if test "$ac_res" != no; then : - test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" - -fi - cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -5293,6 +5249,7 @@ ttyname ttyname_r \ newlocale strtod_l localeconv \ statvfs \ +flock \ do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` @@ -6097,7 +6054,7 @@ INSTALL_ELFLIB_TARGET="install-elf-and-links" ELFLIB_BUILD_NAME="\$(ELFLIB_MAJOR_MINOR_MICRO)" -INSTALL_MODULE="\$(INSTALL_DATA)" +INSTALL_MODULE="\$(INSTALL)" SLANG_DLL_CFLAGS="" M_LIB="-lm" @@ -6105,30 +6062,30 @@ *linux*|*gnu*|k*bsd*-gnu ) DYNAMIC_LINK_FLAGS="-Wl,-export-dynamic" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ;; *solaris* ) if test "$GCC" = yes then DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-ztext -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-G -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" else DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -K PIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -K PIC" ELF_LINK="\$(CC) \$(LDFLAGS) -G -h\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-G -K PIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" fi ;; # osr5 or unixware7 with current or late autoconf @@ -6137,20 +6094,20 @@ then DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-G -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" else DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -K pic" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -K pic" # ELF_LINK="ld -G -z text -h#" ELF_LINK="\$(CC) \$(LDFLAGS) -G -z text -h\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-G -K pic" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" fi ;; *irix6.5* ) @@ -6161,29 +6118,29 @@ # not tested DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-shared -fPIC"
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/text/cref.txt -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/text/cref.txt
Changed
@@ -1,6 +1,6 @@ The S-Lang C Library Reference John E. Davis <www.jedsoft.org> - Nov 11, 2013 + Jul 4, 2018 ____________________________________________________________ @@ -3715,10 +3715,10 @@ The type field specifies which field of the union f should be used. If type is SLKEY_F_INTERPRET, then f.s is a string that should be - passed to the interpreter for evaluation. If type is - SLKEY_F_INTRINSIC, then f.f refers to function that should be - called. Otherwise, type is SLKEY_F_KEYSYM and f.keysym represents - the value of the keysym that is associated with the key sequence. + passed to the interpreter for evaluation. If type is SLKEY_F_IN- + TRINSIC, then f.f refers to function that should be called. Other- + wise, type is SLKEY_F_KEYSYM and f.keysym represents the value of + the keysym that is associated with the key sequence. See Also SLkm_define_keysym, SLkm_define_key
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/text/cslang.txt -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/text/cslang.txt
Changed
@@ -1,6 +1,6 @@ S-Lang Library C Programmer's Guide (v2.3.0) John E. Davis <www.jedsoft.org> - Sep 14, 2014 + Jul 4, 2018 ____________________________________________________________ @@ -241,9 +241,9 @@ If the value of mode is 1, then the library will be put in UTF-8 mode. If the value of mode is 0, then the library will be initialized with UTF-8 support disabled. If the value is -1, then the mode will deter- - mined through an OS-dependent manner, e.g., for Unix, the standard - locale mechanism will be used. The return value of this function will - be 1 if UTF-8 support was activated, or 0 if not. + mined through an OS-dependent manner, e.g., for Unix, the standard lo- + cale mechanism will be used. The return value of this function will be + 1 if UTF-8 support was activated, or 0 if not. The above function determines the UTF-8 state of the library as a whole. For some purposes it may be desirable to have more fine-grained @@ -548,8 +548,8 @@ Here name is the name of the intrinsic function that the interpreter is to give to the function. func-ptr is a pointer to the intrinsic function taking num-args and returning ret-type. The final 7 arguments - specify the argument types. For example, the intrin_exit intrinsic - described above may be added to the table using + specify the argument types. For example, the intrin_exit intrinsic de- + scribed above may be added to the table using MAKE_INTRINSIC_N("exit", intrin_exit, SLANG_VOID_TYPE, 1, SLANG_INT_TYPE, 0,0,0,0,0,0) @@ -611,8 +611,8 @@ MAKE_INTRINSIC_2("vmin", intrin_min, SLANG_DOUBLE_TYPE, SLANG_DOUBLE_TYPE, SLANG_DOUBLE_TYPE) - It is useful to extend this function to take an arbitray number of - arguments and return the lesser. Consider the following variant: + It is useful to extend this function to take an arbitray number of ar- + guments and return the lesser. Consider the following variant: double intrin_min_n (int *num_ptr) { @@ -724,8 +724,8 @@ char S256; - then it would not be possible to make it directly available to the - interpreter. However, one could create a pointer to it, i.e., + then it would not be possible to make it directly available to the in- + terpreter. However, one could create a pointer to it, i.e., char *S_Ptr = S; @@ -847,8 +847,8 @@ SLang_set_array_element (at, &i, seasonsi) - was not used. The return value from this function was also checked - because it too could also fail. + was not used. The return value from this function was also checked be- + cause it too could also fail. Finally, the array was pushed onto the interpreter's stack and then it was freed. It is important to understand why it was freed. This is @@ -1100,9 +1100,8 @@ } Name_Type; - is not supported since char name32 is not a SLANG_STRING_TYPE - object. Always keep in mind that a SLANG_STRING_TYPE object is a char - *. + is not supported since char name32 is not a SLANG_STRING_TYPE ob- + ject. Always keep in mind that a SLANG_STRING_TYPE object is a char *. 5.5.2.2. Intrinsic Structures @@ -1384,8 +1383,8 @@ and set the S-Lang global variable SLKeyBoard_Quit to a non-zero value. In addition, if the default S-Lang interrupt handler has been specified by a NULL argument to the SLang_set_abort_signal function, - the error state of the library will be set to SL_UserBreak_Error - unless the variable SLang_Ignore_User_Abort is non-zero. + the error state of the library will be set to SL_UserBreak_Error un- + less the variable SLang_Ignore_User_Abort is non-zero. The SLang_getkey function waits until input is available to be read. The SLang_input_pending function may be used to determine whether or @@ -1950,10 +1949,10 @@ void SLtt_set_mono (int obj, char *, SLtt_Char_Type attr); Only the first of these routines will be discussed briefly here. The - latter two functions allow more fine control over the object to - attribute mapping (such as assigning a ``blink'' attribute to the - object). For a more full explanation on all of these routines see the - section about the SLtt interface. + latter two functions allow more fine control over the object to attri- + bute mapping (such as assigning a ``blink'' attribute to the object). + For a more full explanation on all of these routines see the section + about the SLtt interface. The SLtt_set_color function takes four parameters. The first parameter, obj, is simply the integer of the object for which @@ -2164,9 +2163,9 @@ It is important that handlers be established for these signals while the either the SLsmg routines or the getkey routines are initialized. - The SLang_init_tty, SLang_reset_tty, SLsmg_init_smg, and - SLsmg_reset_smg functions block these signals from occurring while - they are being called. + The SLang_init_tty, SLang_reset_tty, SLsmg_init_smg, and SLsmg_re- + set_smg functions block these signals from occurring while they are + being called. Since a signal can be delivered at any time, it is important for the signal handler to call only functions that can be called from a signal @@ -2471,12 +2470,12 @@ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a - notice placed by the copyright holder saying it may be distributed - under the terms of this General Public License. The "Program", below, + notice placed by the copyright holder saying it may be distributed un- + der the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: - that is to say, a work containing the Program or a portion of it, - either verbatim or with modifications and/or translated into another + that is to say, a work containing the Program or a portion of it, ei- + ther verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you".
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/text/slang.txt -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/text/slang.txt
Changed
@@ -1,6 +1,6 @@ A Guide to the S-Lang Language (v2.3.0) John E. Davis <www.jedsoft.org> - Aug 18, 2016 + Apr 18, 2020 ____________________________________________________________ @@ -171,9 +171,8 @@ expression involving where filters the data by accepting only those energy values whose status is set to 0. The fits and histogram modules are not distributed with S-Lang but may be obtained separately-- see - http://www.jedsoft.org/slang/modules/ for links to them. For more - information about modules, see the ``Modules'' chapter in this docu- - ment. + http://www.jedsoft.org/slang/modules/ for links to them. For more in- + formation about modules, see the ``Modules'' chapter in this document. For more information about using slsh, see the chapter on ``slsh''. @@ -604,9 +603,9 @@ A = Int_Type 10; A0:9 = 7; A = Int_Type 10; A* = 7; - The second and third methods use an array of indices to index the - array A. In the second, the range of indices has been explicitly spec- - ified, whereas the third example uses a wildcard form. See chapter + The second and third methods use an array of indices to index the ar- + ray A. In the second, the range of indices has been explicitly speci- + fied, whereas the third example uses a wildcard form. See chapter ``Arrays'' for more information about array indexing. Although the examples have pertained to integer arrays, the fact is @@ -665,11 +664,11 @@ is a list of four objects, each with a different type. Like an array, the elements of a list may be accessed via an index, e.g., - x=my_list2 will result in the assignment of "foo" to x. The most - important difference between an array and a list is that an array's - size is fixed whereas a list may grow or shrink. Algorithms that - require such a data structure may execute many times faster when a - list is used instead of an array. + x=my_list2 will result in the assignment of "foo" to x. The most im- + portant difference between an array and a list is that an array's size + is fixed whereas a list may grow or shrink. Algorithms that require + such a data structure may execute many times faster when a list is + used instead of an array. 3.7. Structures and User-Defined Types @@ -718,17 +717,17 @@ bill.age = 51; One advantage of creating a new type is that array elements of such - types are automatically initialized to instances of the type. For - example, + types are automatically initialized to instances of the type. For ex- + ample, People = Person_Type 100; People0.first_name = "Bill"; People1.first_name = "Hillary"; may be used to create an array of 100 such objects and initialize the - first_name fields of the first two elements. In contrast, the form - using an anonymous would require a separate step to instantiate the - array elements: + first_name fields of the first two elements. In contrast, the form us- + ing an anonymous would require a separate step to instantiate the ar- + ray elements: People = Struct_Type 100; People0 = @person; @@ -1141,10 +1140,11 @@ 4.1.7. Array_Type, Assoc_Type, List_Type, and Struct_Type - Variables of type Array_Type, Assoc_Type, List_Type, and Struct_Type - are known as container objects. They are more complicated than the - simple data types discussed so far and each obeys a special syntax. - For these reasons they are discussed in a separate chapters. + Variables of type ``Array_Type'', ``Assoc_Type'', ``List_Type'', and + ``Struct_Type'' are known as container objects. They are more + complicated than the simple data types discussed so far and each obeys + a special syntax. For these reasons they are discussed in a separate + chapters. 4.1.8. DataType_Type Type @@ -1512,9 +1512,9 @@ return flags; } - The buffer flags object is a bitmapped quantity where the 0th bit - indicates whether or not the buffer has been modified, the first bit - indicates whether or not autosave has been enabled for the buffer, and + The buffer flags object is a bitmapped quantity where the 0th bit in- + dicates whether or not the buffer has been modified, the first bit in- + dicates whether or not autosave has been enabled for the buffer, and so on. Consider for the moment the task of determining if the buffer has been modified. This can be determined by looking at the zeroth bit: if it is 0 the buffer has not been modified, otherwise it has @@ -1594,10 +1594,10 @@ } Here the relational binary operator > forms a comparison between one - of the return values (the one at the top of the stack) and 0. In - accordance with the above rule, since read_line returns multiple val- - ues, it must occur as the left binary operand. Putting it on the - right as in + of the return values (the one at the top of the stack) and 0. In ac- + cordance with the above rule, since read_line returns multiple values, + it must occur as the left binary operand. Putting it on the right as + in while (0 < read_line (fp)) % Incorrect { @@ -1844,8 +1844,8 @@ } } - although the indentation indicates otherwise. It is important to - understand the grammar and not be seduced by the indentation! + although the indentation indicates otherwise. It is important to un- + derstand the grammar and not be seduced by the indentation! 8.3.1.3. ifnot @@ -1885,16 +1885,16 @@ orelse { 0 } { 6 } { 2 } { 3 } - returns 6 since the second block is the first to return a non-zero - result. The last two block will not get executed. + returns 6 since the second block is the first to return a non-zero re- + sult. The last two block will not get executed. The syntax for the andelse statement is: andelse {integer-expression-1} ... {integer-expression-n} Each of the blocks will be executed in turn until one of them returns - a zero value. The result of this statement is the integer value - returned by the last block executed. For example, + a zero value. The result of this statement is the integer value re- + turned by the last block executed. For example, andelse { 6 } { 2 } { 0 } { 4 } @@ -2051,12 +2051,12 @@ or-block then statement-or-block next-statement In addition to statement-or-block, its specification requires three - other expressions. When executed, the for statement evaluates init- - expression, then it tests integer-expression. If integer-expression - evaluates to zero, control passes to next-statement. Otherwise, it - executes statement-or-block as long as integer-expression evaluates to - a non-zero result. After every execution of statement-or-block, end- - expression will get evaluated. + other expressions. When executed, the for statement evaluates init-ex- + pression, then it tests integer-expression. If integer-expression + evaluates to zero, control passes to next-statement. Otherwise, it ex- + ecutes statement-or-block as long as integer-expression evaluates to a + non-zero result. After every execution of statement-or-block, end-ex- + pression will get evaluated. This statement is almost equivalent to @@ -2150,8 +2150,8 @@ Here object can be an expression that evaluates to a value. Each time through the loop the variable var will take on a value that depends - upon the data type of the object being processed. For container - objects, var will take on values of successive members of the object. + upon the data type of the object being processed. For container ob- + jects, var will take on values of successive members of the object. A simple example is @@ -2171,8 +2171,8 @@ block The allowed values of control-list will depend upon the type of con- - tainer object. For associative arrays (Assoc_Type), control-list spec- - ifies whether keys, values, or both are used. For example, + tainer object. For associative arrays (``Assoc_Type''), control-list + specifies whether keys, values, or both are used. For example, foreach k (a) using ("keys") { @@ -2180,8 +2180,8 @@ . } - results in the keys of the associative array a being successively - assigned to k. Similarly, + results in the keys of the associative array a being successively as- + signed to k. Similarly, foreach v (a) using ("values")
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/text/slangfun.txt -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/text/slangfun.txt
Changed
@@ -980,7 +980,7 @@ SEE ALSO - where, wherelast, wherfirstmin, wherfirstmax, wherefirst_eq + where, wherelast, wherefirstmin, wherefirstmax, wherefirst_eq -------------------------------------------------------------- @@ -1579,6 +1579,32 @@ -------------------------------------------------------------- +Array_Type + + SYNOPSIS + An array type + + DESCRIPTION + Arrays up to 7 dimensions are supported. The `{i,j,...,k}` element + of an array `A' may be indexed using `Ai,j,..k'. + + The `length' function may be used to obtain the total number of + elements in the array. The shape, type, and other properties of an + array may obtained using the `array_shape' and + `array_info' functions. + + The `foreach' construct may be used with arrays via the + following construct: + + foreach v (A) {...} + + In all the above forms, the loop is over all elements `v' of the array. + + SEE ALSO + List_Type, Struct_Type, Assoc_Type + +-------------------------------------------------------------- + Assoc_Type SYNOPSIS @@ -3663,6 +3689,41 @@ -------------------------------------------------------------- +_Inf + + SYNOPSIS + IEEE Infinity + + USAGE + Double_Type _Inf + + DESCRIPTION +The value of this variable is an IEEE double precision positive infinity. + + SEE ALSO + isinf, isnan, finite, _NaN + +_NaN + + SYNOPSIS + IEEE Not-a-Number + + USAGE + Double_Type _NaN + + DESCRIPTION +The value of this variable is a non-signalling IEEE double precision +NaN. + + NOTES +An IEEE NaN has some peculiar properties that limits how it should be +used. For example, an IEEE NaN is not equal to itself and expressions +such as `x == _NaN' will always be false. To test if a number is +a NaN, use the `isnan' function. + + SEE ALSO + isinf, isnan, finite, _Inf + abs SYNOPSIS @@ -6071,6 +6132,51 @@ -------------------------------------------------------------- +flock + + SYNOPSIS + control an advisory lock on a file + + USAGE + Int_Type flock (File_Type|FD_Type fd, Int_Type op) + + DESCRIPTION + This function may be used to apply or remove an advisory lock to the + open file represented by the file descriptor `fd'. The + `op' argument controls the use of the lock via one of + the following values: + + LOCK_SH : Add a shared lock. Such locks may be shared by multiple + processes + LOCK_EX : Add an exclusive lock. This type of lock is not shared + with other processes + LOCK_UN : Remove the lock added by the current process + + If another process currently has the file locked in an incompatible + way, the call to `flock' will block until that process has + removed the lock. To preveent such blocking, the `LOCK_NB' + flag may be ``ored'' with the locking operation, e.g., + `LOCK_EX|LOCK_NB'. + + The advisory locks are inherited through any operation that + duplicates or inherits the file descriptor, e.g., the `dup2' or + `fork' functions. + + The functions returns 0 upon sucess and -1 upon error. Check the + value of the `errno' variable for the reason for failure. Note + that if the `LOCK_NB' flag is used and the file is already + locked in an incompatible way, then the function will fail and set + `errno' to `EWOULDBLOCK'. + + NOTES + See the system documentation for additional semantics associated + with this function. + + SEE ALSO + open, fopen, fdopen + +-------------------------------------------------------------- + getegid SYNOPSIS @@ -8075,6 +8181,13 @@ file. If the file is empty, an empty string array will be returned. The function returns NULL upon error. + QUALIFIERS + The `trim' qualifier may be used remove leading or trailing + whitespace from the returned lines. If `trim' is 1, trailing + whitespace will be removed. If its value is 2, then leading + whitespace will be removed. If `trim' is 3, then both leading + and trailing whitespace will be removed. + EXAMPLE The following function returns the number of lines in a file: @@ -10278,6 +10391,26 @@ -------------------------------------------------------------- +__add_destroy + + SYNOPSIS + Add a destroy callback function to a user-defined type + + USAGE + __add_destroy(DataType_Type user_type, Ref_Type callback_func) + + DESCRIPTION + The `__add_destroy' function adds a callback function to a + user-defined type such that it will get called prior to deleting an + instance of the user-defined type. Just prior to deleting the + object, the object will be passed to the callback function. The + callback function should return nothing. + + SEE ALSO + __add_unary, __add_binary + +-------------------------------------------------------------- + __add_string SYNOPSIS @@ -11089,7 +11222,7 @@ A better name should have been chosen for this function. SEE ALSO - integer, string, typedef, sprintf, pack + integer, string, sprintf, pack --------------------------------------------------------------
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/array.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/array.tm
Changed
@@ -739,7 +739,7 @@ return NULL; } #v- -\seealso{where, wherelast, wherfirstmin, wherfirstmax, wherefirst_eq} +\seealso{where, wherelast, wherefirstmin, wherefirstmax, wherefirst_eq} \done \function{wherefirst_eq,
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/datatype.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/datatype.tm
Changed
@@ -1,3 +1,23 @@ +\datatype{Array_Type} +\synopsis{An array type} +\description + Arrays up to 7 dimensions are supported. The `{i,j,...,k}` element + of an array \exmp{A} may be indexed using \exmp{Ai,j,..k}. + + The \ifun{length} function may be used to obtain the total number of + elements in the array. The shape, type, and other properties of an + array may obtained using the \ifun{array_shape} and + \ifun{array_info} functions. + + The \var{foreach} construct may be used with arrays via the + following construct: +#v+ + foreach v (A) {...} +#v- + In all the above forms, the loop is over all elements \exmp{v} of the array. +\seealso{List_Type, Struct_Type, Assoc_Type} +\done + \datatype{Assoc_Type} \synopsis{An associative array or hash type} \description
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/math.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/math.tm
Changed
@@ -1,3 +1,23 @@ +\variable{_Inf} +\synopsis{IEEE Infinity} +\usage{Double_Type _Inf} +\description +The value of this variable is an IEEE double precision positive infinity. +\seealso{isinf, isnan, finite, _NaN} + +\variable{_NaN} +\synopsis{IEEE Not-a-Number} +\usage{Double_Type _NaN} +\description +The value of this variable is a non-signalling IEEE double precision +NaN. +\notes +An IEEE NaN has some peculiar properties that limits how it should be +used. For example, an IEEE NaN is not equal to itself and expressions +such as \exmp{x == _NaN} will always be false. To test if a number is +a NaN, use the \ifun{isnan} function. +\seealso{isinf, isnan, finite, _Inf} + \function{abs} \synopsis{Compute the absolute value of a number} \usage{y = abs(x)}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/posix.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/posix.tm
Changed
@@ -1,3 +1,40 @@ + +\function{flock} +\synopsis{control an advisory lock on a file} +\usage{Int_Type flock (File_Type|FD_Type fd, Int_Type op)} +\description + This function may be used to apply or remove an advisory lock to the + open file represented by the file descriptor \exmp{fd}. The + \exmp{op} argument controls the use of the lock via one of + the following values: +#v+ + LOCK_SH : Add a shared lock. Such locks may be shared by multiple + processes + LOCK_EX : Add an exclusive lock. This type of lock is not shared + with other processes + LOCK_UN : Remove the lock added by the current process +#v- + If another process currently has the file locked in an incompatible + way, the call to \ifun{flock} will block until that process has + removed the lock. To preveent such blocking, the \ivar{LOCK_NB} + flag may be ``ored'' with the locking operation, e.g., + \exmp{LOCK_EX|LOCK_NB}. + + The advisory locks are inherited through any operation that + duplicates or inherits the file descriptor, e.g., the \ifun{dup2} or + \ifun{fork} functions. + + The functions returns 0 upon sucess and -1 upon error. Check the + value of the \ivar{errno} variable for the reason for failure. Note + that if the \ivar{LOCK_NB} flag is used and the file is already + locked in an incompatible way, then the function will fail and set + \ivar{errno} to \exmp{EWOULDBLOCK}. +\notes + See the system documentation for additional semantics associated + with this function. +\seealso{open, fopen, fdopen} +\done + \function{getegid} \synopsis{Get the effective group id of the current process} \usage{Int_Type getegid ()}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/stdio.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/stdio.tm
Changed
@@ -169,6 +169,12 @@ unspecified, the function will return the rest of the lines in the file. If the file is empty, an empty string array will be returned. The function returns \NULL upon error. +\qualifiers + The \exmp{trim} qualifier may be used remove leading or trailing + whitespace from the returned lines. If \exmp{trim} is 1, trailing + whitespace will be removed. If its value is 2, then leading + whitespace will be removed. If \exmp{trim} is 3, then both leading + and trailing whitespace will be removed. \example The following function returns the number of lines in a file: #v+
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/struct.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/struct.tm
Changed
@@ -57,6 +57,19 @@ \seealso{__add_unary, __add_string, __add_destroy} \done + +\function{__add_destroy} +\synopsis{Add a destroy callback function to a user-defined type} +\usage{__add_destroy(DataType_Type user_type, Ref_Type callback_func)} +\description + The \ifun{__add_destroy} function adds a callback function to a + user-defined type such that it will get called prior to deleting an + instance of the user-defined type. Just prior to deleting the + object, the object will be passed to the callback function. The + callback function should return nothing. +\seealso{__add_unary, __add_binary} +\done + \function{__add_string} \synopsis{Specify a string representation for a user-defined type} \usage{__add_string (DataType_Type user_type, Ref_Type func)}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/type.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/type.tm
Changed
@@ -95,7 +95,7 @@ whose value is that of \exmp{-c&0xFF}. \notes A better name should have been chosen for this function. -\seealso{integer, string, typedef, sprintf, pack} +\seealso{integer, string, sprintf, pack} \done \function{define_case}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/slang.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/slang.tm
Changed
@@ -10,6 +10,8 @@ #d sectref#1 the section on \ref{$1} #d chapterref#1 the chapter on \ref{$1} +#d ref_dtype#1 <tt><ref id="label-$1" name="$1"></tt> +#d labeled_dtype#1 <label id="label-$1"> #d documentstyle book #%}}} @@ -1169,8 +1171,8 @@ \sect1{Array_Type, Assoc_Type, List_Type, and Struct_Type} - Variables of type \dtype{Array_Type}, \dtype{Assoc_Type}, - \dtype{List_Type}, and \dtype{Struct_Type} are known as + Variables of type \ref_dtype{Array_Type}, \ref_dtype{Assoc_Type}, + \ref_dtype{List_Type}, and \ref_dtype{Struct_Type} are known as \em{container objects}. They are more complicated than the simple data types discussed so far and each obeys a special syntax. For these reasons they are discussed in a separate chapters. @@ -2308,7 +2310,7 @@ \em{statement-or-block} \end{tscreen} The allowed values of \em{control-list} will depend upon the type - of container object. For associative arrays (\var{Assoc_Type}), + of container object. For associative arrays (\ref_dtype{Assoc_Type}), \em{control-list} specifies whether \em{keys}, \em{values}, or both are used. For example, #v+ @@ -3300,6 +3302,7 @@ #%}}} \labeled_chapter{Arrays} #%{{{ +\labeled_dtype{Array_Type} An array is a container object that can contain many values of one data type. Arrays are very useful objects and are indispensable @@ -3320,7 +3323,7 @@ permits arrays to contain as many as 7 dimensions. When a numeric array is created, all its elements are initialized to zero. The initialization of other array types depend upon the data type, - e.g., the elements in \var{String_Type} and \var{Struct_Type} arrays are + e.g., the elements in \var{String_Type} and \ref_dtype{Struct_Type} arrays are initialized to \NULL. As a concrete example, consider @@ -3934,6 +3937,7 @@ #%}}} \chapter{Associative Arrays} #%{{{ +\labeled_dtype{Assoc_Type} An associative array differs from an ordinary array in the sense that its size is not fixed and that it is indexed by a string, called @@ -4054,6 +4058,8 @@ \chapter{Structures and User-Defined Types} #%{{{ +\labeled_dtype{Struct_Type} + A \em{structure} is a heterogeneous container object, i.e., it is an object with elements whose values do not have to be of the same data type. The elements or fields of a structure are named, and @@ -4537,6 +4543,7 @@ #%}}} \chapter{Lists} #%{{{ +\labeled_dtype{List_Type} Sometimes it is desirable to utilize an object that has many of the properties of an array, but can also easily grow or shrink upon
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/slangfun.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/slangfun.tm
Changed
@@ -5,7 +5,8 @@ #i local.tm -#d function#1 \sect{<bf>$1</bf>\label{$1}}<descrip> +#d function#1 \sect{\linuxdoc_list_to_label{$1}}<descrip> +#% #d function#1 \sect{<bf>$1</bf>\label{$1}}<descrip> #d variable#1 \sect{<bf>$1</bf>\label{$1}}<descrip> #d datatype#1 \sect{<bf>$1</bf>\label{$1}}<descrip>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/Makefile.in -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/Makefile.in
Changed
@@ -11,7 +11,7 @@ test_varray.sl test_socket.sl test_rand.sl test_fork.sl test_csv.sl \ test_base64.sl test_chksum.sl test_hist.sl test_stats.sl test_json.sl # -CHKSUM_OBJS = chksum-module.o chksum_md5.o chksum_sha1.o +CHKSUM_OBJS = chksum-module.o chksum_md5.o chksum_sha1.o chksum_sha2.o chksum_crc.o STATS_OBJS = stats-module.o stats_kendall.o # --------------------------------------------------------------------------- CC = @CC@ @@ -153,6 +153,10 @@ $(COMPILE_CMD) -c $(SRCDIR)/chksum_md5.c chksum_sha1.o: $(SRCDIR)/chksum_sha1.c $(SRCDIR)/chksum.h $(COMPILE_CMD) -c $(SRCDIR)/chksum_sha1.c +chksum_sha2.o: $(SRCDIR)/chksum_sha2.c $(SRCDIR)/chksum.h + $(COMPILE_CMD) -c $(SRCDIR)/chksum_sha2.c +chksum_crc.o: $(SRCDIR)/chksum_crc.c $(SRCDIR)/chksum.h + $(COMPILE_CMD) -c $(SRCDIR)/chksum_crc.c # histogram-module.so: $(SRCDIR)/histogram-module.c $(SRCDIR)/histogram-module.inc $(COMPILE_CMD) $(SRCDIR)/histogram-module.c -o histogram-module.so $(LIBS) @@ -213,7 +217,7 @@ cd test; ./runtests.sh $$test_scripts clean: -/bin/rm -f $(OBJDIR_TSTAMP) - -cd $(OBJDIR) && /bin/rm -f $(MODULES) $(CHKSUM_OBJS) + -cd $(OBJDIR) && /bin/rm -f $(MODULES) $(CHKSUM_OBJS) $(STATS_OBJS) -/bin/rm -f *~ */*~ distclean: clean -/bin/rm -f Makefile $(OBJDIR)/Makefile $(CONFIG_H)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/base64-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/base64-module.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2014-2017,2018 John E. Davis +Copyright (C) 2014-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/chksum-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum-module.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2014-2017,2018 John E. Davis +Copyright (C) 2014-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -48,6 +48,13 @@ { {"md5", _pSLchksum_md5_new}, {"sha1", _pSLchksum_sha1_new}, + {"crc8", _pSLchksum_crc8_new}, /* qualifiers: poly, seed, refin, refout, xorout */ + {"crc16", _pSLchksum_crc16_new}, /* qualifiers: poly, seed, ... */ + {"crc32", _pSLchksum_crc32_new}, /* qualifiers: poly, seed, ...*/ + {"sha224", _pSLchksum_sha256_new}, + {"sha256", _pSLchksum_sha256_new}, + {"sha384", _pSLchksum_sha512_new}, + {"sha512", _pSLchksum_sha512_new}, {NULL, NULL} }; @@ -87,7 +94,7 @@ return; } if (obj->c != NULL) - (void) obj->c->close (obj->c, NULL); + (void) obj->c->close (obj->c, NULL, 1); SLfree ((char *)obj); } @@ -103,7 +110,7 @@ obj = (Chksum_Object_Type *)SLmalloc (sizeof (Chksum_Object_Type)); if (obj == NULL) return; - memset ((char *)obj, 0, sizeof(SLChksum_Type)); + memset ((char *)obj, 0, sizeof(Chksum_Object_Type)); obj->numrefs = 1; if (NULL == (obj->c = t->create (name))) @@ -148,46 +155,95 @@ (void) SLang_push_null (); return; } + obj->c = NULL; + + if (c->close_will_push) + { + (void) c->close (c, NULL, 0); + return; + } digest_len = c->digest_len; if (NULL == (digest = (unsigned char *)SLmalloc(2*digest_len+1))) return; - if (-1 == c->close (c, digest)) + if (-1 == c->close (c, digest, 0)) { SLfree ((char *)digest); return; } - obj->c = NULL; - hexify_string (digest, digest_len); + if (SLang_qualifier_exists("binary")) /* allow to return the digest as BString */ + { + SLang_BString_Type *bstr; + if (NULL == (bstr = SLbstring_create_malloced(digest, digest_len, 0))) + { + SLang_push_null(); + return; + } + (void) SLang_push_bstring(bstr); + SLbstring_free(bstr); + return; + } + hexify_string (digest, digest_len); (void) SLang_push_malloced_string ((char *)digest); } +static SLChksum_Type *get_chksum_type_from_obj (Chksum_Object_Type *obj) +{ + SLChksum_Type *c = obj->c; + + if (c == NULL) + SLang_verror (SL_InvalidParm_Error, "Checksum object is invalid"); + + return c; +} + static void chksum_accumulate (Chksum_Object_Type *obj, SLang_BString_Type *b) { SLChksum_Type *c; SLstrlen_Type len; unsigned char *s; - if (NULL == (c = obj->c)) - { - SLang_verror (SL_InvalidParm_Error, "Checksum object is invalid"); - return; - } + if (NULL == (c = get_chksum_type_from_obj (obj))) + return; + if (NULL == (s = SLbstring_get_pointer (b, &len))) return; (void) c->accumulate (c, s, len); } +static unsigned int chksum_buffer_size (Chksum_Object_Type *obj) +{ + SLChksum_Type *c; + + if (NULL == (c = get_chksum_type_from_obj (obj))) + return 0; + + return c->buffer_size; +} + +static unsigned int chksum_digest_length (Chksum_Object_Type *obj) +{ + SLChksum_Type *c; + + if (NULL == (c = get_chksum_type_from_obj (obj))) + return 0; + + return c->digest_len; +} + + #define DUMMY_CHKSUM_TYPE ((unsigned int)-1) static SLang_Intrin_Fun_Type Intrinsics = { MAKE_INTRINSIC_1 ("_chksum_new", chksum_new, SLANG_VOID_TYPE, SLANG_STRING_TYPE), MAKE_INTRINSIC_2 ("_chksum_accumulate", chksum_accumulate, SLANG_VOID_TYPE, DUMMY_CHKSUM_TYPE, SLANG_BSTRING_TYPE), MAKE_INTRINSIC_1 ("_chksum_close", chksum_close, SLANG_VOID_TYPE, DUMMY_CHKSUM_TYPE), + MAKE_INTRINSIC_1 ("_chksum_digest_length", chksum_digest_length, SLANG_UINT_TYPE, DUMMY_CHKSUM_TYPE), + MAKE_INTRINSIC_1 ("_chksum_buffer_size", chksum_buffer_size, SLANG_UINT_TYPE, DUMMY_CHKSUM_TYPE), SLANG_END_INTRIN_FUN_TABLE };
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/chksum.h -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum.h
Changed
@@ -5,11 +5,13 @@ { int (*accumulate)(struct SLChksum_Type *, unsigned char *, unsigned int); - /* compute the digest and delete the object. If the digest parameter is - * NULL, just delete the object + /* compute the digest and delete the object. If the last argument is + * non-zero, just delete the object. */ - int (*close)(struct SLChksum_Type *, unsigned char *); + int (*close)(struct SLChksum_Type *, unsigned char *, int); unsigned int digest_len; /* set by open */ + unsigned int buffer_size; /* the buffer length */ + int close_will_push; /* if non-zero, the close method will push the result */ #ifdef CHKSUM_TYPE_PRIVATE_FIELDS /* private data */ CHKSUM_TYPE_PRIVATE_FIELDS @@ -19,5 +21,10 @@ extern SLChksum_Type *_pSLchksum_sha1_new (char *name); extern SLChksum_Type *_pSLchksum_md5_new (char *name); +extern SLChksum_Type *_pSLchksum_crc8_new (char *name); +extern SLChksum_Type *_pSLchksum_crc16_new (char *name); +extern SLChksum_Type *_pSLchksum_crc32_new (char *name); +extern SLChksum_Type *_pSLchksum_sha256_new (char *name); +extern SLChksum_Type *_pSLchksum_sha512_new (char *name); #endif
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/chksum.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -6,55 +6,154 @@ %--------------------------------------------------------------------------- import ("chksum"); -private define chksum_accumulate (c, str) +private variable CRC8_Map = Assoc_TypeStruct_Type; +define chksum_add_crc8_subtype (subtype) { - _chksum_accumulate (c.obj, str); + subtype = strtrans(subtype, "-_", ""); + CRC8_Mapstrlow(subtype) = @__qualifiers; } -private define chksum_close (c) +chksum_add_crc8_subtype(""; poly=0xD5, seed=0x00, refin=0, refout=0, xorout=0x00); +chksum_add_crc8_subtype("dvb-s2"; poly=0xD5, seed=0x00, refin=0, refout=0, xorout=0x00); +chksum_add_crc8_subtype("cdma2000"; poly=0x9B, seed=0xFF, refin=0, refout=0, xorout=0x00); +chksum_add_crc8_subtype("darc"; poly=0x39, seed=0x00, refin=1, refout=1, xorout=0x00); +chksum_add_crc8_subtype("ebu"; poly=0x1D, seed=0xFF, refin=1, refout=1, xorout=0x00); +chksum_add_crc8_subtype("i-code"; poly=0x1D, seed=0xFD, refin=0, refout=0, xorout=0x00); +chksum_add_crc8_subtype("itu"; poly=0x07, seed=0x00, refin=0, refout=0, xorout=0x55); +chksum_add_crc8_subtype("maxim"; poly=0x31, seed=0x00, refin=1, refout=1, xorout=0x00); +chksum_add_crc8_subtype("rohc"; poly=0x07, seed=0xFF, refin=1, refout=1, xorout=0x00); +chksum_add_crc8_subtype("wcdma"; poly=0x9B, seed=0x00, refin=1, refout=1, xorout=0x00); + +private variable CRC16_Map = Assoc_TypeStruct_Type; +define chksum_add_crc16_subtype (subtype) { - variable chksum = _chksum_close (c.obj); - c.obj = NULL; - return chksum; + subtype = strtrans(subtype, "-_", ""); + CRC16_Mapstrlow(subtype) = @__qualifiers; } -define chksum_new (name) +chksum_add_crc16_subtype(""; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("ccitt-0"; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("ARC"; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("AUG-CCITT"; poly=0x1021U, seed=0x1D0FU, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("BUYPASS"; poly=0x8005U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("CDMA2000"; poly=0xC867U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("DDS-110"; poly=0x8005U, seed=0x800DU, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("DECT-R"; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0001U); +chksum_add_crc16_subtype("DECT-X"; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("DNP"; poly=0x3D65U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU); +chksum_add_crc16_subtype("EN-13757"; poly=0x3D65U, seed=0x0000U, refin=0, refout=0, xorout=0xFFFFU); +chksum_add_crc16_subtype("GENIBUS"; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0xFFFFU); +chksum_add_crc16_subtype("MAXIM"; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU); +chksum_add_crc16_subtype("MCRF4XX"; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("RIELLO"; poly=0x1021U, seed=0xB2AAU, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("T10-DIF"; poly=0x8BB7U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("TELEDISK"; poly=0xA097U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("TMS37157"; poly=0x1021U, seed=0x89ECU, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("USB"; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU); +chksum_add_crc16_subtype("A"; poly=0x1021U, seed=0xC6C6U, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("KERMIT"; poly=0x1021U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("MODBUS"; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("X-25"; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU); +chksum_add_crc16_subtype("XMODEM"; poly=0x1021U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U); + +private variable CRC32_Map = Assoc_TypeStruct_Type; +define chksum_add_crc32_subtype (subtype) { - return struct + subtype = strtrans(subtype, "-_", ""); + CRC32_Mapstrlow(subtype) = @__qualifiers; +} + +chksum_add_crc32_subtype(""; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU); +chksum_add_crc32_subtype("BZIP2"; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0xFFFFFFFFU); +chksum_add_crc32_subtype("C"; poly=0x1EDC6F41U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU); +chksum_add_crc32_subtype("D"; poly=0xA833982BU, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU); +chksum_add_crc32_subtype("MPEG-2"; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0x00000000U); +chksum_add_crc32_subtype("POSIX"; poly=0x04C11DB7U, seed=0x00000000U, refin=0, refout=0, xorout=0xFFFFFFFFU); +chksum_add_crc32_subtype("Q"; poly=0x814141ABU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U); +chksum_add_crc32_subtype("JAMCRC"; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0x00000000U); +chksum_add_crc32_subtype("XFER"; poly=0x000000AFU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U); + +private define parse_name (name) +{ + name = strlow (name); + variable q = __qualifiers; + variable subtype = qualifier ("type", NULL); + variable words = strchop (name, '/', 0); + + % Convert crc-8 to crc8, i-code to icode, etc + name = strtrans(words0, "-_", ""); + if (strncmp(name, "crc", 3)) + return name, q; + + if (length (words) > 1) + subtype = words1; + else if (subtype == NULL) { - obj = _chksum_new (name), - accumulate = &chksum_accumulate, - close = &chksum_close, - name = name, - }; + if (q != NULL) + return name, q; + subtype = ""; + } + + subtype = strtrans (strlow (subtype), "-_", ""); + variable map = NULL; + + if (name == "crc8") + map = CRC8_Map; + else if (name == "crc16") + map = CRC16_Map; + else if (name == "crc32") + map = CRC32_Map; + + if ((map != NULL) + && assoc_key_exists (map, subtype)) + return name, mapsubtype; + + throw UndefinedNameError, "Unknown $name type: $subtype"$; } -define md5sum_new () +private define chksum_accumulate (c, str) { - return chksum_new ("md5"); + _chksum_accumulate (c.obj, str); } -define sha1sum_new () +private define chksum_close (c) { - return chksum_new ("sha1"); + variable chksum = _chksum_close (c.obj;; __qualifiers); + c.obj = NULL; + return chksum; } -define md5sum (str) +private define chksum_digest_length (c) { - variable c = _chksum_new ("md5"); - _chksum_accumulate (c, str); - return _chksum_close (c); + return _chksum_digest_length(c.obj); } -define sha1sum (str) +private define chksum_buffer_size (c) { - variable c = _chksum_new ("sha1"); - _chksum_accumulate (c, str); - return _chksum_close (c); + return _chksum_buffer_size(c.obj); } +define chksum_new (name) +{ + variable q; + (name, q) = parse_name (name;; __qualifiers); + return struct + { + obj = _chksum_new (name;; q), + accumulate = &chksum_accumulate, + close = &chksum_close, + digest_length = &chksum_digest_length, + buffer_size = &chksum_buffer_size, + name = name, + }; +} + + define chksum_file (fp, type) { + variable q; + (type, q) = parse_name (type;; __qualifiers); + variable file = NULL; if (typeof (fp) != File_Type) { @@ -64,7 +163,7 @@ throw OpenError, "Error opening $file"$; } - variable c = _chksum_new (type); + variable c = _chksum_new (type;; q); variable buf; while (-1 != fread_bytes (&buf, 4096, fp)) @@ -75,13 +174,226 @@ return _chksum_close (c); } +define md5sum_new ()
View file
_service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum_crc.c
Added
@@ -0,0 +1,467 @@ +/* +Copyright (C) 2019-2021,2022 John E. Davis + +This file is part of the S-Lang Library. + +The S-Lang Library is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License as +published by the Free Software Foundation; either version 2 of the +License, or (at your option) any later version. + +The S-Lang Library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this library; if not, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. +*/ +#include "config.h" +#include <string.h> +#include <limits.h> +#include <slang.h> +#include <stdint.h> + +#define CHKSUM_TYPE_PRIVATE_FIELDS \ + void *vlookup_table; \ + int refin, refout; \ + unsigned int seed; \ + unsigned int poly; \ + unsigned int xorout; + +#include "chksum.h" + +#define SLang_push_uint16 SLang_push_ushort +#define SLang_push_uint32 SLang_push_uint + +static unsigned char Byte_Reflect256; +static unsigned int reflect_bits (unsigned int val, unsigned int nbits) +{ + unsigned int i; + unsigned int r = 0, s; + + s = (1 << (nbits-1)); + for (i = 0; i < nbits; i++) + { + if (val & 0x00000001) + r |= s; + val = val >> 1; + s = s >> 1; + } + return r; +} + +static void make_byte_reflect_table (void) +{ + static int inited = 0; + unsigned int i; + + if (inited) return; + + for (i = 0; i < 256; i++) + Byte_Reflecti = (unsigned char) reflect_bits (i, 8); + + inited = 1; +} + +typedef struct CRC8_Table_Type_ +{ + struct CRC8_Table_Type_ *next; + unsigned int poly; + unsigned char lookup_table256; +} +CRC8_Table_Type; +static CRC8_Table_Type *CRC8_Table_List; + +static unsigned char *get_crc8_table (unsigned char poly) +{ + CRC8_Table_Type *list; + unsigned char *lookup_table; + unsigned int i; + + list = CRC8_Table_List; + + while (list != NULL) + { + if (list->poly == poly) + return list->lookup_table; + list = list->next; + } + list = (CRC8_Table_Type *)SLmalloc(sizeof(CRC8_Table_Type)); + if (list == NULL) return NULL; + + list->poly = poly; + list->next = CRC8_Table_List; + CRC8_Table_List = list; + + lookup_table = list->lookup_table; + for (i = 0; i < 256; i++) + { + unsigned int j; + unsigned char crc; + + crc = i; + for (j = 0; j < 8; j++) + { + if (crc & 0x80) + crc = (crc << 1)^poly; + else + crc = crc << 1; + } + lookup_tablei = crc; + } + return lookup_table; +} + +static int crc8_accumulate (SLChksum_Type *cs, unsigned char *buf, unsigned int buflen) +{ + unsigned char *lookup_table; + unsigned int i; + unsigned char crc; + + lookup_table = (unsigned char *)cs->vlookup_table; + crc = cs->seed; + + if (cs->refin) + { + for (i = 0; i < buflen; i++) + crc = lookup_tablecrc ^ Byte_Reflectbufi; + } + else + { + for (i = 0; i < buflen; i++) + crc = lookup_tablecrc ^ bufi; + } + cs->seed = crc; + return 0; +} + +static int crc8_close (SLChksum_Type *cs, unsigned char *digest, int just_free) +{ + unsigned char crc; + + if (cs == NULL) + return -1; + + (void) digest; + + if (just_free) + { + SLfree ((char *) cs); + return 0; + } + + crc = (unsigned char) cs->seed & 0xFF; + if (cs->refout) + crc = Byte_Reflectcrc; + crc = (crc ^ cs->xorout) & 0xFF; + + SLfree ((char *)cs); + return SLang_push_uchar (crc); +} + +typedef struct CRC16_Table_Type_ +{ + struct CRC16_Table_Type_ *next; + unsigned int poly; + uint16_t lookup_table256; +} +CRC16_Table_Type; +static CRC16_Table_Type *CRC16_Table_List; + +static uint16_t *get_crc16_table (uint16_t poly) +{ + CRC16_Table_Type *list; + uint16_t *lookup_table; + unsigned int i; + + list = CRC16_Table_List; + while (list != NULL) + { + if (list->poly == poly) + return list->lookup_table; + list = list->next; + } + list = (CRC16_Table_Type *)SLmalloc(sizeof(CRC16_Table_Type)); + if (list == NULL) return NULL; + + list->poly = poly; + list->next = CRC16_Table_List; + CRC16_Table_List = list; + + lookup_table = list->lookup_table; + for (i = 0; i < 256; i++) + { + unsigned int j; + uint16_t crc; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/chksum_md5.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum_md5.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2014-2017,2018 John E. Davis +Copyright (C) 2014-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -349,14 +349,14 @@ return 0; } -static int md5_close (SLChksum_Type *md5, unsigned char *digest) +static int md5_close (SLChksum_Type *md5, unsigned char *digest, int just_free) { unsigned char num_bits_buf8; if (md5 == NULL) return -1; - if (digest != NULL) + if ((digest != NULL) && (just_free == 0)) { /* Handle num bits before padding */ uint32_to_uchar (md5->num_bits, 2, num_bits_buf);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/chksum_sha1.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum_sha1.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2014-2017,2018 John E. Davis +Copyright (C) 2014-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -273,14 +273,14 @@ } } -static int sha1_close (SLChksum_Type *sha1, unsigned char *digest) +static int sha1_close (SLChksum_Type *sha1, unsigned char *digest, int just_free) { unsigned char num_bits_buf8; if (sha1 == NULL) return -1; - if (digest != NULL) + if ((digest != NULL) && (just_free == 0)) { /* Handle num bits before padding */ uint32_to_uchar (sha1->num_bits, 2, num_bits_buf); @@ -308,6 +308,7 @@ sha1->accumulate = sha1_accumulate; sha1->close = sha1_close; sha1->digest_len = SHA1_DIGEST_LEN; + sha1->buffer_size = SHA1_BUFSIZE; sha1->h0 = 0x67452301; sha1->h1 = 0xEFCDAB89;
View file
_service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum_sha2.c
Added
@@ -0,0 +1,1031 @@ +/* -*- mode: c; mode: fold; -*- */ + +/* Implementation of the sha2 family: sha256, sha224, sha512, and sha384. + * The implementation loosely follows https://datatracker.ietf.org/doc/html/rfc4634#section-5.2 + * but mapped into the structure as layed out by chksum_sha1.c + */ + +#include "config.h" +#include <string.h> +#include <limits.h> +#include <slang.h> + +#include "_slint.h" + +#define SHA224_BUFSIZE 64 +#define SHA224_DIGEST_LEN 28 +#define SHA256_BUFSIZE 64 +#define SHA256_DIGEST_LEN 32 +#define SHA224_BITSIZE 224 +#define SHA256_BITSIZE 256 +#define SHA384_BUFSIZE 128 +#define SHA384_DIGEST_LEN 48 +#define SHA512_BUFSIZE 128 +#define SHA512_DIGEST_LEN 64 +#define SHA384_BITSIZE 384 +#define SHA512_BITSIZE 512 + +#define CHKSUM_TYPE_PRIVATE_FIELDS \ + unsigned int bitsize; \ + _pSLuint32_Type *h; \ + _pSLuint32_Type num_bits4; /* 64 bit/128 bit representation */ \ + unsigned int num_buffered; \ + unsigned char *buf; + +#include "chksum.h" + +#define SHL(n, x) ((x)<<(n)) +#define SHR(n, x) ((x)>>(n)) +#define ROTR(n, x) (((x)>>(n)) | ((x)<<(32-(n)))) +#define ROTL(n, x) (((x)<<(n)) | ((x)>>(32-(n)))) + +#define CH(x, y, z) (((x) & (y)) ^ ((~(x)) & (z))) +#define MAJ(x, y, z) (((x) & (y)) ^ ((x) & (z)) ^ ((y) & (z))) +#define BSIG0(x) (ROTR( 2, (x)) ^ ROTR(13, (x)) ^ ROTR(22, (x))) +#define BSIG1(x) (ROTR( 6, (x)) ^ ROTR(11, (x)) ^ ROTR(25, (x))) +#define SSIG0(x) (ROTR( 7, (x)) ^ ROTR(18, (x)) ^ SHR( 3, (x))) +#define SSIG1(x) (ROTR(17, (x)) ^ ROTR(19, (x)) ^ SHR(10, (x))) + +#define MAKE_WORD(b) \ + ((((_pSLuint32_Type)((b)0))<<24) | (((_pSLuint32_Type)((b)1))<<16) \ + | (((_pSLuint32_Type)((b)2))<<8) | ((_pSLuint32_Type)((b)3))) + +/* We need some macros to handle 64 bit values to not have to rely on this datatype */ +#if _pSLANG_UINT64_TYPE + +# define ROTR_64(n, x) (((x) >> (n)) | ((x)<<(64-(n)))) +# define ROTL_64(n, x) (((x) << (n)) | ((x)>>(64-(n)))) + +# define BSIG0_64(x) (ROTR_64(28, (x)) ^ ROTR_64(34, (x)) ^ ROTR_64(39, (x))) +# define BSIG1_64(x) (ROTR_64(14, (x)) ^ ROTR_64(18, (x)) ^ ROTR_64(41, (x))) +# define SSIG0_64(x) (ROTR_64( 1, (x)) ^ ROTR_64( 8, (x)) ^ SHR( 7, (x))) +# define SSIG1_64(x) (ROTR_64(19, (x)) ^ ROTR_64(61, (x)) ^ SHR( 6, (x))) + +# define MAKE_LONG_WORD(b) \ + ( \ + (((_pSLuint64_Type)((b)0))<<56) | \ + (((_pSLuint64_Type)((b)1))<<48) | \ + (((_pSLuint64_Type)((b)2))<<40) | \ + (((_pSLuint64_Type)((b)3))<<32) | \ + (((_pSLuint64_Type)((b)4))<<24) | \ + (((_pSLuint64_Type)((b)5))<<16) | \ + (((_pSLuint64_Type)((b)6))<<8) | \ + (((_pSLuint64_Type)((b)7))) \ + ) + +#else /* ! _pSLANG_UINT64_TYPE */ + +/* 64 bit bitshift right */ +# define SHR_64(n, x, r) \ + ( \ + (r)1 = (((n) > 32) \ + ? ((x)0 >> ((n) - 32)) \ + : (((n) == 32) \ + ? (x)0 \ + : (((n) >= 0) \ + ? (((x)0 << (32 - (n))) | ((x)1 >> (n))) \ + : 0) \ + ) \ + ), \ + (r)0 = (((n) < 32) && ((n) >= 0)) ? ((x)0 >> (n)) : 0 \ + ) + +/* 64 bit bitshift left */ +# define SHL_64(n, x, r) \ + ( \ + (r)0 = (((n) > 32) \ + ? ((x)1 << ((n) - 32)) \ + : (((n) == 32) \ + ? (x)1 \ + : (((n) >= 0) \ + ? (((x)0 << (n)) | ((x)1 >> (32 - (n)))) \ + : 0) \ + ) \ + ), \ + (r)1 = (((n) < 32) && ((n) >= 0)) ? ((x)1 << (n)) : 0 \ + ) + +// 64 bit bitwise or +# define OR_64(a, b, r) \ + ( \ + (r)0 = (a)0 | (b)0, \ + (r)1 = (a)1 | (b)1 \ + ) + +// 64 bit bitwise xor +# define XOR_64(a, b, r) \ + ( \ + (r)0 = (a)0 ^ (b)0, \ + (r)1 = (a)1 ^ (b)1 \ + ) + +// 64 bit bitwise and +# define AND_64(a, b, r) \ + ( \ + (r)0 = (a)0 & (b)0, \ + (r)1 = (a)1 & (b)1 \ + ) + +// 64 bit bitwise not +# define NOT_64(x, r) \ + ( \ + (r)0 = ~(x)0, \ + (r)1 = ~(x)1 \ + ) + +// 64 bit add +# define ADD_64(a, b, r) \ + ( \ + (r)1 = (a)1 + (b)1, \ + (r)0 = (a)0 + (b)0 + ((r)1 < (a)1) \ + ) + +// 64 bit rotate right +# define ROTR_64(n, x, tmp, r) \ + ( \ + SHR_64((n), (x), (tmp)), \ + SHL_64(64-(n), (x), (r)), \ + OR_64((tmp), (r), (r))\ + ) + +// 64 bit BSIG0 +# define BSIG0_64(x, t1, t2, t3, r) \ + ( \ + ROTR_64(28, (x), (t3), (t1)), \ + ROTR_64(34, (x), (t3), (t2)), \ + ROTR_64(39, (x), (t3), (r)), \ + XOR_64((t1), (t2), (t2)), \ + XOR_64((t2), (r), (r)) \ + ) + +// 64 bit BSIG1 +# define BSIG1_64(x, t1, t2, t3, r) \ + ( \ + ROTR_64(14, (x), (t3), (t1)), \ + ROTR_64(18, (x), (t3), (t2)), \ + ROTR_64(41, (x), (t3), (r)), \ + XOR_64((t1), (t2), (t2)), \ + XOR_64((t2), (r), (r)) \ + ) + +// 64 bit SSIG0 +# define SSIG0_64(x, t1, t2, t3, r) \ + ( \ + ROTR_64(1, (x), (t3), (t1)), \ + ROTR_64(8, (x), (t3), (t2)), \ + SHR_64( 7, (x), (r)), \ + XOR_64((t1), (t2), (t2)), \ + XOR_64((t2), (r), (r)) \ + ) + +// 64 bit SSIG1 +# define SSIG1_64(x, t1, t2, t3, r) \ + ( \ + ROTR_64(19, (x), (t3), (t1)), \ + ROTR_64(61, (x), (t3), (t2)), \ + SHR_64( 6, (x), (r)), \ + XOR_64((t1), (t2), (t2)), \ + XOR_64((t2), (r), (r)) \ + ) + +// 64 bit CH +# define CH_64(x, y, z, r) \ + ( \ + (r)0 = (((x)0 & ((y)0 ^ (z)0)) ^ (z)0), \ + (r)1 = (((x)1 & ((y)1 ^ (z)1)) ^ (z)1) \ + ) + +// 64 bit MAJ +# define MAJ_64(x, y, z, r) \
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/csv-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/csv-module.c
Changed
@@ -28,13 +28,14 @@ return 0; } -static int execute_read_callback (CSV_Type *csv, char **sptr) +static int execute_read_callback (CSV_Type *csv, int in_quote, char **sptr) { char *s; *sptr = NULL; if ((-1 == SLang_start_arg_list ()) + || (-1 == SLang_push_int (in_quote)) || (-1 == SLang_push_anytype (csv->callback_data)) || (-1 == SLang_end_arg_list ()) || (-1 == SLexecute_function (csv->read_callback))) @@ -139,15 +140,16 @@ || (0 == (ch = lineline_ofs++)) \ || (ch == '\r')) \ { \ - if ((do_read == 0) && (ch == '\r') && (lineline_ofs == '\n')) \ + if ((do_read == 0) && (ch == '\r')) \ { \ + if (lineline_ofs != '\n') break; \ line_ofs++; \ ch = '\n'; \ break; \ } \ SLang_free_slstring (line); \ line = NULL; \ - status = execute_read_callback (csv, &line); \ + status = execute_read_callback (csv, in_quote, &line); \ do_read = 0; \ if (status == -1) \ goto return_error; \
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/csv.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/csv.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -6,7 +6,7 @@ %--------------------------------------------------------------------------- import ("csv"); -private define read_fp_callback (info) +private define read_fp_callback (in_quote, info) { variable line, comment_char = info.comment_char; forever @@ -14,15 +14,17 @@ if (-1 == fgets (&line, info.fp)) return NULL; + info.line_num++; if ((line0 == comment_char) - && (0 == strnbytecmp (line, info.comment, info.comment_len))) + && (in_quote == 0) + && (0 == strnbytecmp (line, info.comment, info.comment_len))) continue; return line; } } -private define read_strings_callback (str_info) +private define read_strings_callback (in_quote, str_info) { variable line; @@ -39,27 +41,48 @@ if (line-1 != '\n') str_info.output_crlf = 1; + str_info.line_num++; return line; } -private define resize_arrays (list, n) +private define resize_arrays (arrays, n) { - _for (0, length(list)-1, 1) + _for (0, length(arrays)-1, 1) { variable i = (); - variable a = listi; + variable a = arraysi; variable m = length(a); + if (m == n) continue; if (m > n) { - listi = a:n-1; + arraysi = a:n-1; continue; } variable b = _typeof(a)n; b:m-1 = a; - listi = b; + arraysi = b; } } +private define merge_column_arrays (list_of_column_arrays) +{ + variable j, n = length (list_of_column_arrays); + variable column_arrays = list_of_column_arrays0; + variable i, ncols = length (column_arrays); + variable merged = {}; + _for i (0, ncols-1, 1) + { + variable array_list = {}; + _for j (0, n-1, 1) + { + column_arrays = list_of_column_arraysj; + list_append (array_list, column_arraysi); + } + list_append (merged, __push_list(__tmp(array_list))); + } + return merged; +} + private define atofloat (x) { typecast (atof(x), Float_Type); @@ -99,18 +122,7 @@ variable i = where (names == ""); namesi = array_map (String_Type, &sprintf, "col%d", i+1); -#iffalse - % This code is nolonger necessary since slang now allows arbitrary - % structure names. - names = strtrans (names, "^\\w", "_"); - names = strcompress (names, "_"); - - _for i (0, length(names)-1, 1) - { - if ('0' <= namesi0 <= '9') - namesi = "_" + namesi; - } -#endif + names = strtrim (names); % strip leading/trailing WS if (is_scalar) names = names0; return names; } @@ -147,6 +159,7 @@ typeNTH=val (specifiy type for NTH column)\n\ snan=\"\", inan=0, lnan=0L, fnan=_NaN, dnan=_NaN (defaults for empty fields),\n\ nanNTH=val (value used for an empty field in the NTH column\n\ + init_size=int (number of rows to initially read)\n\ " ); } @@ -166,6 +179,8 @@ variable fnan = qualifier ("fnan", typecast(_NaN,Float_Type)); variable inan = qualifier ("inan", 0); variable lnan = qualifier ("lnan", 0L); + variable init_size = qualifier ("init_size", 0x8000); + if (init_size <= 0) init_size = 0x8000; if ((fields != NULL) && (columns != NULL) && (length(fields) != length(columns))) @@ -190,22 +205,49 @@ col = columnsi; j = wherefirst (col == header); if (j == NULL) - throw InvalidParmError, "Unknown (canonical) column name $col"; + throw InvalidParmError, "Unknown (canonical) column name $col"$; column_intsi = j+1; } } - variable row_data = _csv_decode_row (csv.decoder, flags); - if (column_ints == NULL) - column_ints = 1:length(row_data); + variable datastruct = NULL, ncols, row_data, e; + try (e) + { + row_data = _csv_decode_row (csv.decoder, flags); + } + catch AnyError: + { + throw e.error, sprintf ("Error encountered decoding line %S: %S", csv.func_data.line_num, e.message); + } - if (any(column_ints>length(row_data))) + variable nread = 0; + if (row_data != NULL) { - throw InvalidParmError, "column number is too large for data"; + nread++; + + if (column_ints == NULL) + column_ints = 1:length(row_data); + + if (any(column_ints>length(row_data))) + { + throw InvalidParmError, "column number is too large for data"; + } + } + + if (column_ints == NULL) + { + if (fields != NULL) + ncols = length(fields); + else if (columns_are_string) + ncols = length(columns); + else if (header != NULL) + ncols = length (header); + else + throw RunTimeError, "Insufficient information to determine the number of columns in the CSV file"; + + column_ints = 1:ncols; } - variable ncols = length(column_ints); - variable datastruct = NULL; if (fields == NULL) { if (columns_are_string) @@ -215,6 +257,7 @@ else fields = array_map(String_Type, &sprintf, "col%d", column_ints); } + ncols = length(fields); datastruct = @Struct_Type(fields); column_ints -= 1; % make 0-based @@ -243,7 +286,9 @@ _for i (1, ncols, 1) { i1 = i-1; - typesi1 = qualifier ("type$i"$, typesi1); + val = qualifier ("type$i"$, typesi1); + + typesi1 = val;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/fcntl-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/fcntl-module.c
Changed
@@ -1,4 +1,4 @@ -/* Copyright (c) 2001-2017,2018 John E. Davis +/* Copyright (c) 2001-2021,2022 John E. Davis * This file is part of the S-Lang library. * * You may distribute under the terms of either the GNU General Public
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/fork-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/fork-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold; -*- */ /* -Copyright (C) 2009-2017,2018 John E. Davis +Copyright (C) 2009-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/help/base64funs.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/help/base64funs.hlp
Changed
@@ -163,7 +163,7 @@ variable b64 = _base64_encoder_new (&encode_callback, &s); _base64_encoder_accumulate (b64, bstr); _base64_encoder_close (b64); - return b; + return s; }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/help/chksumfuns.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/help/chksumfuns.hlp
Changed
@@ -73,3 +73,241 @@ sha1sum, md5sum_file, md5sum -------------------------------------------------------------- + +crc8sum + + SYNOPSIS + Compute an 8 bit CRC on a string + + USAGE + UChar_Type crc8sum (BString_Type bstr) + + DESCRIPTION + This function computes an 8 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: + + cdma2000 ; poly=0x9B, seed=0xFF, refin=0, refout=0, xorout=0x00 + darc ; poly=0x39, seed=0x00, refin=1, refout=1, xorout=0x00 + dvb-s2 ; poly=0xD5, seed=0x00, refin=0, refout=0, xorout=0x00 + ebu ; poly=0x1D, seed=0xFF, refin=1, refout=1, xorout=0x00 + i-code ; poly=0x1D, seed=0xFD, refin=0, refout=0, xorout=0x00 + itu ; poly=0x07, seed=0x00, refin=0, refout=0, xorout=0x55 + maxim ; poly=0x31, seed=0x00, refin=1, refout=1, xorout=0x00 + rohc ; poly=0x07, seed=0xFF, refin=1, refout=1, xorout=0x00 + wcdma ; poly=0x9B, seed=0x00, refin=1, refout=1, xorout=0x00 + + The CRC-8 algorithm is specified via qualifiers. The following + specify the same CRC-8 algorthm: + + crc8 = crc8sum ("string" ; type="maxim"); + crc8 = crc8sum ("string" ; poly=0x31, refin=1, refout=1); + + The default CRC-8 algorithm is "dvb-s2". + + EXAMPLE + This example shows how to compute the Maxim CRC-8 value on a file. + + fp = fopen (file, "rb"); + c = chksum_new("crc8"; type="maxim"); + while (-1 != fread_bytes (&buf, 4096, fp) + c.accumulate (buf); + crc8 = chksum_close (); + + + NOTES + This function is part of the `chksum' module: + + require("chksum"); + + + SEE ALSO + crc16sum, crc32sum, crc8sum_file + +-------------------------------------------------------------- + +crc8sum_file + + SYNOPSIS + Compute the CRC-8 value for the contents of a file + + USAGE + UChar_Type crc8sum_file (String_Type|File_Type f) + + DESCRIPTION + The `crc8sum_file' function computes the CRC-8 sum on the + contents of a file. The file may either be specified as a string + giving the name of the file, or as an open stdio File_Type + pointer. The function returns the 8-bit CRC value. + + Qualifiers are used to specifiy the CRC-8 variant. See the + documentation for `crc8sum' function for more information. + + SEE ALSO + crc8sum, crc32sum_file, sha1sum_file + +-------------------------------------------------------------- + +crc16sum + + SYNOPSIS + Compute an 16 bit CRC on a string + + USAGE + UInt16_Type crc16sum (BString_Type bstr) + + DESCRIPTION + This function computes an 16 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: + + ccitt-0 ; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U + arc ; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U + aug-ccitt ; poly=0x1021U, seed=0x1D0FU, refin=0, refout=0, xorout=0x0000U + buypass ; poly=0x8005U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + cdma2000 ; poly=0xC867U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U + dds-110 ; poly=0x8005U, seed=0x800DU, refin=0, refout=0, xorout=0x0000U + dect-r ; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0001U + dect-x ; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + dnp ; poly=0x3D65U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU + en-13757 ; poly=0x3D65U, seed=0x0000U, refin=0, refout=0, xorout=0xFFFFU + genibus ; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0xFFFFU + maxim ; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU + mcrf4xx ; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U + riello ; poly=0x1021U, seed=0xB2AAU, refin=1, refout=1, xorout=0x0000U + t10-dif ; poly=0x8BB7U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + teledisk ; poly=0xA097U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + tms37157 ; poly=0x1021U, seed=0x89ECU, refin=1, refout=1, xorout=0x0000U + usb ; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU + a ; poly=0x1021U, seed=0xC6C6U, refin=1, refout=1, xorout=0x0000U + kermit ; poly=0x1021U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U + modbus ; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U + x-25 ; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU + xmodem ; poly=0x1021U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + + The CRC-16 algorithm is specified via qualifiers. The following + specify the same CRC-16 algorthm: + + crc16 = crc16sum ("string" ; type="arc"); + crc16 = crc16sum ("string" ; poly=0x8005U, refin=1, refout=1); + + The default CRC-16 algorithm is "ccitt-0". + + EXAMPLE + This example shows how to compute the Maxim CRC-16 value on a file. + + fp = fopen (file, "rb"); + c = chksum_new("crc16"; type="maxim"); + while (-1 != fread_bytes (&buf, 4096, fp) + c.accumulate (buf); + crc16 = chksum_close (); + + + NOTES + This function is part of the `chksum' module: + + require("chksum"); + + + SEE ALSO + crc8sum, crc32sum, crc16sum_file + +-------------------------------------------------------------- + +crc16sum_file + + SYNOPSIS + Compute the CRC-16 value for the contents of a file + + USAGE + UInt16_Type crc16sum_file (String_Type|File_Type f) + + DESCRIPTION + The `crc16sum_file' function computes the CRC-16 sum on the + contents of a file. The file may either be specified as a string + giving the name of the file, or as an open stdio File_Type + pointer. The function returns the 16-bit CRC value. + + Qualifiers are used to specifiy the CRC-16 variant. See the + documentation for `crc16sum' function for more information. + + SEE ALSO + crc16sum, crc32sum_file, sha1sum_file + +-------------------------------------------------------------- + +crc32sum + + SYNOPSIS + Compute an 32 bit CRC on a string + + USAGE + UInt32_Type crc32sum (BString_Type bstr) + + DESCRIPTION + This function computes an 32 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: + +(default); poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + bzip2 ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0xFFFFFFFFU + c ; poly=0x1EDC6F41U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + d ; poly=0xA833982BU, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + mpeg-2 ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0x00000000U + posix ; poly=0x04C11DB7U, seed=0x00000000U, refin=0, refout=0, xorout=0xFFFFFFFFU + q ; poly=0x814141ABU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U + jamcrc ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0x00000000U + xfer ; poly=0x000000AFU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U + + The CRC-32 algorithm is specified via qualifiers. The following + specify the same CRC-32 algorthm: + + crc32 = crc32sum ("string" ; type="posix"); + crc32 = crc32sum ("string" ; poly=0x04C11DB7U, xorout=0xFFFFFFFFU); + +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/help/csvfuns.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/help/csvfuns.hlp
Changed
@@ -34,11 +34,13 @@ It is important to understand the difference between a ROW and a LINE in a CSV formatted file: a row may span more than one line in a file. The `skiplines' qualifier specifies the number of LINES to be - skipped, not ROWS. + skipped, not ROWS. However, if a comment string appears at the + beginning of one of the lines forming a multiline string, it will + treated as part of the string and not as a comment. CSV files have no notion of data-types: all field values are strings. For this reason, the `type' qualifier introduces an extra layer - that is not part CSV format. + that is not part of the CSV specification. SEE ALSO csv.readcol, csv.readrow
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/help/randfuns.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/help/randfuns.hlp
Changed
@@ -335,7 +335,7 @@ rand SYNOPSIS - Generate random integers numbers + Generate random unsigned integers USAGE X = rand (Rand_Type g, ,num)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/help/statsfuns.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/help/statsfuns.hlp
Changed
@@ -54,8 +54,8 @@ to the value of the statistic upon return. QUALIFIERS - ; mu=value: Specifies the known mean of the normal distribution. - ; sigma: Specifies the known standard deviation of the normal distribution + ; mean=value: Specifies the known mean of the normal distribution. + ; stddev=value: Specifies the known standard deviation of the normal distribution ; cdf: If present, the data will be interpreted as a CDFs of a known, but unspecified, distribution. NOTES @@ -71,7 +71,30 @@ 2004. SEE ALSO - ad_ktest, ks_test, t_test, z_test, normal_cdf, + ad_ktest, ks_test, t_test, z_test, normal_cdf + +-------------------------------------------------------------- + +cumulant + + SYNOPSIS + Compute the first n cumulants of an array + + USAGE + k1,...,kn = cumulant (X, n) + + DESCRIPTION + This function returns unbiased estimates of the first `n' + cumulants from an array `X' of samples of a probability + distribution. The cumulants are returned as an array of size + `n'. + + NOTES + The implementation currently restricts the value of n to 1, 2, 3, or 4. + The estimator of the nth cumulent is also known as the nth k-statistic. + + SEE ALSO + mean, stddev, kurtosis, skewness -------------------------------------------------------------- @@ -195,7 +218,7 @@ s = skewness (a) DESCRIPTION - This function computes the so-called skewness of the array `a'. + This function computes the skewness (g1) of the array `a'. SEE ALSO mean, stddev, kurtosis @@ -211,7 +234,7 @@ s = kurtosis (a) DESCRIPTION - This function computes the so-called kurtosis of the array `a'. + This function computes the kurtosis (g2) of the array `a'. NOTES This function is defined such that the kurtosis of the normal @@ -271,12 +294,12 @@ Compute the Poisson CDF USAGE - cdf = poisson_cdf (Double_Type m, Int_Type k) + cdf = poisson_cdf (Double_Type lambda, Int_Type k) DESCRIPTION This function computes the CDF for the Poisson probability - distribution parameterized by the value `m'. For values of - `m>100' and `abs(m-k)<sqrt(m)', the Wilson and Hilferty + distribution parameterized by the value `lambda'. For values of + `lambda>100' and `abs(lambda-k)<sqrt(lambda)', the Wilson and Hilferty asymptotic approximation is used. SEE ALSO
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/histogram-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/histogram-module.c
Changed
@@ -2,7 +2,7 @@ /* Copyright (c) 2003-2007 Massachusetts Institute of Technology - Copyright (c) 2013-2017,2018 John E. Davis <jed@jedsoft.org> + Copyright (c) 2013-2021,2022 John E. Davis <jed@jedsoft.org> This software was developed by the MIT Center for Space Research under contract SV1-61010 from the Smithsonian Institution.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/histogram.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/histogram.sl
Changed
@@ -142,7 +142,7 @@ #ifexists add_doc_file $1 = path_concat (path_concat (path_dirname (__FILE__), "help"), - "histogram.hlp"); + "histfuns.hlp"); if (NULL != stat_file ($1)) add_doc_file ($1); #endif
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/json-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/json-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold -*- */ /* -Copyright (C) 2013-2017,2018 John E. Davis, Manfred Hanke +Copyright (C) 2013-2021,2022 John E. Davis, Manfred Hanke This file is part of the S-Lang Library. @@ -558,7 +558,7 @@ SLfree ((char *)sp); } -/* This has table implementation does not copy the strings */ +/* This hash table implementation does not copy the strings */ #define HASH_TABLE_SIZE 601 typedef struct String_Hash_Elem_Type {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/mkfiles/makefile.all -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/mkfiles/makefile.all
Changed
@@ -145,7 +145,7 @@ # List of modules to compile. Some/Most require additional libraries to be # installed. MODULES = chksum stats slsmg rand csv base64 histogram json -CHKSUM_XOBJS = chksum_md5.$(O) chksum_sha1.$(O) +CHKSUM_XOBJS = chksum_md5.$(O) chksum_sha1.$(O) chksum_sha2.$(O) chksum_crc.$(O) STATS_XOBJS = stats_kendall.$(O) # slsmg, rand, csv base64 histogram stats: no external dependencies # iconv: iconv library @@ -186,6 +186,8 @@ chksum: $(MAKE) TARGET=chksum_md5 TARGETINCS=$(CHKSUMINCS) compile-target $(MAKE) TARGET=chksum_sha1 TARGETINCS=$(CHKSUMINCS) compile-target + $(MAKE) TARGET=chksum_sha2 TARGETINCS=$(CHKSUMINCS) compile-target + $(MAKE) TARGET=chksum_crc TARGETINCS=$(CHKSUMINCS) compile-target $(MAKE) TARGET=chksum-module TARGETLIBS=$(CHKSUMLIBS) TARGETINCS=$(CHKSUMINCS) "TARGET_XOBJS=$(CHKSUM_XOBJS)" build-target stats: $(MAKE) TARGET=stats_kendall TARGETINCS=$(STATSINCS) compile-target
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/onig-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/onig-module.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2007-2017,2018 John E. Davis +Copyright (C) 2007-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -424,12 +424,15 @@ case 4: if (NULL == (syntax = pop_onig_syntax ())) return; + /* fall through */ case 3: if (NULL == (enc = pop_onig_encoding ())) return; + /* fall through */ case 2: if (-1 == pop_onig_option (&option)) return; + /* fall through */ case 1: if (-1 == SLang_pop_slstring ((char **)&pattern)) return; @@ -516,7 +519,7 @@ case 5: if (-1 == pop_onig_option (&option)) return -1; - /* drop */ + /* fall through */ case 4: if (-1 == SLang_pop_int (&end_pos)) return -1;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/pcre-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/pcre-module.c
Changed
@@ -1,5 +1,5 @@ /* -*- mode: C; mode: fold -*- -Copyright (C) 2010-2017,2018 John E. Davis +Copyright (C) 2010-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -137,7 +137,7 @@ case 2: if (-1 == SLang_pop_integer (&options)) return; - /* drop */ + /* fall through */ case 1: default: if (-1 == SLang_pop_slstring (&pattern)) @@ -187,12 +187,12 @@ case 4: if (-1 == SLang_pop_integer (&options)) return -1; - /* drop */ + /* fall through */ case 3: - /* drop */ + /* fall through */ if (-1 == SLang_pop_integer (&pos)) return -1; - /* drop */ + /* fall through */ default: switch (SLang_peek_at_stack()) {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/pcre.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/pcre.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -25,7 +25,7 @@ if (typeof (re) != PCRE_Type) { variable compile_options = qualifier ("options", 0); - re = pcre_compile (re, options); + re = pcre_compile (re, compile_options); } variable n = pcre_exec (re, str, pos, options);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/png-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/png-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold; -*- */ /* -Copyright (C) 2005-2017,2018 John E. Davis +Copyright (C) 2005-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/png.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/png.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -82,8 +82,15 @@ define png_rgb_to_gray (rgb) { - variable gray = ((rgb&0xFF) + ((rgb&0xFF00)shr 8) + ((rgb&0xFF0000)shr 16)); - return typecast ((__tmp(gray)/3.0), UChar_Type); + variable w = 1.0; + w = qualifier ("wghts", w); + if (length (w) != 3) + w = w0, w0, w0; + w /= sum(w); + if (any(isnan(w) or isinf(w))) w* = 1.0/3; + + variable gray = (w2*(rgb&0xFF) + w1*((rgb&0xFF00)shr 8) + w0*((rgb&0xFF0000)shr 16)); + return typecast (__tmp(gray), UChar_Type); } private define normalize_gray (gray, nlevels) @@ -112,8 +119,8 @@ if (g0 != g1) { - variable factor = nlevels/double(g1-g0); - gray = typecast ((gray-g0)*factor, Int_Type); + variable factor = (nlevels-1)/double(g1-g0); + gray = nint((gray-g0)*factor); graywhere (gray<0) = 0; graywhere (gray>=nlevels) = (nlevels-1); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/rand-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/rand-module.c
Changed
@@ -1,5 +1,5 @@ /* -*- mode: C; mode: fold -*- -Copyright (C) 2007-2017,2018 John E. Davis +Copyright (C) 2007-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/rand.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/rand.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/select-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/select-module.c
Changed
@@ -1,4 +1,4 @@ -/* Copyright (c) 2010-2017,2018 John E. Davis +/* Copyright (c) 2010-2021,2022 John E. Davis * This file is part of the S-Lang library. * * You may distribute under the terms of the GNU General Public
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/slsmg-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/slsmg-module.c
Changed
@@ -1,6 +1,6 @@ /* This module implements an interface to the SLang SMG routines */ /* -*- mode: C; mode: fold -*- -Copyright (C) 2010-2017,2018 John E. Davis +Copyright (C) 2010-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/socket-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/socket-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold; -*- */ /* - Copyright (C) 2006-2017,2018 John E. Davis + Copyright (C) 2006-2021,2022 John E. Davis * This file is part of the S-Lang Library. * @@ -545,7 +545,7 @@ int status; Host_Addr_Info_Type *hinfo; - if (-1 == pop_host_port ("connect", nargs, &host, &port)) + if (-1 == pop_host_port ("bind", nargs, &host, &port)) return -1; if (NULL == (hinfo = get_host_addr_info (host)))
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/stats-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/stats-module.c
Changed
@@ -1,6 +1,7 @@ /* -*- mode: C; mode: fold; -*- */ /* + Copyright (c) 2013-2021,2022 John E. Davis Copyright (c) 2007 Massachusetts Institute of Technology This software was developed by the MIT Center for Space Research
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/stats-module.h -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/stats-module.h
Changed
@@ -1,7 +1,7 @@ #ifndef SLSTATS_MODULE_H_ # define SLSTATS_MODULE_H_ 1 /* -Copyright (C) 2017,2018 John E. Davis +Copyright (C) 2017-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/stats.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/stats.sl
Changed
@@ -78,15 +78,15 @@ return mean (__push_args(args)); } -% These functions return the biased stddev define sample_stddev () { - variable x = (); - variable n = 1.0*length (x); - return stddev(x) * sqrt((n-1.0)/n); + % The stddev intrinsic returns the sample stddev. + % For backward compatibility, simply call it. + variable args = __pop_list (_NARGS); + return stddev (__push_list (args)); } -private define get_mean_stddev (x) +private define get_mean_and_biased_stddev (x) { variable m = mean(x); variable n = 1.0*length (x); @@ -94,13 +94,61 @@ return m, s, n; } +define cumulant () +{ + variable x, m = 0; + + if (_NARGS == 2) + (x,m) = (); + + % Only the first 4 cumulants are supported + if ((m != 1) && (m != 2) && (m != 3) && (m != 4)) + usage ("k1,..,kn = cumulant(A, n); %% n=1,2,3,4"); + + variable i, n = double(length (x)); + variable k = Double_Typem; k* = _NaN; + + if (n <= m) return k; + + variable s1, s2, s3, s4, s1_2, s1_3, s1_4, den, xm; + + den = n; + xm = x; + s1 = sum(xm); + k0 = s1/den; + if ((m == 1) || isnan(s1)) return k; + + den = den*(n-1.0); + xm = xm * x; + s2 = sum(xm); + s1_2 = s1*s1; + k1 = (n*s2-s1_2)/den; + if (m == 2) return k; + + den = den*(n-2.0); + xm = xm*x; + s3 = sum(xm); + s1_3 = s1_2*s1; + k2 = (2*s1_3 - n*(3*s1*s2 - n*s3))/den; + if (m == 3) return k; + + den = den*(n-3.0); + xm = xm*x; + s4 = sum(xm); + s1_4 = s1_3*s1; + k3 = (-6*s1_4 + n*s2*(12*s1_2 - 3*(n-1)*s2) + -n*(n+1)*(4*s1*s3 - n*s4))/den; + return k; +} + +% Returns the skewness (Wikipedia g1) define skewness () { if (_NARGS != 1) usage ("s = %s(A);", _function_name ()); variable x = (); variable m, s, n; - (m, s, n) = get_mean_stddev (x); + (m, s, n) = get_mean_and_biased_stddev (x); x = sum (((x - m)/s)^3)/n; @@ -116,7 +164,7 @@ usage ("s = %s(A);", _function_name ()); variable x = (); variable m, s, n; - (m, s, n) = get_mean_stddev (x); + (m, s, n) = get_mean_and_biased_stddev (x); x = sum (((x - m)/s)^4)/n - 3.0; @@ -423,7 +471,7 @@ (x,y,tref) = (); else { - usage ("p = welch_t_test2 (X, Y ,&t ; qualifiers); %% Welch's 2 sample t-test\n" + usage ("p = welch_t_test (X, Y ,&t ; qualifiers); %% Welch's 2 sample t-test\n" + "Qualifiers:\n" + " side=\"<\" | \">\"" );
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/stats_kendall.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/stats_kendall.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2017,2018 John E. Davis +Copyright (C) 2020-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/statslib/ad_test.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/statslib/ad_test.sl
Changed
@@ -255,6 +255,7 @@ variable i, j, a, zz; + % Evaluate adinf(z) i = where (0.0 < z < 2.0, &j); if (length (i)) { @@ -315,8 +316,10 @@ usage ("\ p = ad_test (X ,&Asquared);\n\ %% 1-sample Anderson-Darling test\n\ Qualifiers:\n\ - ;cdf %% The X values are the CDFs of the underlying distribution\n\ - %% and 0 <= X <= 1\n\ + ;cdf %% The X values are the CDFs of the underlying distribution\n\ + %% and 0 <= X <= 1\n\ + ;mean=val %% The mean of the assumed normal distribution\n\ + ;stddev=val %% The stddev of the assumed normal distribution\n\ " ); @@ -350,8 +353,6 @@ variable ii = 1:2*n:2; variable a2 = -n - (sum(ii*log(cdf) + (2*n-ii)*log(1.0-cdf)))/n; - a2 = factor * a2; - if (s_ref != NULL) @s_ref = a2; @@ -359,6 +360,7 @@ { return 1.0 - anderson_darling_cdf (a2, n); } + a2 = factor * a2; % Augostino & Stephens, 1986 if (a2 >= 0.6)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/statslib/ks_test.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/statslib/ks_test.sl
Changed
@@ -44,8 +44,8 @@ % private define ks_test2_prob () { - if (_NARGS != 3) - usage ("p = %s(m, n, d); %% P(D_mn >= d)", _function_name ()); + %if (_NARGS != 3) + % usage ("p = %s(m, n, d); %% P(D_mn >= d)", _function_name ()); variable d, m, n; (m, n, d) = (); % See the above note for why 1 is subtracted for the first argument of
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/sysconf-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/sysconf-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold; -*- */ /* -Copyright (C) 2009-2017,2018 John E. Davis +Copyright (C) 2009-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/termios-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/termios-module.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2010-2017,2018 John E. Davis +Copyright (C) 2010-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -101,7 +101,8 @@ } #define DO_SYSCALL_0(fun, f) do_syscall_0((int(*)(int))(fun),(f)) -#define DO_SYSCALL_1(fun, f, i) do_syscall_1((int(*)(int,int))(fun),(f),(i)) +/* #define DO_SYSCALL_1(fun, f, i) do_syscall_1((int(*)(int,int))(fun),(f),(i)) */ +#define DO_SYSCALL_1(fun, f, i) do_syscall_1((fun),(f),(i)) #define DO_SYSCALL_STRUCT_1(fun, f, s) \ do_syscall_struct_1((int(*)(int, void*))(fun), (f), (void*)(s)) #define DO_SYSCALL_STRUCT_2(fun, f, i, s) \ @@ -129,7 +130,18 @@ static int tcsetpgrp_intrin (SLFile_FD_Type *f, int *id) { - return DO_SYSCALL_1 (tcgetpgrp, f, *id); + /* In case sizeof(pid_t) is not the same as sizeof(int), inline this */ + int fd; + int ret; + + if (-1 == SLfile_get_fd (f, &fd)) + return -1; + + while ((-1 == (ret = tcsetpgrp (fd, *id))) + && (0 == check_and_set_errno (errno))) + ; + + return ret; } static int tcsendbreak_intrin (SLFile_FD_Type *f, int *action)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/runtests.sh -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/runtests.sh
Changed
@@ -9,17 +9,36 @@ export DYLD_LIBRARY_PATH="$ROOT/src/${ARCH}elfobjs" run_test_pgm="$SLSHROOT/${ARCH}objs/slsh_exe -n -g" -#run_test_pgm="$SLSHROOT/${ARCH}objs/slsh_exe -n -g $SLSHROOT/scripts/sldb" runprefix="$SLTEST_RUN_PREFIX" -#runprefix="valgrind --tool=memcheck --leak-check=yes --error-limit=no --num-callers=25" -#runprefix="gdb --args" +use_slcov=0 +while "$#" -ge 1 +do + case "$1" in + "--slcov" ) runsuffix="$SLSHROOT/scripts/slcov"; shift + rm -f test_*.slcov* + use_slcov=1 + ;; + "--sldb" ) runsuffix="$SLSHROOT/scripts/sldb"; shift + ;; + "--gdb" ) runprefix="gdb --args"; shift + ;; + "--memcheck" ) runprefix="valgrind --tool=memcheck --leak-check=yes --error-limit=no --num-callers=25" + shift + ;; + "--strace" ) runprefix="strace -f -o strace.log" + shift + ;; + * ) break + ;; + esac +done ######################################################################## if $# -eq 0 then - echo "Usage: $0 test1.sl test2.sl ..." + echo "Usage: $0 --gdb|--sldb|--slcov|--memcheck test1.sl test2.sl ..." exit 64 fi @@ -29,9 +48,10 @@ n_failed=0 tests_failed="" + for testxxx in $@ do - $runprefix $run_test_pgm $testxxx + $runprefix $run_test_pgm $runsuffix $testxxx if $? -ne 0 then @@ -44,6 +64,15 @@ if $n_failed -eq 0 then echo "All tests passed." + if $use_slcov -eq 1 + then + lcov_merge_args="" + for X in test_*.slcov* + do + lcov_merge_args="$lcov_merge_args -a $X" + done + lcov $lcov_merge_args -o "modules.slcov" + fi else echo "$n_failed tests failed: $tests_failed" fi
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_chksum.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_chksum.sl
Changed
@@ -3,33 +3,54 @@ private variable Chksum_Map = Assoc_Type; -private define add_entry (str, md5, sha1) +private define add_entry (str, md5, sha1, + sha224, sha256, sha384, sha512) { Chksum_Mapstr = struct { md5 = md5, sha1 = sha1, + sha224 = sha224, + sha256 = sha256, + sha384 = sha384, + sha512 = sha512, }; } add_entry ("", "d41d8cd98f00b204e9800998ecf8427e", - "da39a3ee5e6b4b0d3255bfef95601890afd80709" + "da39a3ee5e6b4b0d3255bfef95601890afd80709", + "d14a028c2a3a2bc9476102bb288234c415a2b01f828ea62ac5b3e42f", + "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855", + "38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b", + "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" ); add_entry ("1", "c4ca4238a0b923820dcc509a6f75849b", - "356a192b7913b04c54574d18c28d46e6395428ab" + "356a192b7913b04c54574d18c28d46e6395428ab", + "e25388fde8290dc286a6164fa2d97e551b53498dcbf7bc378eb1f178", + "6b86b273ff34fce19d6b804eff5a3f5747ada4eaa22f1d49c01e52ddb7875b4b", + "47f05d367b0c32e438fb63e6cf4a5f35c2aa2f90dc7543f8a41a0f95ce8a40a313ab5cf36134a2068c4c969cb50db776", + "4dff4ea340f0a823f15d3f4f01ab62eae0e5da579ccb851f8db9dfe84c58b2b37b89903a740e1ee172da793a6e79d560e5f7f9bd058a12a280433ed6fa46510a" ); add_entry ("Four score and seven years ago", "8bc88284b17081c54df4daa4576251f7", - "0e6089220e01abfc69188c555f1a37201d2fa37f" + "0e6089220e01abfc69188c555f1a37201d2fa37f", + "5016349562f610749f5e34b105e48b55e2fb3aed3f81fd0572f066fd", + "213742bd59f1d8fe848b6ea94647dd465310b8d816234d5a952dc645fa320707", + "8d18c7eb4e4ccaaf18f6e7b9566d97e2a81d0838e704e8d9da1cb7461efa44165fe9ad5510f2dafa630f1de8b32d0a42", + "c9e9b19978e48a2d3031bfc411f60ab1d89e5ccfb9fabbc0ec135c14aa54568ca051e96ed07a5d0c7c3704f7f3189a631008734b4ce6ee1d87e97384aea21fe7" ); add_entry ("Four score and seven years ago our fathers brought forth on this continent a new nation, conceived in liberty, and dedicated to the proposition that all men are created equal.", "73168f4191456bc526791a83c064997b", - "3eabb94199e5347c55ae914ef75803ff0970d9e4" + "3eabb94199e5347c55ae914ef75803ff0970d9e4", + "0b85933f2cf20d16c0158e46b101386b5f791a360b9590f053369a58", + "16b7310f53d595aa0cad0cbe8c4fe3e8ae4c71d21faae9ee0ac84530d759beea", + "d8f207a10e97415c2147f8702a5a1cd93239aa2dbdd8c6c23da9723929b189e65a1c9e5aae79d8161c736bbfec94b617", + "2a4a49becf6865588cf7fab5f3fee94a4fd2cbcc19fa6202d6be153360992ad0a8993a14a44429035cc3377dd22e1bfafb09f5e5625f3fe7654c2fdfbb3e6cfb" ); private define test_accumulate (name, str, chksum) @@ -82,9 +103,7 @@ variable md5 = md5sum (key); if (md5 != s.md5) failed ("MD5 failure for %s, got %s instead of %s", key, md5, s.md5); - test_accumulate ("md5", key, md5); - md5 = test_chksum_file (&md5sum_file, key); if (md5 != s.md5) failed ("md5sum_file failed: got %s, expected %s", md5, s.md5); @@ -92,13 +111,50 @@ variable sha1 = sha1sum (key); if (sha1 != s.sha1) failed ("SHA1 failure for %s, got %s instead of %s", key, sha1, s.sha1); - test_accumulate ("sha1", key, sha1); - sha1 = test_chksum_file (&sha1sum_file, key); if (sha1 != s.sha1) failed ("sha1sum_file failed: got %s, expected %s", sha1, s.sha1); + + variable sha224 = sha224sum (key); + if (sha224 != s.sha224) + failed ("sha224 failure for %s, got %s instead of %s", key, sha224, s.sha224); + test_accumulate ("sha224", key, sha224); + sha224 = test_chksum_file (&sha224sum_file, key); + if (sha224 != s.sha224) + failed ("sha224sum_file failed: got %s, expected %s", sha224, s.sha224); + + variable sha256 = sha256sum (key); + if (sha256 != s.sha256) + failed ("sha256 failure for %s, got %s instead of %s", key, sha256, s.sha256); + test_accumulate ("sha256", key, sha256); + sha256 = test_chksum_file (&sha256sum_file, key); + if (sha256 != s.sha256) + failed ("sha256sum_file failed: got %s, expected %s", sha256, s.sha256); + + variable sha384 = sha384sum (key); + if (sha384 != s.sha384) + failed ("sha384 failure for %s, got %s instead of %s", key, sha384, s.sha384); + test_accumulate ("sha384", key, sha384); + sha384 = test_chksum_file (&sha384sum_file, key); + if (sha384 != s.sha384) + failed ("sha384sum_file failed: got %s, expected %s", sha384, s.sha384); + + variable sha512 = sha512sum (key); + if (sha512 != s.sha512) + failed ("sha512 failure for %s, got %s instead of %s", key, sha512, s.sha512); + test_accumulate ("sha512", key, sha512); + sha512 = test_chksum_file (&sha512sum_file, key); + if (sha512 != s.sha512) + failed ("sha512sum_file failed: got %s, expected %s", sha512, s.sha512); } + + if (md5sum_new().name != "md5") failed ("md5sum_new"); + if (sha1sum_new().name != "sha1") failed ("sha1sum_new"); + if (sha224sum_new().name != "sha224") failed ("sha224sum_new"); + if (sha256sum_new().name != "sha256") failed ("sha256sum_new"); + if (sha384sum_new().name != "sha384") failed ("sha384sum_new"); + if (sha512sum_new().name != "sha512") failed ("sha512sum_new"); } define slsh_main ()
View file
_service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_crc.sl
Added
@@ -0,0 +1,173 @@ +() = evalfile ("./test.sl"); +require ("chksum"); + +private variable CRC8_Map = Assoc_Type; +private variable CRC16_Map = Assoc_Type; +private variable CRC32_Map = Assoc_Type; + +private define addcrc (map, name,r0,r1,poly,seed,refin,refout,xorout) +{ + mapname = struct + { + s0 = "Four score and seven years ago", + s1 = "123456789", + r0 = r0, + r1 = r1, + poly = poly, + seed = seed, + refin = refin, + refout = refout, + xorout = xorout, + }; +} + +private define addcrc8(name,r0,r1,poly,seed,refin,refout,xorout) +{ + addcrc (CRC8_Map, name,r0,r1,poly,seed,refin,refout,xorout); +} + +addcrc8("CRC-8", 0x3EU, 0xBCU, 0xD5U, 0x00U, 0, 0, 0x00U); +addcrc8("CRC-8/CDMA2000", 0xE6U, 0xDAU, 0x9BU, 0xFFU, 0, 0, 0x00U); +addcrc8("CRC-8/DARC", 0x4DU, 0x15U, 0x39U, 0x00U, 1, 1, 0x00U); +addcrc8("CRC-8/DVB-S2", 0x3EU, 0xBCU, 0xD5U, 0x00U, 0, 0, 0x00U); +addcrc8("CRC-8/EBU", 0x1FU, 0x97U, 0x1DU, 0xFFU, 1, 1, 0x00U); +addcrc8("CRC-8/I-CODE", 0x00U, 0x7EU, 0x1DU, 0xFDU, 0, 0, 0x00U); +addcrc8("CRC-8/ITU", 0xB5U, 0xA1U, 0x07U, 0x00U, 0, 0, 0x55U); +addcrc8("CRC-8/MAXIM", 0x98U, 0xA1U, 0x31U, 0x00U, 1, 1, 0x00U); +addcrc8("CRC-8/ROHC", 0xC4U, 0xD0U, 0x07U, 0xFFU, 1, 1, 0x00U); +addcrc8("CRC-8/WCDMA", 0xDCU, 0x25U, 0x9BU, 0x00U, 1, 1, 0x00U); + +private define addcrc16(name,r0,r1,poly,seed,refin,refout,xorout) +{ + addcrc (CRC16_Map, name,r0,r1,poly,seed,refin,refout,xorout); +} + +addcrc16("CRC-16", 0x8FAAU, 0x29B1U, 0x1021U, 0xFFFFU, 0, 0, 0x0000U); +addcrc16("CRC-16/CCITT-0", 0x8FAAU, 0x29B1U, 0x1021U, 0xFFFFU, 0, 0, 0x0000U); +addcrc16("CRC-16/ARC", 0xE78CU, 0xBB3DU, 0x8005U, 0x0000U, 1, 1, 0x0000U); +addcrc16("CRC-16/AUG-CCITT", 0x54A3U, 0xE5CCU, 0x1021U, 0x1D0FU, 0, 0, 0x0000U); +addcrc16("CRC-16/BUYPASS", 0xC772U, 0xFEE8U, 0x8005U, 0x0000U, 0, 0, 0x0000U); +addcrc16("CRC-16/CDMA2000", 0xA2C5U, 0x4C06U, 0xC867U, 0xFFFFU, 0, 0, 0x0000U); +addcrc16("CRC-16/DDS-110", 0x475BU, 0x9ECFU, 0x8005U, 0x800DU, 0, 0, 0x0000U); +addcrc16("CRC-16/DECT-R", 0x9854U, 0x007EU, 0x0589U, 0x0000U, 0, 0, 0x0001U); +addcrc16("CRC-16/DECT-X", 0x9855U, 0x007FU, 0x0589U, 0x0000U, 0, 0, 0x0000U); +addcrc16("CRC-16/DNP", 0x5F10U, 0xEA82U, 0x3D65U, 0x0000U, 1, 1, 0xFFFFU); +addcrc16("CRC-16/EN-13757", 0x0D60U, 0xC2B7U, 0x3D65U, 0x0000U, 0, 0, 0xFFFFU); +addcrc16("CRC-16/GENIBUS", 0x7055U, 0xD64EU, 0x1021U, 0xFFFFU, 0, 0, 0xFFFFU); +addcrc16("CRC-16/MAXIM", 0x1873U, 0x44C2U, 0x8005U, 0x0000U, 1, 1, 0xFFFFU); +addcrc16("CRC-16/MCRF4XX", 0x24BCU, 0x6F91U, 0x1021U, 0xFFFFU, 1, 1, 0x0000U); +addcrc16("CRC-16/RIELLO", 0x0FB0U, 0x63D0U, 0x1021U, 0xB2AAU, 1, 1, 0x0000U); +addcrc16("CRC-16/T10-DIF", 0xD885U, 0xD0DBU, 0x8BB7U, 0x0000U, 0, 0, 0x0000U); +addcrc16("CRC-16/TELEDISK", 0x3CEFU, 0x0FB3U, 0xA097U, 0x0000U, 0, 0, 0x0000U); +addcrc16("CRC-16/TMS37157", 0x8A0CU, 0x26B1U, 0x1021U, 0x89ECU, 1, 1, 0x0000U); +addcrc16("CRC-16/USB", 0x578DU, 0xB4C8U, 0x8005U, 0xFFFFU, 1, 1, 0xFFFFU); +addcrc16("CRC-16/A", 0xCE93U, 0xBF05U, 0x1021U, 0xC6C6U, 1, 1, 0x0000U); +addcrc16("CRC-16/KERMIT", 0x86E8U, 0x2189U, 0x1021U, 0x0000U, 1, 1, 0x0000U); +addcrc16("CRC-16/MODBUS", 0xA872U, 0x4B37U, 0x8005U, 0xFFFFU, 1, 1, 0x0000U); +addcrc16("CRC-16/X-25", 0xDB43U, 0x906EU, 0x1021U, 0xFFFFU, 1, 1, 0xFFFFU); +addcrc16("CRC-16/XMODEM", 0xA5EFU, 0x31C3U, 0x1021U, 0x0000U, 0, 0, 0x0000U); + +private define addcrc32(name,r0,r1,poly,seed,refin,refout,xorout) +{ + addcrc (CRC32_Map, name,r0,r1,poly,seed,refin,refout,xorout); +} +addcrc32("CRC-32", 0x3CFE93B8U, 0xCBF43926U, 0x04C11DB7U, 0xFFFFFFFFU, 1, 1, 0xFFFFFFFFU); +addcrc32("CRC-32/BZIP2", 0x1CFC038AU, 0xFC891918U, 0x04C11DB7U, 0xFFFFFFFFU, 0, 0, 0xFFFFFFFFU); +addcrc32("CRC-32/C", 0xA3E98C0DU, 0xE3069283U, 0x1EDC6F41U, 0xFFFFFFFFU, 1, 1, 0xFFFFFFFFU); +addcrc32("CRC-32/D", 0x40A73E0DU, 0x87315576U, 0xA833982BU, 0xFFFFFFFFU, 1, 1, 0xFFFFFFFFU); +addcrc32("CRC-32/MPEG-2", 0xE303FC75U, 0x0376E6E7U, 0x04C11DB7U, 0xFFFFFFFFU, 0, 0, 0x00000000U); +addcrc32("CRC-32/POSIX", 0x4E7FDC75U, 0x765E7680U, 0x04C11DB7U, 0x00000000U, 0, 0, 0xFFFFFFFFU); +addcrc32("CRC-32/Q", 0x099A5C02U, 0x3010BF7FU, 0x814141ABU, 0x00000000U, 0, 0, 0x00000000U); +addcrc32("CRC-32/JAMCRC", 0xC3016C47U, 0x340BC6D9U, 0x04C11DB7U, 0xFFFFFFFFU, 1, 1, 0x00000000U); +addcrc32("CRC-32/XFER", 0x636909D5U, 0xBD0BE338U, 0x000000AFU, 0x00000000U, 0, 0, 0x00000000U); + +private define test_crc_file (func, data) +{ + variable tmpfile = sprintf ("/tmp/test_crc_%d_%d", getpid(), _time()); + variable fp = fopen (tmpfile, "wb"); + if (fp == NULL) + return; + () = fwrite (data, fp); + () = fclose (fp); + variable s = (@func)(tmpfile;; __qualifiers); + () = remove (tmpfile); + return s; +} + + +private define check_crcmap (type, map, sumfunc, sumfile) +{ + foreach (assoc_get_keys (map)) + { + variable key = (); + variable s = mapkey; + + variable cs, r; + + cs = chksum_new (type; seed=s.seed, poly=s.poly, + refin=s.refin, refout=s.refout, xorout=s.xorout); + cs.accumulate (s.s0); + r = cs.close(); + if (r != s.r0) + { + failed ("%S `%S' produced 0x%X, expected 0x%X", + key, s.s0, r, s.r0); + } + + cs = chksum_new (key); + cs.accumulate (s.s0); + r = cs.close(); + if (r != s.r0) + { + failed ("%S as key `%S' produced 0x%X, expected 0x%X", + key, s.s0, r, s.r0); + } + + cs = chksum_new (type; seed=s.seed, poly=s.poly, + refin=s.refin, refout=s.refout, xorout=s.xorout); + foreach (s.s1) + { + variable ch = (); + cs.accumulate (char(ch)); + } + r = cs.close(); + if (r != s.r1) + { + failed ("%S `%S' produced 0x%X, expected 0x%X", + key, s.s1, r, s.r1); + } + + r = (@sumfunc)(s.s1; + seed=s.seed, poly=s.poly, + refin=s.refin, refout=s.refout, xorout=s.xorout); + if (r != s.r1) + { + failed ("sumfunc=%S", sumfunc); + } + + r = test_crc_file (sumfile, s.s1; + seed=s.seed, poly=s.poly, + refin=s.refin, refout=s.refout, xorout=s.xorout); + if (r != s.r1) + failed ("sumfile=%S", sumfile); + } +} + +private define test_module (module_name) +{ + testing_module (module_name); + check_crcmap ("crc8", CRC8_Map, &crc8sum, &crc8sum_file); + check_crcmap ("crc16", CRC16_Map, &crc16sum, &crc16sum_file); + check_crcmap ("crc32", CRC32_Map, &crc32sum, &crc32sum_file); + + if (crc8_new().name != "crc8") failed ("crc8_new"); + if (crc16_new().name != "crc16") failed ("crc16_new"); + if (crc32_new().name != "crc32") failed ("crc32_new"); +} + +define slsh_main () +{ + test_module ("chksum/crc"); + end_test (); +} +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_csv.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_csv.sl
Changed
@@ -29,20 +29,18 @@ { variable names = get_struct_field_names (Table); - variable table = csv_readcol (file;has_header); - + variable table = csv_readcol (file; has_header, init_size=1); if (any(names != get_struct_field_names (table))) { - failed ("csv_read/write failed to produce a table with the expected column names"); + failed ("1: csv_read/write failed to produce a table with the expected column names"); return; } - foreach (names) { variable name = (); ifnot (_eqs(get_struct_field (table, name), get_struct_field (table, name))) { - failed ("column %S entries are not equal", name); + failed ("1: column %S entries are not equal", name); return; } } @@ -56,7 +54,28 @@ table = csv_readcol (file, 1, 3; has_header); if (any(names1,3-1 != get_struct_field_names (table))) { - failed ("csv_read/write failed to produce a table with the expected column names"); + failed ("2: csv_read/write failed to produce a table with the expected column names"); + return; + } + foreach (get_struct_field_names (table)) + { + name = (); + ifnot (_eqs(get_struct_field (table, name), get_struct_field (table, name))) + { + failed ("2: column %S entries are not equal", name); + return; + } + } + + if (typeof(file) == File_Type) + { + clearerr (file); + () = fseek (file, 0, SEEK_SET); + } + table = csv_readcol (file, names2, names0; has_header); + if (any(names2,0 != get_struct_field_names (table))) + { + failed ("3: csv_read/write failed to produce a table with the expected column names"); return; } foreach (get_struct_field_names (table)) @@ -64,12 +83,101 @@ name = (); ifnot (_eqs(get_struct_field (table, name), get_struct_field (table, name))) { - failed ("column %S entries are not equal", name); + failed ("3: column %S entries are not equal", name); return; } } } +private define test_empty_file (file) +{ + variable s = struct + { + col1name = String_Type0, col2name = Int_Type 0, col3name = Float_Type0, + }; + csv_writecol (file, s); + variable s1 = csv_readcol (file; has_header, type2='i', type3='f'); + + ifnot (_eqs(s, s1)) + { + failed ("csv_read/writecol for a file with no rows"); + } + + () = open (file, O_WRONLY|O_TRUNC); + s1 = csv_readcol (file; header=get_struct_field_names(s), type="sif"); + ifnot (_eqs(s, s1)) + { + failed ("csv_read/writecol for empty file failed"); + } + +} + +private define test_embedded_cr (file) +{ + variable fp = fopen (file, "w"); + variable f0 = "ABC\rDEF", f1 = `quot\r,ed"`, f2 = "\rXYZ"; + () = fprintf (fp, "%S,\"%S\"\",%S\n", f0, f1, f2); + () = fclose (fp); + variable s = csv_readcol (file); + if (3 != length (get_struct_field_names (s))) + { + failed ("test_embedded_cr: wrong num fields"); + } + if ((s.col10 != f0) || (s.col20 != f1) || (s.col30 != f2)) + { + failed ("test_embedded_cr: column values do not match"); + } +} + + +private define test_embedded_comments (file) +{ + variable fp = fopen (file, "w"); + () = fputs (` +#comment line +name +"Value +#1" +#another comment +Value #2 +`, + fp); + () = fclose (fp); + variable s = csv_readcol (file; has_header, comment="#"); + if (length (s.name) != 2) + failed ("test_embedded_comments: expected 2 rows"); + if (s.name0 != "Value\n#1") + failed ("test_embedded_comments: value 1 incorrect"); + if (s.name1 != "Value #2") + failed ("test_embedded_comments: value 2 incorrect"); +} + +private define test_rdb (file) +{ + variable n = 10; + variable x = 0:2*PI:#n; + variable s0 = struct + { + idx = 1:n, x = x, sinx = sin(x), fsinx, + }; + variable fsinx = typecast (s0.sinx, Float_Type); + s0.fsinx = fsinx; + + csv_writecol (file, s0; rdb); + variable s1 = csv_readcol (file; rdb, type4='f'); + ifnot (_eqs (s0, s1)) + { + failed ("rdb 1"); + } + + s1 = csv_readcol (file; rdb, type='A', type4='f'); + ifnot (_eqs (s0, s1)) + { + failed ("rdb 2"); + } +} + + define slsh_main () { testing_module ("csv"); @@ -78,6 +186,11 @@ csv_writecol (file, Table); test_csv (file); test_csv (fopen (file, "r")); + test_csv (fgetslines (fopen (file, "r"))); + test_empty_file (file); + test_embedded_comments (file); + test_embedded_cr (file); + test_rdb (file); () = remove (file); end_test (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_hist.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_hist.sl
Changed
@@ -364,9 +364,58 @@ catch InvalidParmError:; } +private define check_usage (fun) +{ + try + { + (@fun)(); + } + catch UsageError; +} + +private define test_whist () +{ + variable grid = 0:9; + variable pts = 10*urand (20); + variable wghts = Double_Typelength(pts); + wghtswhere (5 <= pts < 6) = 7.5; + variable h = whist1d (pts, wghts, grid); + % We expect h=0, except for h5. + variable i = where (grid5 <= pts < grid6); + variable hexp = Double_Type10; hexp5 = 7.5*length(i); + ifnot (_eqs (h, hexp)) + { + failed ("whist1d 1"); + } + + variable nx = 10, ny = 20, xgrid = 0:nx-1, ygrid = 0:ny-1; + variable xpts = nx*urand(10000); + variable ypts = ny*urand(10000); + wghts = Double_Typelength(xpts); + i = where ((5 <= xpts < 7) and (2 <= ypts < 3)); + wghtsi = 7.1; + hexp = Double_Typenx, ny; + hexp5,2 = 7.1*length(where((5<=xpts<6)and(2<=ypts<3))); + hexp6,2 = 7.1*length(where((6<=xpts<7)and(2<=ypts<3))); + variable r; + h = whist2d (xpts, ypts, wghts, xgrid, ygrid, &r); + ifnot (_eqs(h, hexp)) + failed ("whist2d 1"); + + variable xgrid1 = 0,2,4,5,7:nx-1:2; + h = hist2d_rebin (xgrid1, ygrid, xgrid, ygrid, h); + if (h3,2 != (hexp5,2 + hexp6,2)) + failed ("hist2d_rebin"); + + check_usage (&whist2d); + check_usage (&whist1d); + check_usage (&hist2d_rebin); +} + define slsh_main () { test_module ("hist"); test_badgrids (); + test_whist (); end_test (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_pcre.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_pcre.sl
Changed
@@ -18,6 +18,10 @@ if (ans != eans) failed ("pcre_exec(%s) matched '%s, expected '%s'", slpat, ans, eans); + + variable matches = pcre_matches (pat, str); + if ((matches == NULL) || (matches0 != eans)) + failed ("pcre_matches"); } define slsh_main ()
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_png.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_png.sl
Changed
@@ -40,10 +40,68 @@ } } +private define test_colormaps () +{ + variable cmap_names = png_get_colormap_names(); + + if (length (cmap_names) == 0) + failed ("png_get_colormap_names: no color maps found"); + + variable cmap_name, cmap; + + foreach cmap_name (cmap_names) + { + try + { + cmap = png_get_colormap (cmap_name); + if (cmap == NULL) throw DataError; + } + catch AnyError: failed ("png_get_colormap %s failed", cmap_name); + } + + variable rgb = 0x80A0B0C0; + if (png_rgb_get_r (rgb) != 0xA0) failed ("png_get_r failed"); + if (png_rgb_get_g (rgb) != 0xB0) failed ("png_get_g failed"); + if (png_rgb_get_b (rgb) != 0xC0) failed ("png_get_b failed"); + + % A single value or array of identical values map to 127 + rgb = png_gray_to_rgb (0x80); + if (rgb != 0x7F7F7F) failed ("png_gray_to_rgb: %X vs %X", rgb, 0x808080); + + variable img = typecast (64, 128, UChar_Type); + rgb = png_gray_to_rgb (img); + % This should map to 0,255 + ifnot (_eqs(rgb, 0,0xFFFFFF)) + failed ("png_gray_to_rgb(64,128)"); + + variable gray = png_rgb_to_gray (0x808080); + if (gray != 0x80) failed ("png_rgb_to_gray 1"); + + gray = png_rgb_to_gray (0x200000; wghts=1.0,0,0); + if (gray != 0x20) failed ("png_rgb_to_gray 2"); + + variable r = UChar_Type256, g = @r, b = @r; + r0:127 = 0x20; r128: = 0xAA; + g0:127 = 0x40; g128: = 0xBB; + b0:127 = 0x60; b128: = 0xCC; + rgb = (r<<16)|(g<<8)|b; + png_add_colormap ("testmap", rgb); + variable badvalue = rgb0; + + gray = 0:255*1.0; + gray0x80 = _NaN; % bad pixel + rgb = png_gray_to_rgb (gray, "testmap"); + if ((rgb64 != 0x204060) + || (rgb200 != 0xAABBCC) + || (rgb0x80 != badvalue)) + failed ("png_gray_to_rgb with testmap"); +} + define slsh_main () { testing_module ("png"); test_png (); + test_colormaps (); end_test (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_rand.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_rand.sl
Changed
@@ -345,6 +345,34 @@ } } +private define test_rand_usage_forms () +{ + variable g = rand_new (_time(), getpid()); + variable imin = 12, imax = 15, r; + + r = rand_int (imin, imax); + ifnot (imin <= r <= imax) + failed ("rand_int form 1"); + r = rand_int (imin, imax, 0); + if (length (r) != 0) + failed ("rand_int form 2a"); + r = rand_int (imin, imax, 20); + if (length (r) != 20) + failed ("rand_int form 2b"); + r = rand_int (g, imin, imax, 10); + if (length (r) != 10) + failed ("rand_int form 3"); + r = rand_int (g, imin, imax); + ifnot (imin <= r <= imax) + failed ("rand_int form 4"); + try + { + rand_int (); + failed ("rand_int usage"); + } + catch UsageError; +} + define slsh_main () { testing_module ("rand"); @@ -369,5 +397,7 @@ test_rand_int (); test_rand_exp (); + test_rand_usage_forms (); + end_test (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_stats.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_stats.sl
Changed
@@ -1,5 +1,69 @@ () = evalfile("./test.sl"); -require ("stats.sl"); +require ("stats"); +require ("rand"); + +private define round_to_sigfig (x, n) +{ + if ((x == 0) || (n <= 0)) return x; + variable s = 1; + if (x < 0) + { + x = -x; + s = -1; + } + + % Convert x to exponential form + % x = a*10^b + % where 0.1 <= a < 1.0 ==> -1 <= log10(a) < 0 + % ==> log10(x) = log10(a) + b + % ==> -1 <= log10(x) - b < 0 + % ==> log10(x) < b <= log10(x) + 1 + % Since b is an integer, round log10(x) up to an integer + variable b = int (ceil(log10(x))); + % Given b: + % log10(x) - b = log10(a) + % ==> a = x * 10^(-b); + % + % Since 0.1 <= a < 1.0, write: + % x = (a*10^n)*10^(b-n) + % x = a'*10^(b-n), where a' = a*10^n = x*10^(n-b) + % Then 0.1*10^n <= a' < 10^n + % Or: 10^(n-1) <= a' < 10^n + % Round a' to the nearest integer. + variable p1, p2, a; + p1 = 10^b; p2 = 10^n; % to avoid under/overflow don't combine p1/p2 + a = int (0.5 + (x/p1)*p2); + return s*(a/p2)*p1; +} + +% Many of the books with examples used to validate the tests only +% provide values to a given number of significant figures. +private define sigeq (x, y, n) +{ + x = round_to_sigfig (x,n); + y = round_to_sigfig (y,n); + return feqs (x,y,1e-4,1e-8); +} + +private define generate_data (m, s, n) +{ + variable x = m + rand_gauss (s, n); + variable m0 = mean(x); + x = x + (m-m0); + variable s0 = stddev(x); + x = m + (x-m)*s/s0; + return x; +} + +private define check_usage (ref) +{ + try + { + (@ref)(); + failed ("%S usage", ref); + } + catch UsageError; +} private define test_chisqr_test () { @@ -21,14 +85,14 @@ p = chisqr_test (16,14., 14,6., 13,10., 13,8., &t); if (abs(t - 1.524) > 0.01) failed ("chisqr_test: Expected 1.524, got t=%S", t); + + check_usage (&chisqr_test); } private define test_f () { variable x, y, s, p; variable s0, p0; - %variable x = 41, 34, 33, 36, 40, 25, 31, 37, 34, 30, 38; - %variable y = 52, 57, 62, 55, 64, 57, 56, 55; % This test comes from the Gnumeric documentation for the f-test x = 68.5, 83, 83, 66.5, 58.1, 82.4; @@ -40,8 +104,9 @@ ifnot (feqs (p,p0) || feqs (s,s0)) failed ("f_test2 test 1 failed"); - p = f_test2 (x, y, &s; side=">"); - p0 = 0.53667; + % swap y, x + p = f_test2 (y, x, &s; side=">"); + p0 = 1-0.53667; ifnot (feqs (p,p0)) failed ("f_test2 size=> failed: expected %g, got %g", p0, p); @@ -49,6 +114,8 @@ p0 = 0.46333; ifnot (feqs (p,p0)) failed ("f_test2 side=< failed: expected %g, got %g", p0, p); + + check_usage (&f_test2); } private define map_cdf_to_pval (cdf) @@ -182,6 +249,8 @@ expected_p = 0.0389842391014099; expected_s = -0.376201540231705; run_kendall_test (x, y, expected_p, expected_s); + + check_usage (&kendall_tau); } private define test_ks () @@ -205,6 +274,9 @@ p = ks_test2 (x,y, &s); ifnot (feqs (p, expected_p)) failed ("*** ks_test2 pval=: %g, expected %g", p, expected_p); + + check_usage (&ks_test); + check_usage (&ks_test2); } private define test_mw_cdf (N) @@ -285,6 +357,8 @@ failed ("mw_test 5 returned %S, expected %S", w, ew); ifnot (feqs (p, ep)) failed ("mw_test 5 returned pval=%g, expected %g", p, ep); + + check_usage (&mw_test); } private define test_spearman () @@ -315,6 +389,8 @@ failed ("*** spearman_r statistic: %g, expected %g", s, expected_s); ifnot (feqs (p, expected_p)) failed ("*** spearman_r pval= %g, expected %g", p, expected_p); + + check_usage (&spearman_r); } private define check_pval_and_t (name, pv, t, pv_exp, t_exp) @@ -362,6 +438,54 @@ pval = ad_ktest (__push_list(datasets), &t; pval2=&pval2, stat2=&t2); check_pval_and_t ("ad_ktest3", pval, t, 0.193, 0.70807); check_pval_and_t ("ad_ktest3", pval2, t2, 0.190135, 0.72238); + + check_usage (&ad_ktest); +} + +private define test_ad_test () +{ + % Example from R (via statology.org) using iris data set. Check to + % see if the petal.width data are normally distributed + variable x, pval, t; + x = 0.2, 0.2, 0.2, 0.2, 0.2, 0.4, 0.3, 0.2, + 0.2, 0.1, 0.2, 0.2, 0.1, 0.1, 0.2, 0.4, 0.4, 0.3, 0.3, 0.3, 0.2, 0.4, 0.2, + 0.5, 0.2, 0.2, 0.4, 0.2, 0.2, 0.2, 0.2, 0.4, 0.1, 0.2, 0.2, 0.2, 0.2, 0.1, + 0.2, 0.2, 0.3, 0.3, 0.2, 0.6, 0.4, 0.3, 0.2, 0.2, 0.2, 0.2, 1.4, 1.5, 1.5, + 1.3, 1.5, 1.3, 1.6, 1, 1.3, 1.4, 1, 1.5, 1, 1.4, 1.3, 1.4, 1.5, 1, 1.5, 1.1, + 1.8, 1.3, 1.5, 1.2, 1.3, 1.4, 1.4, 1.7, 1.5, 1, 1.1, 1, 1.2, 1.6, 1.5, 1.6, + 1.5, 1.3, 1.3, 1.3, 1.2, 1.4, 1.2, 1, 1.3, 1.2, 1.3, 1.3, 1.1, 1.3, 2.5, + 1.9, 2.1, 1.8, 2.2, 2.1, 1.7, 1.8, 1.8, 2.5, 2, 1.9, 2.1, 2, 2.4, 2.3, 1.8, + 2.2, 2.3, 1.5, 2.3, 2, 2, 1.8, 2.1, 1.8, 1.8, 1.8, 2.1, 1.6, 1.9, 2, 2.2, + 1.5, 1.4, 2.3, 2.4, 1.8, 1.8, 2.1, 2.4, 2.3, 1.9, 2.3, 2.5, 2.3, 1.9, 2, + 2.3, 1.8; + variable t_exp = 5.1057, pval_exp = 1.125e-12; + pval = ad_test (x, &t); + ifnot (sigeq (t, t_exp, 5) && sigeq(pval, pval_exp, 4)) + { + failed ("ad_test: t=%S, texp=%S, p=%S, pexp=%S", + t, t_exp, pval, pval_exp); + } + + % Try with Marsaglia CDF + x = .0392,.0884,.260,.310,.454,.644,.797,.813,.921,.960; + t_exp = 0.36320; pval_exp = 0.11816; + pval = 1-ad_test (x, &t; cdf); + ifnot (sigeq (t, t_exp, 4) && sigeq(pval, pval_exp, 4)) + { + failed ("ad_test: t=%S, texp=%S, p=%S, pexp=%S", + t, t_exp, pval, pval_exp); + } + + x = .0015,.0078,.0676,.0961,.106,.107,.835,.861,.948,.992; + t_exp = 4.23161; pval_exp = 0.99293; + pval = 1-ad_test (x, &t; cdf); + ifnot (sigeq (t, t_exp, 4) && sigeq(pval, pval_exp, 4)) + { + failed ("ad_test: t=%S, texp=%S, p=%S, pexp=%S", + t, t_exp, pval, pval_exp); + } + + check_usage (&ad_test); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_zlib.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_zlib.sl
Changed
@@ -1,27 +1,25 @@ () = evalfile("./test.sl"); require ("zlib"); -private define silly_deflate (str) +private define silly_deflate (z, str) { - variable z = zlib_deflate_new (); variable x = ""; foreach (str) { variable ch = (); - x = x + _zlib_deflate (z.zobj, pack("C", ch), 0); + x = x + z.deflate (pack("C", ch); flush=ZLIB_NO_FLUSH); } x = x + z.flush (); return x; } -private define silly_inflate (zstr) +private define silly_inflate (z, zstr) { - variable z = zlib_inflate_new (); variable x = ""; foreach (zstr) { variable ch = (); - x = x + _zlib_inflate (z.zobj, pack("C", ch), 0); + x = x + z.inflate(pack("C", ch); flush=ZLIB_NO_FLUSH); } x = x + z.flush (); return x; @@ -36,24 +34,64 @@ failed ("to deflate/inflate %s", str0); return; } - variable zstr1 = silly_deflate (str0); + + variable z = zlib_deflate_new (); + variable zstr1 = silly_deflate (z, str0); + if (zstr1 != zstr) + { + failed ("to deflate %s via multiple calls", str0); + return; + } + % Repeat using the same object + z.reset (); + zstr1 = silly_deflate (z, str0); if (zstr1 != zstr) { failed ("to deflate %s via multiple calls", str0); return; } - str1 = silly_inflate (zstr1); + + z = zlib_inflate_new (); + str1 = silly_inflate (z, zstr1); if (str1 != str0) { failed ("to inflate %s via multiple calls", str0); return; } + % Repeat using the same object + z.reset (); + str1 = silly_inflate (z, zstr1); + if (str1 != str0) + { + failed ("to inflate %s via multiple calls", str0); + return; + } +} + +private define check_usage () +{ + foreach ("zlib_inflate()", "zlib_deflate()", + "zlib_inflate_new().inflate()", + "(@zlib_inflate_new().flush)()", + "zlib_deflate_new().deflate()", + "(@zlib_deflate_new().flush)()", + ) + { + variable f = (); + try + { + eval (f); + failed ("%s usage", f); + } + catch UsageError; + } } define slsh_main () { testing_module ("zlib"); + check_usage (); test_zlib (""); test_zlib ("\0"); test_zlib ("\0\0\0");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/tm/base64funs.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/tm/base64funs.tm
Changed
@@ -123,7 +123,7 @@ variable b64 = _base64_encoder_new (&encode_callback, &s); _base64_encoder_accumulate (b64, bstr); _base64_encoder_close (b64); - return b; + return s; } #v- \example
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/tm/chksumfuns.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/tm/chksumfuns.tm
Changed
@@ -41,3 +41,190 @@ representation of the checksum. \seealso{sha1sum, md5sum_file, md5sum} \done + +\function{crc8sum} +\synopsis{Compute an 8 bit CRC on a string} +\usage{UChar_Type crc8sum (BString_Type bstr)} +\description + This function computes an 8 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: +#v+ + cdma2000 ; poly=0x9B, seed=0xFF, refin=0, refout=0, xorout=0x00 + darc ; poly=0x39, seed=0x00, refin=1, refout=1, xorout=0x00 + dvb-s2 ; poly=0xD5, seed=0x00, refin=0, refout=0, xorout=0x00 + ebu ; poly=0x1D, seed=0xFF, refin=1, refout=1, xorout=0x00 + i-code ; poly=0x1D, seed=0xFD, refin=0, refout=0, xorout=0x00 + itu ; poly=0x07, seed=0x00, refin=0, refout=0, xorout=0x55 + maxim ; poly=0x31, seed=0x00, refin=1, refout=1, xorout=0x00 + rohc ; poly=0x07, seed=0xFF, refin=1, refout=1, xorout=0x00 + wcdma ; poly=0x9B, seed=0x00, refin=1, refout=1, xorout=0x00 +#v- + The CRC-8 algorithm is specified via qualifiers. The following + specify the same CRC-8 algorthm: +#v+ + crc8 = crc8sum ("string" ; type="maxim"); + crc8 = crc8sum ("string" ; poly=0x31, refin=1, refout=1); +#v- + The default CRC-8 algorithm is "dvb-s2". +\example + This example shows how to compute the Maxim CRC-8 value on a file. +#v+ + fp = fopen (file, "rb"); + c = chksum_new("crc8"; type="maxim"); + while (-1 != fread_bytes (&buf, 4096, fp) + c.accumulate (buf); + crc8 = chksum_close (); +#v- +\notes + This function is part of the \var{chksum} module: +#v+ + require("chksum"); +#v- +\seealso{crc16sum, crc32sum, crc8sum_file} +\done + +\function{crc8sum_file} +\synopsis{Compute the CRC-8 value for the contents of a file} +\usage{UChar_Type crc8sum_file (String_Type|File_Type f)} +\description + The \ifun{crc8sum_file} function computes the CRC-8 sum on the + contents of a file. The file may either be specified as a string + giving the name of the file, or as an open stdio \dtype{File_Type} + pointer. The function returns the 8-bit CRC value. + + Qualifiers are used to specifiy the CRC-8 variant. See the + documentation for \ivar{crc8sum} function for more information. +\seealso{crc8sum, crc32sum_file, sha1sum_file} +\done + + +\function{crc16sum} +\synopsis{Compute an 16 bit CRC on a string} +\usage{UInt16_Type crc16sum (BString_Type bstr)} +\description + This function computes an 16 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: +#v+ + ccitt-0 ; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U + arc ; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U + aug-ccitt ; poly=0x1021U, seed=0x1D0FU, refin=0, refout=0, xorout=0x0000U + buypass ; poly=0x8005U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + cdma2000 ; poly=0xC867U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U + dds-110 ; poly=0x8005U, seed=0x800DU, refin=0, refout=0, xorout=0x0000U + dect-r ; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0001U + dect-x ; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + dnp ; poly=0x3D65U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU + en-13757 ; poly=0x3D65U, seed=0x0000U, refin=0, refout=0, xorout=0xFFFFU + genibus ; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0xFFFFU + maxim ; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU + mcrf4xx ; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U + riello ; poly=0x1021U, seed=0xB2AAU, refin=1, refout=1, xorout=0x0000U + t10-dif ; poly=0x8BB7U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + teledisk ; poly=0xA097U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + tms37157 ; poly=0x1021U, seed=0x89ECU, refin=1, refout=1, xorout=0x0000U + usb ; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU + a ; poly=0x1021U, seed=0xC6C6U, refin=1, refout=1, xorout=0x0000U + kermit ; poly=0x1021U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U + modbus ; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U + x-25 ; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU + xmodem ; poly=0x1021U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U +#v- + The CRC-16 algorithm is specified via qualifiers. The following + specify the same CRC-16 algorthm: +#v+ + crc16 = crc16sum ("string" ; type="arc"); + crc16 = crc16sum ("string" ; poly=0x8005U, refin=1, refout=1); +#v- + The default CRC-16 algorithm is "ccitt-0". +\example + This example shows how to compute the Maxim CRC-16 value on a file. +#v+ + fp = fopen (file, "rb"); + c = chksum_new("crc16"; type="maxim"); + while (-1 != fread_bytes (&buf, 4096, fp) + c.accumulate (buf); + crc16 = chksum_close (); +#v- +\notes + This function is part of the \var{chksum} module: +#v+ + require("chksum"); +#v- +\seealso{crc8sum, crc32sum, crc16sum_file} +\done + +\function{crc16sum_file} +\synopsis{Compute the CRC-16 value for the contents of a file} +\usage{UInt16_Type crc16sum_file (String_Type|File_Type f)} +\description + The \ifun{crc16sum_file} function computes the CRC-16 sum on the + contents of a file. The file may either be specified as a string + giving the name of the file, or as an open stdio \dtype{File_Type} + pointer. The function returns the 16-bit CRC value. + + Qualifiers are used to specifiy the CRC-16 variant. See the + documentation for \ivar{crc16sum} function for more information. +\seealso{crc16sum, crc32sum_file, sha1sum_file} +\done + + +\function{crc32sum} +\synopsis{Compute an 32 bit CRC on a string} +\usage{UInt32_Type crc32sum (BString_Type bstr)} +\description + This function computes an 32 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: +#v+ +(default); poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + bzip2 ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0xFFFFFFFFU + c ; poly=0x1EDC6F41U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + d ; poly=0xA833982BU, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + mpeg-2 ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0x00000000U + posix ; poly=0x04C11DB7U, seed=0x00000000U, refin=0, refout=0, xorout=0xFFFFFFFFU + q ; poly=0x814141ABU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U + jamcrc ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0x00000000U + xfer ; poly=0x000000AFU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U +#v- + The CRC-32 algorithm is specified via qualifiers. The following + specify the same CRC-32 algorthm: +#v+ + crc32 = crc32sum ("string" ; type="posix"); + crc32 = crc32sum ("string" ; poly=0x04C11DB7U, xorout=0xFFFFFFFFU); +#v- +\example + This example shows how to compute the default CRC-32 value on a file. +#v+ + fp = fopen (file, "rb"); + c = chksum_new("crc32"); + while (-1 != fread_bytes (&buf, 4096, fp) + c.accumulate (buf); + crc32 = chksum_close (); +#v- +\notes + This function is part of the \var{chksum} module: +#v+ + require("chksum"); +#v- +\seealso{crc8sum, crc32sum, crc32sum_file} +\done + +\function{crc32sum_file} +\synopsis{Compute the CRC-32 value for the contents of a file} +\usage{UInt32_Type crc32sum_file (String_Type|File_Type f)} +\description + The \ifun{crc32sum_file} function computes the CRC-32 sum on the + contents of a file. The file may either be specified as a string + giving the name of the file, or as an open stdio \dtype{File_Type} + pointer. The function returns the 32-bit CRC value. + + Qualifiers are used to specifiy the CRC-32 variant. See the + documentation for \ivar{crc32sum} function for more information. +\seealso{crc32sum, crc16sum_file, sha1sum_file} +\done +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/tm/csvfuns.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/tm/csvfuns.tm
Changed
@@ -25,11 +25,13 @@ It is important to understand the difference between a ROW and a LINE in a CSV formatted file: a row may span more than one line in a file. The \exmp{skiplines} qualifier specifies the number of LINES to be - skipped, not ROWS. + skipped, not ROWS. However, if a comment string appears at the + beginning of one of the lines forming a multiline string, it will + treated as part of the string and not as a comment. CSV files have no notion of data-types: all field values are strings. For this reason, the \exmp{type} qualifier introduces an extra layer - that is not part CSV format. + that is not part of the CSV specification. \seealso{csv.readcol, csv.readrow} \done
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/tm/randfuns.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/tm/randfuns.tm
Changed
@@ -174,7 +174,7 @@ \done \function{rand} -\synopsis{Generate random integers numbers} +\synopsis{Generate random unsigned integers} \usage{X = rand (Rand_Type g, ,num)} \description This function generates unsigned 32 bit randomly distributed
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/tm/statsfuns.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/tm/statsfuns.tm
Changed
@@ -39,8 +39,8 @@ present, then it must be a reference to a variable that will be set to the value of the statistic upon return. \qualifiers -\qualifier{mu=value}{Specifies the known mean of the normal distribution}. -\qualifier{sigma}{Specifies the known standard deviation of the normal distribution} +\qualifier{mean=value}{Specifies the known mean of the normal distribution}. +\qualifier{stddev=value}{Specifies the known standard deviation of the normal distribution} \qualifier{cdf}{If present, the data will be interpreted as a CDFs of a known, but unspecified, distribution.} \notes For testing the hypothesis that a dataset is sampled from a known, @@ -53,7 +53,22 @@ Marsaglia and Marsaglia: Evaluating the Anderson-Darling Distribution, Journal of Statistical Software, Vol. 9, Issue 2, Feb 2004. -\seealso{ad_ktest, ks_test, t_test, z_test, normal_cdf, } +\seealso{ad_ktest, ks_test, t_test, z_test, normal_cdf} +\done + + +\function{cumulant} +\synopsis{Compute the first n cumulants of an array} +\usage{k1,...,kn = cumulant (X, n)} +\description + This function returns unbiased estimates of the first \exmp{n} + cumulants from an array \exmp{X} of samples of a probability + distribution. The cumulants are returned as an array of size + \exmp{n}. +\notes + The implementation currently restricts the value of n to 1, 2, 3, or 4. + The estimator of the nth cumulent is also known as the nth k-statistic. +\seealso{mean, stddev, kurtosis, skewness} \done \function{median} @@ -136,7 +151,7 @@ \synopsis{Compute the skewness of an array of values} \usage{s = skewness (a)} \description - This function computes the so-called skewness of the array \exmp{a}. + This function computes the skewness (g1) of the array \exmp{a}. \seealso{mean, stddev, kurtosis} \done @@ -144,7 +159,7 @@ \synopsis{Compute the kurtosis of an array of values} \usage{s = kurtosis (a)} \description - This function computes the so-called kurtosis of the array \exmp{a}. + This function computes the kurtosis (g2) of the array \exmp{a}. \notes This function is defined such that the kurtosis of the normal distribution is 0, and is also known as the ``excess-kurtosis''. @@ -181,11 +196,11 @@ \function{poisson_cdf} \synopsis{Compute the Poisson CDF} -\usage{cdf = poisson_cdf (Double_Type m, Int_Type k)} +\usage{cdf = poisson_cdf (Double_Type lambda, Int_Type k)} \description This function computes the CDF for the Poisson probability - distribution parameterized by the value \exmp{m}. For values of - \exmp{m>100} and \exmp{abs(m-k)<sqrt(m)}, the Wilson and Hilferty + distribution parameterized by the value \exmp{lambda}. For values of + \exmp{lambda>100} and \exmp{abs(lambda-k)<sqrt(lambda)}, the Wilson and Hilferty asymptotic approximation is used. \seealso{chisqr_cdf} \done
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/varray-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/varray-module.c
Changed
@@ -1,5 +1,5 @@ /* -*- mode: C; mode: fold -*- -Copyright (C) 2010-2017,2018 John E. Davis +Copyright (C) 2010-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/zlib-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/zlib-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold; -*- */ /* -Copyright (C) 2008-2017,2018 John E. Davis +Copyright (C) 2008-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -485,7 +485,7 @@ return; if (z->initialized) - check_zerror (deflateReset (&z->zs)); + check_zerror (inflateReset (&z->zs)); } static void inflate_flush_intrin (ZLib_Type *z, int *flush)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/zlib.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/zlib.sl
Changed
@@ -1,5 +1,5 @@ % -*- mode: slang; mode: fold -*- -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slang.lis -> _service:tar_scm:slang-2.3.3.tar.bz2/slang.lis
Changed
@@ -132,7 +132,9 @@ @modules/base64.sl @modules/chksum-module.c @modules/chksum_sha1.c +@modules/chksum_sha2.c @modules/chksum_md5.c +@modules/chksum_crc.c @modules/chksum.h @modules/chksum.sl @modules/csv-module.c @@ -185,6 +187,7 @@ @modules/test/test.sl @modules/test/test_base64.sl @modules/test/test_chksum.sl +@modules/test/test_crc.sl @modules/test/test_csv.sl @modules/test/test_fcntl.sl @modules/test/test_fork.sl @@ -299,6 +302,7 @@ @slsh/lib/profile.sl @slsh/lib/print.sl @slsh/lib/slshhelp.sl +@slsh/lib/timestamp.sl @slsh/lib/cmdopt.sl @slsh/lib/readascii.sl @slsh/lib/process.sl @@ -326,6 +330,7 @@ @slsh/lib/help/process.hlp @slsh/lib/help/setfuns.hlp @slsh/lib/help/listfuns.hlp +@slsh/lib/help/timestamp.hlp @slsh/lib/tm/Makefile @slsh/lib/tm/arrayfuns.tm @@ -340,6 +345,7 @@ @slsh/lib/tm/process.tm @slsh/lib/tm/setfuns.tm @slsh/lib/tm/listfuns.tm +@slsh/lib/tm/timestamp.tm @slsh/lib/test/runtests.sh 0755 @slsh/lib/test/common.sl @@ -350,6 +356,7 @@ @slsh/lib/test/test_process.sl @slsh/lib/test/test_setfuns.sl @slsh/lib/test/test_listfuns.sl +@slsh/lib/test/test_timestamp.sl @slsh/doc/tm/slsh.tm @slsh/doc/tm/Makefile @@ -379,6 +386,7 @@ @slsh/scripts/jpegsize 0755 @slsh/scripts/svnsh 0755 @slsh/scripts/sldb 0755 +@slsh/scripts/slcov 0755 @slsh/scripts/slprof 0755 @slsh/scripts/slstkchk 0755 @slsh/slsh.c
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/Makefile.in -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/Makefile.in
Changed
@@ -37,7 +37,7 @@ SLSH_DOC_DIR = $(datarootdir)/doc/slsh SLSH_LOCALLIB_DIR = $(SLSH_LIB_DIR)/local-packages SLSH_SCRIPT_DIR = $(SLSH_LIB_DIR)/scripts -SCRIPTS = jpegsize lsrpm sldb svnsh slprof slstkchk +SCRIPTS = jpegsize lsrpm sldb svnsh slprof slstkchk slcov #--------------------------------------------------------------------------- # Hard-coded paths may be configured during run-time via the SLSH_CONF_DIR # and SLSH_PATH env variables. The names of those variables may be @@ -77,22 +77,22 @@ #---------------------------------------------------------------------------- @SET_MAKE@ SHELL = /bin/sh -INST_LIBS = $(DEST_LIB_DIR) $(RPATH) $(SLANG_INST_LIB) -lslang $(READLINE_LIB) $(DYNAMIC_LIBS) +INST_LIBS = $(DEST_LIB_DIR) $(RPATH) $(SLANG_INST_LIB) -lslang $(LDFLAGS) $(READLINE_LIB) $(DYNAMIC_LIBS) DEFS = -DSLSH_CONF_DIR='"$(SLSH_CONF_DIR)"' -DSLSH_PATH='"$(SLSH_LIB_DIR)"' \ -DSLSH_CONF_DIR_ENV='$(SLSH_CONF_DIR_ENV)' -DSLSH_LIB_DIR_ENV='$(SLSH_LIB_DIR_ENV)' \ -DSLSH_PATH_ENV='$(SLSH_PATH_ENV)' $(SLSYSWRAP_DEF) SDEFS = $(DEFS) -DSLSH_STATIC -SRC_LIBS = $(SLANG_ELFLIB) -lslang $(SLSYSWRAP_LIB) $(READLINE_LIB) $(DYNAMIC_LIBS) -STATIC_SRC_LIBS = $(SLANG_OBJLIB) -lslang $(SLSYSWRAP_LIB) $(READLINE_LIB) $(STATIC_LIBS) +SRC_LIBS = $(SLANG_ELFLIB) -lslang $(SLSYSWRAP_LIB) $(LDFLAGS) $(READLINE_LIB) $(DYNAMIC_LIBS) +STATIC_SRC_LIBS = $(SLANG_OBJLIB) -lslang $(SLSYSWRAP_LIB) $(LDFLAGS) $(READLINE_LIB) $(STATIC_LIBS) OBJDIR_TSTAMP = $(OBJDIR)/tstamp SOBJDIR_TSTAMP = $(SOBJDIR)/tstamp # all: $(OBJDIR)/slsh_exe slsh: $(OBJDIR)/slsh $(OBJDIR)/slsh_exe: $(OBJDIR)/slsh.o $(OBJDIR)/readline.o - $(CC) $(CFLAGS) $(OBJDIR)/slsh.o $(OBJDIR)/readline.o -o $(OBJDIR)/slsh_exe $(LDFLAGS) $(DLINK_FLAGS) $(SRC_LIBS) + $(CC) $(OBJDIR)/slsh.o $(OBJDIR)/readline.o -o $(OBJDIR)/slsh_exe $(LDFLAGS) $(DLINK_FLAGS) $(SRC_LIBS) $(OBJDIR)/slsh: $(OBJDIR)/slsh.o $(OBJDIR)/readline.o - $(CC) $(CFLAGS) $(OBJDIR)/slsh.o $(OBJDIR)/readline.o -o $(OBJDIR)/slsh $(LDFLAGS) $(DLINK_FLAGS) $(INST_LIBS) + $(CC) $(OBJDIR)/slsh.o $(OBJDIR)/readline.o -o $(OBJDIR)/slsh $(LDFLAGS) $(DLINK_FLAGS) $(INST_LIBS) $(OBJDIR)/slsh.o: $(OBJDIR_TSTAMP) slsh.c slsh.h config.h Makefile cd $(OBJDIR) && $(CC) $(SLANG_SRCINC) $(CFLAGS) -c $(DEFS) $(SRCDIR)/slsh.c $(OBJDIR)/readline.o: $(OBJDIR_TSTAMP) readline.c slsh.h config.h Makefile @@ -103,7 +103,7 @@ # static: $(SOBJDIR)/slsh $(SOBJDIR)/slsh: $(SOBJDIR)/slsh.o $(SOBJDIR)/readline.o - $(CC) $(CFLAGS) $(SOBJDIR)/slsh.o $(SOBJDIR)/readline.o -o $(SOBJDIR)/slsh $(LDFLAGS) $(STATIC_SRC_LIBS) + $(CC) $(SOBJDIR)/slsh.o $(SOBJDIR)/readline.o -o $(SOBJDIR)/slsh $(LDFLAGS) $(STATIC_SRC_LIBS) $(SOBJDIR)/slsh.o: $(SOBJDIR_TSTAMP) slsh.c slsh.h config.h Makefile cd $(SOBJDIR) && $(CC) $(SLANG_SRCINC) $(CFLAGS) -c $(SDEFS) $(SRCDIR)/slsh.c $(SOBJDIR)/readline.o: $(SOBJDIR_TSTAMP) readline.c slsh.h config.h Makefile @@ -124,7 +124,7 @@ $(MKINSDIR) $(DEST_SLSH_LOCALLIB_DIR) $(MKINSDIR) $(DEST_SLSH_SCRIPT_DIR) $(MKINSDIR) $(DEST_SLSH_DOC_DIR)/html -install_lib_files: +install_lib_files: install_directories @for X in lib/*.sl; \ do \ echo $(INSTALL_DATA) $$X $(DEST_SLSH_LIB_DIR); \ @@ -133,7 +133,7 @@ exit 1; \ fi; \ done -install_rline_files: +install_rline_files: install_directories @for X in lib/rline/*.sl lib/rline/slrline.rc; \ do \ echo $(INSTALL_DATA) $$X $(DEST_SLSH_LIB_DIR)/rline/; \ @@ -142,7 +142,7 @@ exit 1; \ fi; \ done -install_scripts: +install_scripts: install_directories @for X in $(SCRIPTS); \ do \ echo $(INSTALL) scripts/$$X $(DEST_SLSH_SCRIPT_DIR); \ @@ -151,7 +151,7 @@ exit 1; \ fi; \ done -install_help: +install_help: install_directories @for X in lib/help/*.hlp; \ do \ echo $(INSTALL_DATA) $$X $(DEST_SLSH_HELP_DIR); \ @@ -160,7 +160,7 @@ exit 1; \ fi; \ done -install_docs: +install_docs: install_directories @for X in doc/html/*.html; \ do \ echo $(INSTALL_DATA) $$X $(DEST_SLSH_DOC_DIR)/html/; \ @@ -171,11 +171,11 @@ done $(INSTALL_DATA) doc/man/slsh.1 $(DEST_MAN_DIR)/ # -install_slsh: +install_slsh: install_directories $(OBJDIR)/slsh $(INSTALL) $(OBJDIR)/slsh $(DEST_BIN_DIR)/ -install_static_slsh: +install_static_slsh: install_directories $(SOBJDIR)/slsh $(INSTALL) $(SOBJDIR)/slsh $(DEST_BIN_DIR)/ -install_slshrc: +install_slshrc: install_directories $(INSTALL_DATA) etc/slsh.rc $(DEST_SLSH_CONF_DIR)/ echo 'prepend_to_slang_load_path("$(SLSH_LOCALLIB_DIR)");' >> $(DEST_SLSH_CONF_DIR)/slsh.rc install_common: install_directories install_lib_files install_rline_files install_scripts install_help install_docs @@ -199,4 +199,3 @@ install_lib_files install_rline_files install_scripts install_help \ install_docs install-static static install_common \ install_slsh install_static_slsh install_slshrc -
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-1.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-1.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Introduction</TITLE> <LINK HREF="slshfun-2.html" REL=next>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-10.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-10.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Profiling Functions</TITLE> <LINK HREF="slshfun-11.html" REL=next> <LINK HREF="slshfun-9.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-11.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-11.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Set Functions</TITLE> <LINK HREF="slshfun-12.html" REL=next> <LINK HREF="slshfun-10.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-12.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-12.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Miscellaneous Functions</TITLE> <LINK HREF="slshfun-13.html" REL=next> <LINK HREF="slshfun-11.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-13.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-13.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): SLSH intrinsic functions</TITLE> <LINK HREF="slshfun-12.html" REL=previous> <LINK HREF="slshfun.html#toc13" REL=contents>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-2.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-2.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): The require Function</TITLE> <LINK HREF="slshfun-3.html" REL=next> <LINK HREF="slshfun-1.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-3.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-3.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Command Line Parsing Functions</TITLE> <LINK HREF="slshfun-4.html" REL=next> <LINK HREF="slshfun-2.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-4.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-4.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Filename Globbing and Related Functions</TITLE> <LINK HREF="slshfun-5.html" REL=next> <LINK HREF="slshfun-3.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-5.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-5.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Reading Text-formated Data Files</TITLE> <LINK HREF="slshfun-6.html" REL=next> <LINK HREF="slshfun-4.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-6.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-6.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Structure Functions</TITLE> <LINK HREF="slshfun-7.html" REL=next> <LINK HREF="slshfun-5.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-7.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-7.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Array Functions</TITLE> <LINK HREF="slshfun-8.html" REL=next> <LINK HREF="slshfun-6.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-8.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-8.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): List Functions and List-based Data Structures</TITLE> <LINK HREF="slshfun-9.html" REL=next> <LINK HREF="slshfun-7.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-9.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-9.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Subprocess Functions</TITLE> <LINK HREF="slshfun-10.html" REL=next> <LINK HREF="slshfun-8.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0)</TITLE> <LINK HREF="slshfun-1.html" REL=next>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/man/slsh.1 -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/man/slsh.1
Changed
@@ -3,7 +3,7 @@ .\" <http://shell.ipoline.com/~elmert/comp/docbook2X/> .\" Please send any bug reports, improvements, comments, patches, .\" etc. to Steve Cheng <steve@ggi-project.org>. -.TH "SLSH" "1" "04 March 2018" "" "" +.TH "SLSH" "1" "19 February 2021" "" "" .SH NAME slsh \- Interpreter for S-Lang scripts
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/tm/local.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/tm/local.tm
Changed
@@ -1,4 +1,5 @@ #d slang \bf{S-Lang} +#d most \bf{most} #d slang2 \bf{S-Lang 2} #d slrn \bf{slrn} #d sldb \bf{sldb}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/arrayfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/arrayfuns.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/cmdopt.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/cmdopt.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -170,6 +170,8 @@ { if (value != NULL) value = (@opt.convert_method) (opts, opt, name, value); + else + value = opt.default_value; (@opt.valuep)(value, __push_args(opt.callback_args)); return; @@ -233,25 +235,6 @@ return find_opt (opts, name); } -private define process_short_args (opts, letters) -{ - variable i = 0, n = strlen (letters); - while (i < n) - { - i++; - variable name = substr (letters, i, 1); - variable opt = find_short_opt (opts, name); - variable value = NULL; - if (opt.flags & CMDOPT_REQ_VALUE) - { - if (i < n) - value = substr (letters, i+1, n); - i = n; - } - process_option (opts, opt, name, NULL); - } -} - private define parse_arg (arg) { variable pos = is_substr (arg, "="); @@ -330,7 +313,7 @@ { i++; if (i == iend) - usage_error (opts, opt, "value expected"); + usage_error (opts, arg, "value expected"); value = argvi; }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/fswalk.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/fswalk.sl
Changed
@@ -1,31 +1,49 @@ % Functions to walk the file system -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for % more information. +private define get_stat (w, file) +{ + variable st = (@w.stat_func)(file); + if (st == NULL) + () = fprintf (stderr, "Unable to stat %s: %s\n", file, errno_string (errno)); + return st; +} + private define process_dir (w, dir, dir_st); private define process_dir (w, dir, dir_st) { - variable status; - if (w.dir_method != NULL) + variable status = 1; + + EXIT_BLOCK + { + if ((status != -1) && (w.leavedir_method != NULL)) + { + if (-1 == (@w.leavedir_method)(dir, dir_st, __push_list (w.leavedir_method_args))) + return -1; + } + return status; + } + + if (w.enterdir_method != NULL) { - status = (@w.dir_method) (dir, dir_st, __push_list (w.dir_method_args)); + status = (@w.enterdir_method) (dir, dir_st, __push_list (w.enterdir_method_args)); if (status <= 0) - return status; + return; } foreach (listdir (dir)) { variable file = (); file = path_concat (dir, file); - variable st = (@w.stat_func)(file); + + variable st = get_stat (w, file); if (st == NULL) - { - () = fprintf (stderr, "Unable to stat %s: %s\n", file, errno_string (errno)); - continue; - } + continue; + if (stat_is ("dir", st.st_mode)) { status = process_dir (w, file, dir_st); @@ -39,43 +57,50 @@ continue; status = (@w.file_method) (file, st, __push_list(w.file_method_args)); if (status <= 0) - return status; + return; } - return 1; + status = 1; } private define fswalk (w, start) { - variable st = (@w.stat_func)(start); - ifnot (stat_is ("dir", st.st_mode)) - { - throw InvalidParmError, "fs_walk: $start is not a directory"$; - } - () = process_dir (w, start, st); + variable st = get_stat (w, start); + if (st == NULL) return; + + if (stat_is ("dir", st.st_mode)) + () = process_dir (w, start, st); + else if (w.file_method_args != NULL) + () = (@w.file_method) (start, st, __push_list(w.file_method_args)); } define fswalk_new () { - if (_NARGS != 2) - usage ("\ -w = fswalk_new (dirfunc, filefunc ; qualifiers);\n\ + ifnot (2 <= _NARGS <= 3) + usage ("\n\ +w = fswalk_new (enterdir_func, file_func , leavedir_func ; qualifiers);\n\ w.walk (topdir);\n\ \n\ Qualifiers:\n\ - dargs={args,...} Additional arguments to be passed to dirfunc\n\ - fargs={args,...} Additional arguments to be passed to dirfunc\n\ - followlinks=0|1 Indicates whethe or not symbolic links will be followed\n\ + dargs={args,...} Additional arguments to be passed to enterdir_func\n\ + fargs={args,...} Additional arguments to be passed to file_func\n\ + largs={args,...} Additional arguments to be passed to leavedir_func\n\ + followlinks=0|1 Indicates whether or not symbolic links will be followed\n\ "); - variable dir_method, file_method; - (dir_method, file_method) = (); + variable enterdir_method, leavedir_method = NULL, file_method; + if (_NARGS == 3) leavedir_method = (); + (enterdir_method, file_method) = (); - variable dir_method_args = qualifier ("dargs", {}); + variable enterdir_method_args = qualifier ("dargs", {}); variable file_method_args = qualifier ("fargs", {}); - if (typeof (dir_method_args) != List_Type) - dir_method_args = {dir_method_args}; + variable leavedir_method_args = qualifier ("largs", {}); + + if (typeof (enterdir_method_args) != List_Type) + enterdir_method_args = {enterdir_method_args}; if (typeof (file_method_args) != List_Type) file_method_args = {file_method_args}; + if (typeof (leavedir_method_args) != List_Type) + leavedir_method_args = {leavedir_method_args}; variable followlinks = (qualifier_exists ("followlinks") && (0 != qualifier ("followlinks"))); @@ -84,8 +109,10 @@ walk = &fswalk, file_method = file_method, file_method_args = file_method_args, - dir_method = dir_method, - dir_method_args = dir_method_args, + enterdir_method = enterdir_method, + enterdir_method_args = enterdir_method_args, + leavedir_method = leavedir_method, + leavedir_method_args = leavedir_method_args, stat_func = (followlinks ? &stat_file : &lstat_file), }; return w;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/glob.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/glob.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/help/fswalk.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/help/fswalk.hlp
Changed
@@ -4,36 +4,45 @@ Create an object to walk the filesystem tree USAGE - obj = fswalk_new (Ref_Type dirfunc, Ref_Type filefunc; qualifiers) + obj = fswalk_new (Ref_Type enterdir_func, Ref_Type file_func, Ref_Type leavedir_func; qualifiers) DESCRIPTION The `fswalk_new' function creates an object that is useful - for exploring a filesystem tree. It requires two arguments that + for exploring a filesystem tree. It requires at least two arguments that are references to functions to be called when a directory or file is - encountered. Each of these functions is passed at least two + encountered. The third argument (`leavedir_func') is optional. + Each of these functions is passed at least two arguments: the name of the file or directory (including leading path elements relative to the directory where processing started), and - the stat structure of the of the file or directory. Qualifiers may + the stat structure of the file or directory. Qualifiers may be used to specify additional arguments. The object's `walk' method is the one that actually walks the filesystem. - The directory callback function must return an integer value that + The `enterdir_func' callback function is called when a + directory is encountered. It must return an integer value that indicates how it should be processed. If the function returns 0, then the directory will be skipped (pruned). A positive value indicates that the directory will processed. If the function returns a negative value, then no further processing by the walk - function will take place and control will pass to the user. + function will take place and control will pass back to the caller. The + value of this function may be NULL. - The file callback function must also return an integer that + The `file_func' callback function must return an integer that indicates how processing should continue. If it returns a positive value, then additional files in the corresponding directory will be processed. If it returns 0, then no further files or subdirectories of the directory will be processed, and processing will continue to take place in the parent directory. Otherwise, the return value is negative, which indicates that processing should be stopped and - control will pass back to the caller. + control will pass back to the caller. The value of this function + may be NULL. + + If the `leavedir_func' has been specified and is non-NULL, then + it will be called after the directory has been processed. It must + return an integer. A return value of -1 is used to indicate that an + error has occurred, and that further processing should stop. QUALIFIERS The following qualifiers are supported: @@ -41,12 +50,17 @@ dargs={args...} `dargs' is a list of additional arguments that will be added when - calling the directory callback function. + calling the `enterdir_func' callback. fargs={args...} `fargs' is a list of additional arguments that will be added when - calling the file callback function. + calling the `file_func' callback function. + + largs={args...} + + `largs' is a list of additional arguments that will be added when + calling the `leavedir_func' callback. followlinks=val
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/help/process.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/help/process.hlp
Changed
@@ -105,6 +105,35 @@ If this qualifier exists, its value will be passed as the second argument to the `pre_exec_hook' callback function. + exec_hook=&func + + This qualifier may be used to specify the function that actually + executes the child process. It is expected to take 2 arguments: + the `argv' array and the value of the `exec_hook_arg' + qualifier. The function should invoke the `execvp' system + and return its value. Only in very special cases, such as testing + the process code itself, should this hook be needed. + + exec_hook_arg=VAL + + The value of this qualifier will be passed to the `exec_hook' + callback function. + + exit_hook=&func + + This qualifier may be used to specify the function to be called + just before the child process exits in the case of a failure. + executes the child process. The function will be passed 2 + arguments: the `argv' array and the value of the + `exit_hook_arg' qualifier. The function should not return a + value. Only in very special cases, such as testing the process + code itself, should this hook be needed. + + exit_hook_arg=VAL + + The value of this qualifier will be passed to the `exit_hook' + callback function. + Note that the read and write qualifiers specify the nature of the file descriptors from the child process's view. That is, those opened in the child process using the read qualifier, may be written
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/help/timestamp.hlp
Added
@@ -0,0 +1,33 @@ +timestamp_parse + + SYNOPSIS + Parse a timestamps to Unix time + + USAGE + Long_Type timestamp_parse (String_Type timestamp) + + DESCRIPTION + The `timestamp_parse' function parses the string representation + of a timestamp and returns it expessed as the number of seconds + since the Unix Epoch. + + The `timestamp' string is assumed to conform to one of the + following standards: RFCs 822, 1036, 1123, 2822, 3339, and ISO-8601. + Examples include: + + "2020-05-02T17:09:58+00:00" + "Sunday, 02-May-20 17:09:58 UTC" + "Sun, 2 May 2020 17:09:58 +0000" + "5/2/2020, 5:31:57 PM EDT" + "2020-02-14T170958+0000" + "5/02/2020, 5:31:57 PM", + + If a timezone specifier is missing, the local timezone will be + assumed. + + Upon success, the functions returns the number of seconds since + 1970-01-01T00:00:00 UTC. If the format of the timestamp is not + recognized as the function, NULL will be returned. + + SEE ALSO + _time, ctime, strftime, gmtime, timegm, mktime
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/listfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/listfuns.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/print.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/print.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -75,10 +75,10 @@ # ifexists SIGPIPE signal (SIGPIPE, SIG_IGN, &Sigpipe_Handler); # endif - variable fp = popen (cmd, "w"); - try { + variable fp = popen (cmd, "w"); + if (fp == NULL) throw OpenError, "Unable to open the pager ($cmd)"$; @@ -340,16 +340,16 @@ { case Array_Type: variable dims = array_shape (x); - use_pager = ((dims0 > pager_rows) - || (prod(dims) > 10*pager_rows)); + use_pager = ((dims0 >= pager_rows) + || (prod(dims) >= 10*pager_rows)); } { case List_Type: - use_pager = length (x) > pager_rows; + use_pager = length (x) >= pager_rows; } { case String_Type: - use_pager = count_byte_occurrences (x, '\n') > pager_rows; + use_pager = count_byte_occurrences (x, '\n') >= pager_rows; if (noescape) str_x = x; } @@ -359,7 +359,7 @@ else str_x = generic_to_string (x); - use_pager = (count_byte_occurrences (str_x, '\n') > pager_rows); + use_pager = (count_byte_occurrences (str_x, '\n') >= pager_rows); } }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/process.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/process.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -56,6 +56,9 @@ { variable name = (); variable fd, ifd, value, defflags = 0, flags, file; + + value = get_struct_field (q, name); + if (1 != sscanf (name, "fd%d", &ifd)) { if (name == "stdin") ifd = 0; @@ -66,7 +69,6 @@ if (ifd == 0) defflags = O_RDONLY|O_NOCTTY; if ((ifd == 1) || (ifd == 2)) defflags = O_WRONLY|O_TRUNC|O_CREAT|O_NOCTTY; - value = get_struct_field (q, name); if (typeof(value) == String_Type) { (flags, file) = parse_redir (value); @@ -106,7 +108,7 @@ return (redir_fds, redir_ifds); } -% parse dipN=M qualifiers +% parse dupN=M qualifiers private define parse_dup_qualifiers (q) { variable open_fds = FD_Type0, wanted_ifds = Int_Type0; @@ -146,23 +148,44 @@ private define dup2_open_fds (wanted_ifds, open_ifds, open_fds, idx_offset) { variable i, ifd, fd; + _for i (0, length(wanted_ifds)-1, 1) { ifd = wanted_ifdsi; i += idx_offset; variable j = wherefirst (open_ifds == ifd); + + if (j == i) continue; + if (j == 0) + { + % This is the file descriptior that we want to use for + % messages + % Dup it to something else. + fd = dup_fd (open_fds0); + if (fd == NULL) + throw OSError, "dup_fd failed: " + errno_string (); + () = fcntl_setfd (fd, fcntl_getfd (fd) | FD_CLOEXEC); + + open_fds0 = fd; + open_ifds0 = _fileno(fd); + j = wherefirst (open_ifds == ifd); + } + if (j != NULL) { - if (j == i) - continue; + % Here, ifd is already associated with an open + % descriptor. Dup that descriptor to something else so + % that ifd can be used. fd = dup_fd (open_fdsj); if (fd == NULL) throw OSError, "dup_fd failed: " + errno_string (); open_ifdsj = _fileno(fd); open_fdsj = fd; + % drop } + % Replace open_ifdsi with the desired descriptor if (-1 == dup2_fd (open_fdsi, ifd)) throw OSError, "dup2_fd failed: " + errno_string (); @@ -178,7 +201,7 @@ % The child pipe ends will need to be dup2'd to the corresponding % integers. Care must be exercised to not stomp on pipe descriptors % that have the same values. - % Note: The first on in the list is the traceback fd + % Note: The first one in the list is the traceback fd variable child_open_ifds = array_map (Int_Type, &_fileno, child_fds); dup2_open_fds (required_child_ifds, child_open_ifds, child_fds, 1); @@ -192,6 +215,7 @@ child_fds = child_fds, redir_fds; child_open_ifds = child_open_ifds, array_map (Int_Type, &_fileno, redir_fds); + redir_fds = NULL; % decrement ref-counts dup2_open_fds (wanted_redir_ifds, child_open_ifds, child_fds, ofs); @@ -209,6 +233,7 @@ % descriptors that correspond to the ifdNs child_fds = child_fds, fdMs, fdMs; child_open_ifds = child_open_ifds, ifdMs, Int_Typenum_aliased-1; + dup2_open_fds (ifdNs, child_open_ifds, child_fds, length(child_fds)-num_aliased); } } @@ -229,7 +254,7 @@ child_open_ifds = list_to_array (list); } - variable close_mask = Char_TypeOPEN_MAX+1; + variable close_mask = Char_TypeOPEN_MAX; close_mask 3: = 1; foreach ifd (child_open_ifds) close_maskifd = 0; _for ifd (0, length(close_mask)-1, 1) @@ -237,7 +262,12 @@ if (close_maskifd) () = _close (ifd); } - () = execvp (argv0, argv); + variable exec_hook = qualifier("exec_hook"); + if (exec_hook == NULL) + () = execvp (argv0, argv); + else + () = (@exec_hook)(argv, qualifier ("exec_hook_arg")); + throw OSError, "exec failed: " + argv0 + " : " + errno_string (); } @@ -335,6 +365,9 @@ () = write (fd, sprintf ("Traceback:\n%S\n", e.traceback)); fd = NULL; } + variable exit_hook = qualifier("exit_hook"); + variable exit_hook_arg = qualifier ("exit_hook_arg"); + if (exit_hook != NULL) (@exit_hook)(argv, exit_hook_arg); _exit (1); } variable other_struct_fields = "pid", "wait";
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/profile.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/profile.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/readascii.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/readascii.sl
Changed
@@ -1,5 +1,5 @@ % Simple ascii file reader -% Copyright (C) 2007-2017,2018 John E. Davis +% Copyright (C) 2007-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/setfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/setfuns.sl
Changed
@@ -1,5 +1,5 @@ % Functions that operate on sets in the form of arrays and lists: -% Copyright (C) 2010-2017,2018 John E. Davis +% Copyright (C) 2010-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -93,8 +93,8 @@ variable has_list = 0; loop (_NARGS) { - has_list += (typeof (obj) == List_Type); obj = pop_set_object (); + has_list += (typeof (obj) == List_Type); list_insert (args, obj); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/sldb.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/sldb.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/sldbcore.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/sldbcore.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -21,7 +21,8 @@ % it may be limited due to the lack of line number information. % % -require ("print"); +%require ("print"); +()=evalfile("print"); private variable Debugger_Methods = struct {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/sldbsock.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/sldbsock.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/stkcheck.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/stkcheck.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/structfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/structfuns.sl
Changed
@@ -1,5 +1,5 @@ % Struct functions -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/runtests.sh -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/runtests.sh
Changed
@@ -9,17 +9,36 @@ export DYLD_LIBRARY_PATH="$ROOT/src/${ARCH}elfobjs" run_test_pgm="$SLSHROOT/${ARCH}objs/slsh_exe -n -g" -#run_test_pgm="$SLSHROOT/${ARCH}objs/slsh_exe -n -g $SLSHROOT/scripts/sldb" runprefix="$SLTEST_RUN_PREFIX" -#runprefix="valgrind --tool=memcheck --leak-check=yes --error-limit=no --num-callers=25" -#runprefix="gdb --args" +use_slcov=0 +while "$#" -ge 1 +do + case "$1" in + "--slcov" ) runsuffix="$SLSHROOT/scripts/slcov"; shift + rm test_*.slcov* + use_slcov=1 + ;; + "--sldb" ) runsuffix="$SLSHROOT/scripts/sldb"; shift + ;; + "--gdb" ) runprefix="gdb --args"; shift + ;; + "--memcheck" ) runprefix="valgrind --tool=memcheck --leak-check=yes --error-limit=no --num-callers=25" + shift + ;; + "--strace" ) runprefix="strace -f -o strace.log" + shift + ;; + * ) break + ;; + esac +done ######################################################################## if $# -eq 0 then - echo "Usage: $0 test1.sl test2.sl ..." + echo "Usage: $0 --gdb|--sldb|--slcov|--memcheck test1.sl test2.sl ..." exit 64 fi @@ -29,9 +48,10 @@ n_failed=0 tests_failed="" + for testxxx in $@ do - $runprefix $run_test_pgm $testxxx + $runprefix $run_test_pgm $runsuffix $testxxx if $? -ne 0 then @@ -44,6 +64,15 @@ if $n_failed -eq 0 then echo "All tests passed." + if $use_slcov -eq 1 + then + lcov_merge_args="" + for X in test_*.slcov* + do + lcov_merge_args="$lcov_merge_args -a $X" + done + lcov $lcov_merge_args -o "slshlib.slcov" + fi else echo "$n_failed tests failed: $tests_failed" fi
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_arrayfuns.sl
Added
@@ -0,0 +1,39 @@ +() = evalfile ("./common.sl"); + +require ("arrayfuns"); + +define slsh_main () +{ + start_test ("arrayfuns"); + + variable a = 1:10, b; + + b = reverse (a); + ifnot (_eqs(b, 10:1:-1)) + failed ("reverse"); + + b = shift (a, 1); + ifnot (_eqs (b, 2:10, 1)) + failed ("shift 1"); + b = shift (a, -1); + ifnot (_eqs (b, 10, 1:9)) + failed ("shift -1"); + + variable i = 8, 9, 2, 1, 0, 7, 5, 6, 4, 3, i1; + b = @a; + i1 = @i; + rearrange (b, i); + ifnot (_eqs (i, i1)) + failed ("rearrange modified the indices"); + ifnot (_eqs (b, ai)) + failed ("rearrange"); + i3 = i7; + try + { + rearrange (b, i); + failed ("Expected rearrange to fail on a bad permutation"); + } + catch AnyError; + + end_test (); +}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_cmdopt.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_cmdopt.sl
Changed
@@ -66,6 +66,11 @@ @ref += 1; } +private define callback_opt2 (value, a, b, ref) +{ + @ref = value + a + b; +} + private define test_cmdopt () { variable opts = cmdopt_new (NULL); @@ -132,6 +137,20 @@ opts.add ("f", &s.flags; bor=1, band=~0x2); args = "-a", "-f", "--b4000"; test_args (opts, args, 3, s, {0x8000|0x4000|1, 0x4|0x1}, 0); + + s = struct {v = NULL}; + opts = cmdopt_new (NULL); + opts.add ("f|foo", &callback_opt2, 1, 2, &s.v; type="int", optional=17); + + args = "-f"; + test_args (opts, args, 1, s, {1+2+17}, 0); + + args = "--foo=12"; + test_args (opts, args, 1, s, {1+2+12}, 0); + + args = "--bar=12"; + test_args (opts, args, 1, s, {-1}, 1); + } define slsh_main ()
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_glob.sl
Added
@@ -0,0 +1,55 @@ +() = evalfile ("./common.sl"); + +require ("glob"); +require ("setfuns"); + +define slsh_main () +{ + start_test ("glob"); + + variable files, files1, files2; + + files = glob (__FILE__, "foo.xxyu.zz"); + if ((length (files) != 1) + || (path_basename (files0) != path_basename (__FILE__))) + { + failed ("glob __FILE__"); + } + + files = glob ("*.sl"); + files1 = listdir ("."); + files1 = files1where (".sl" == array_map (String_Type, &path_extname, files1)); + files = filesarray_sort (files); + files1 = files1array_sort (files1); + + ifnot (_eqs (files, files1)) + { + failed ("glob 1"); + } + + variable dir = getcwd (); + % The getcwd function returns the CWD with a trailing slash. + % That is not wanted here. + if (strbytelen(dir) > 1) dir = dir:-2; + files1 = glob (path_concat (dir + "*", "*.sl")); + + % A an equivalent variant + dir = glob (dir + "*/"); % returns an array, so use array_map below + files2 = glob (array_map (String_Type, &path_concat, dir, "*.sl")); + + if ((length (files1) != length (files2)) + || length (complement (files1, files2))) + { + failed ("glob file1 vs files2"); + } + + % There may be more than one directory matching dir*. So just + % look for a subset of matching files, i.e., files \in files1 + files1 = array_map (String_Type, &path_basename, files1); + if (length (complement (files, files1)) != 0) + { + failed ("glob 2: some files were not found in files1"); + } + + end_test(); +}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_listfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_listfuns.sl
Changed
@@ -3,6 +3,13 @@ require ("rand"); require ("listfuns"); +private define cmp_func (a, b) +{ + if (a > b) return 1; + if (a < b) return -1; + return 0; +} + define test_heap (n, dir) { variable rnums = rand_uniform (n); @@ -20,7 +27,10 @@ list = {}; while (h.length ()) { - list_append (list, h.remove()); + variable obj = h.peek (); + if (obj != h.remove ()) + failed ("h.peek"); + list_append (list, obj); } rearrange (rnums, array_sort (rnums; dir=dir)); @@ -29,11 +39,26 @@ if (length (rnums) && any (rnums != list_to_array (list))) failed ("heap sorted list does not match sorted array"); + + % shuffle the list, then sort the list using a custom sort function + list = listrand_permutation (length(list)); + i = list_sort (list; dir=dir, cmp=&cmp_func); + list = listi; + if (length (rnums) && any (rnums != list_to_array (list))) + failed ("sorted list using a custom sort function"); } define slsh_main () { start_test ("listfuns"); + + try + { + heap_new (); + failed ("heap_new usage"); + } + catch UsageError; + srand (0); variable i; _for i (0, 33, 1)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_print.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_print.sl
Changed
@@ -2,18 +2,21 @@ require ("print"); -private define test_print () +private define test_print (x) { - variable x = 1:20:0.1; - variable ref_x, file_x, fp_x; + variable ref_x, file_x, fp_x, pager_x; + + % Wrie to a reference print (x, &ref_x); + % Write to a named file variable file = sprintf ("/tmp/test_print_%X_%d", _time(), getpid()); print (x, file); variable fp = fopen (file, "r"); () = fread_bytes (&file_x, 2*strlen (ref_x), fp); () = fclose (fp); + % Write to a file pointer fp = fopen (file, "wb"); print (x, fp); () = fclose (fp); @@ -21,8 +24,14 @@ () = fread_bytes (&fp_x, 2*strlen (ref_x), fp); () = fclose (fp); + % write to a pager + print (x; pager="cat > $file"$); + fp = fopen (file, "r"); + () = fread_bytes (&pager_x, 2*strlen (ref_x), fp); + () = fclose (fp); + () = remove (file); - if ((ref_x != file_x) || (ref_x != fp_x)) + if ((ref_x != file_x) || (ref_x != fp_x) || (pager_x != file_x)) { failed ("Failed: print failed to produce identical results\n"); } @@ -31,7 +40,39 @@ define slsh_main () { start_test ("print"); - test_print (); + % The test_print function cannot be used to print strings + % since the print function treats strings differently depending + % upon the device. + test_print (1:20:0.1); + test_print (_reshape (1:20, 2,10)); + test_print (_reshape (1:20, 2,5,2)); + test_print (struct {x = {}, y = 1:3, }); + test_print (struct {x = {}, y = 1:3, }); + test_print ({struct {x = {}, y = 1:3, }}); + test_print (Int_Type); + + % For the use of a pager + print_set_pager ("cat > /dev/null"); + print_set_pager_lines (0); + + print ("1\n\2\n\3\n"); + print ("1\n\2\0\n\3\n"); + print (struct {x = {1}, y = 1:3, }); + print (struct {x = {2}, y = 1:3, }); + print ({struct {x = {3}, y = 1:3, z = "\0"B}}); + + print_set_pager_lines (NULL); + print (array_map (String_Type, &sprintf, "%d\n", 1:1000)); + + + % Force an exception + try + { + print ("x"; pager='x'); + failed ("Expected an invalid pager to produce an exception"); + } + catch AnyError; + end_test (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_process.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_process.sl
Changed
@@ -2,21 +2,56 @@ require ("process"); -private define pre_exec_hook (fdlist, optarg) +private define pre_exec_hook2 (fdlist, optarg) { putenv ("TEST_OPTARG=$optarg"); } +private define pre_exec_hook1(fdlist) +{ + return pre_exec_hook2 (fdlist, "unused"); +} + +#ifexists slcov_write_report +private variable Start_Dir = getcwd (); +private define exit_hook (argv, cd) +{ + variable file = path_concat (Start_Dir, sprintf ("%s-%d", cd, getpid())); + slcov_write_report (fopen (file, "w"), 1); +} +private define exec_hook (argv, cd) +{ + variable file = path_concat (Start_Dir, sprintf ("%s-%d", cd, getpid())); + slcov_write_report (fopen (file, "w"), 1); + return execvp (argv0, argv); +} + +#endif + private define test_process () { % This is a silly example. echo write to fd=12, which has stdout % dup'd to it. wc reads from echo via fd=16, which has stdin dup'd % to it. variable echo = new_process ("echo", "foo bar"; write=12, dup1=12, - pre_exec_hook=&pre_exec_hook, + read={4,5,6,7}, + stdin="</dev/null", + stdout=1, +#ifexists slcov_write_report + exec_hook = &exec_hook, + exec_hook_arg = "test_process.slcov", +#endif + pre_exec_hook=&pre_exec_hook2, pre_exec_hook_optarg="FOOBAR"); - variable wc = new_process ("wc"; write=10, dup1=10, fd16=echo.fd12, dup0=16); + variable wc = new_process ("wc"; write=10, dup1=10, fd16=echo.fd12, dup0=16, + read=3:9, + pre_exec_hook=&pre_exec_hook1, +#ifexists slcov_write_report + exec_hook = &exec_hook, + exec_hook_arg = "test_process.slcov", +#endif + ); variable line; if (-1 == fgets (&line, wc.fp10)) @@ -32,6 +67,32 @@ status = wc.wait (); if (status == NULL) failed ("wait method failed for echo"); + + % Force an exception + try + { + echo = new_process ("echo", "foo bar"; + stdout="/", +#ifexists slcov_write_report + exit_hook = &exit_hook, + exit_hook_arg = "test_process.slcov", +#endif + ); + failed ("failed to force an exception"); + } + catch OSError; + + variable p = new_process ("pwd"; dir="/", write=1, +#ifexists slcov_write_report + exec_hook = &exec_hook, + exec_hook_arg = "test_process.slcov", +#endif + ); + if (-1 == fgets (&line, p.fp1)) + failed ("Failed to read from pwd process: " + errno_string ()); + if ("/" != strtrim(line)) + failed ("Failed dir qualifier"); + p.wait (0); } define slsh_main ()
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_readascii.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_readascii.sl
Changed
@@ -17,6 +17,22 @@ return array_map (String_Type, &sprintf, fmt, x, y, z); } +private define make_lines_file (x, y, z, delim) +{ + variable lines = make_lines_array (x, y, z, delim); + variable file = sprintf ("/tmp/test_readascii_%X_%d", _time(), getpid()); + variable fp = fopen (file, "w"); + if (fp == NULL) + throw OpenError, "Unable to open $file"$; + () = fputslines (lines, fp); + () = fclose (fp); + + variable data; + () = readascii (file, &data; ncols=3, delim=delim, size=11, dsize=7); + () = remove (file); + return make_lines_array (data0, data1, data2, delim); +} + private define make_lines_list (x, y, z, delim) { variable list = {}; @@ -140,5 +156,6 @@ start_test ("readascii"); run_test (&make_lines_array); run_test (&make_lines_list); + run_test (&make_lines_file); end_test (); }
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_require.sl
Added
@@ -0,0 +1,20 @@ +() = evalfile ("./common.sl"); + +require ("./common.sl", "r"); +require ("common", "s", "./common.sl"); + +define slsh_main () +{ + try + { + r->start_test ("require"); + s->end_test (); + exit (0); + } + catch AnyError: + { + failed ("require"); + } + end_test (); +} +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_setfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_setfuns.sl
Changed
@@ -20,48 +20,71 @@ private define test_setfuns () { -test_func (&unique1, {1,2,2,3,5,-1}, 1,2,3,5,-1); -test_func (&unique1, {1}, 1); -test_func (&unique1, {1,1}, 1); -test_func (&unique1, {0:-1}, Int_Type0); -test_func (&unique1, {{1,2,2,3,5,-1}}, {1,2,3,5,-1}); -test_func (&unique1, {{1}}, {1}); -test_func (&unique1, {{1,1}}, {1}); -test_func (&unique1, {{}}, {}); + test_func (&unique1, {1,2,2,3,5,-1}, 1,2,3,5,-1); + test_func (&unique1, {1}, 1); + test_func (&unique1, {1,1}, 1); + test_func (&unique1, {0:-1}, Int_Type0); + test_func (&unique1, {{1,2,2,3,5,-1}}, {1,2,3,5,-1}); + test_func (&unique1, {{1}}, {1}); + test_func (&unique1, {{1,1}}, {1}); + test_func (&unique1, {{}}, {}); -test_func (&intersection, {1:5, 3:7}, 2:4); -test_func (&intersection, {1:5, 5:7}, 4); -test_func (&intersection, {1:5, 0:1}, 0); -test_func (&intersection, {1:5, 5}, 4); -test_func (&intersection, {1:5, 6}, Int_Type0); + test_func (&intersection, {1:5, 3:7}, 2:4); + test_func (&intersection, {1:5, 5:7}, 4); + test_func (&intersection, {1:5, 0:1}, 0); + test_func (&intersection, {1:5, 5}, 4); + test_func (&intersection, {1:5, 6}, Int_Type0); -test_func (&intersection, {{1,2,3,4,5}, 3:7}, 2:4); -test_func (&intersection, {{1,2,3,4,5}, 5:7}, 4); -test_func (&intersection, {{1,2,3,4,5}, 0:1}, 0); -test_func (&intersection, {{1,2,3,4,5}, 5}, 4); -test_func (&intersection, {{1,2,3,4,5}, 6}, Int_Type0); + test_func (&intersection, {{1,2,3,4,5}, 3:7}, 2:4); + test_func (&intersection, {{1,2,3,4,5}, 5:7}, 4); + test_func (&intersection, {{1,2,3,4,5}, 0:1}, 0); + test_func (&intersection, {{1,2,3,4,5}, 5}, 4); + test_func (&intersection, {{1,2,3,4,5}, 6}, Int_Type0); -test_func (&intersection, {{"foo", 2i, 3i}, {"foo", 3i}}, 0,2); -test_func (&intersection, {{1, "foo", 2i, 3i}, {"foo", 3i}}, 1,3); -test_func (&intersection, {{}, {"foo", 3i}}, Int_Type0); -test_func (&intersection, {{"foo", 3i},{}}, Int_Type0); -test_func (&intersection, {{"foo","foo"}, {"foo"}}, 0,1); -test_func (&intersection, {{"foo"}, {"foo","bar"}}, 0); +#ifexists Complex_Type + test_func (&intersection, {{"foo", 2i, 3i}, {"foo", 3i}}, 0,2); + test_func (&intersection, {{1, "foo", 2i, 3i}, {"foo", 3i}}, 1,3); + test_func (&intersection, {{}, {"foo", 3i}}, Int_Type0); + test_func (&intersection, {{"foo", 3i},{}}, Int_Type0); +#endif + test_func (&intersection, {{"foo","foo"}, {"foo"}}, 0,1); + test_func (&intersection, {{"foo"}, {"foo","bar"}}, 0); -test_func (&complement, {{1,2,3,4,5}, 3:7}, 0,1); -test_func (&complement, {{1,2,3,4,5}, 5:7}, 0:3); -test_func (&complement, {{1,2,3,4,5}, 0:1}, 1:4); -test_func (&complement, {{1,2,3,4,5}, 5}, 0:3); -test_func (&complement, {{1,2,3,4,5}, 6}, 0:4); -test_func (&complement, {{"foo", 2i, 3i}, {"foo", 3i}}, 1); -test_func (&complement, {{1, "foo", 2i, 3i}, {"foo", 3i}}, 0,2); -test_func (&complement, {{}, {"foo", 3i}}, Int_Type0); -test_func (&complement, {{"foo", 3i}, {}}, 0,1); -test_func (&complement, {{"foo","foo"}, {"foo"}}, Int_Type0); + test_func (&complement, {{1,2,3,4,5}, 3:7}, 0,1); + test_func (&complement, {{1,2,3,4,5}, 5:7}, 0:3); + test_func (&complement, {{1,2,3,4,5}, 0:1}, 1:4); + test_func (&complement, {{1,2,3,4,5}, 5}, 0:3); + test_func (&complement, {{1,2,3,4,5}, 6}, 0:4); +#ifexists Complex_Type + test_func (&complement, {{"foo", 2i, 3i}, {"foo", 3i}}, 1); + test_func (&complement, {{1, "foo", 2i, 3i}, {"foo", 3i}}, 0,2); + test_func (&complement, {{}, {"foo", 3i}}, Int_Type0); + test_func (&complement, {{"foo", 3i}, {}}, 0,1); +#endif + test_func (&complement, {{"foo","foo"}, {"foo"}}, Int_Type0); -test_func (&union, {{"foo", 1, 2}, {"bar", 1, 3}}, {"foo", 1, 2, "bar", 3}); -test_func (&union, {1:10, 3:5, 9:12}, 1:12); -test_func (&union, {1:10, 3:5, 2i}, 1:10, 2i); + test_func (&union, {{"foo", 1, 2}, {"bar", 1, 3}}, {"foo", 1, 2, "bar", 3}); + test_func (&union, {1:10, 3:5, 9:12}, 1:12); + test_func (&union, {1:3, {31}, 4, 5}, {1,2,3,4,5,31}); +#ifexists Complex_Type + test_func (&union, {1:10, 3:5, 2i}, 1:10, 2i); +#endif + + variable i = ismember (2, 1:10); + ifnot (_eqs (i, 1)) + failed ("is_member 1"); + + i = ismember (-1, 1:10); + ifnot (_eqs (i, 0)) + failed ("is_member 2"); + + i = ismember (1,2,3, 2); + ifnot (_eqs (i, 0,1,0)) + failed ("is_member 3"); + + i = ismember ({1,2,3}, 2,3,4); + ifnot (_eqs (i, 0,1,1)) + failed ("is_member 4"); } define slsh_main ()
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_structfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_structfuns.sl
Changed
@@ -2,17 +2,34 @@ require ("structfuns"); -private define test_structfuns () +private define test_struct_filter () { - variable s = struct + variable s, s1, i; + + s = struct + { + str = "foo", + a1 = "bar", "foo", + a2 = {1,2,3}, + }; + + i = 0; + s1 = struct_filter (s, i; copy); + if ((s1.str != s.str) + || (s1.a1 != "bar") + || not _eqs (s1.a2, s.a2)) + failed ("filtering with i=0"); + + s = struct { str = "foo", a1 = 1:3, a2 = _reshape (1:3*4*5, 3,4*5), a3 = _reshape (1:3*4*5, 3,4,5), }; - variable i = 1,2; - variable s1 = struct_filter (s, i; dim=0, copy); + + i = 1,2; + s1 = struct_filter (s, i; dim=0, copy); if ((s1.str != s.str) || not _eqs (s1.a1, s.a1i) || not _eqs (s1.a2, s.a2i,*) @@ -36,11 +53,46 @@ failed ("filtering on dim=1 failed"); } +private define test_struct_combine () +{ + variable s1 = struct + { + a = "s1_a", + b, + c = "s1_c", + }; + variable s2 = struct + { + x = "s2_x", + c = "s2_c", + y, + }; + + variable s1s2 = struct_combine (s1, s2); + variable s = struct + { + a = s1.a, + b = s1.b, + c = s2.c, + x = s2.x, + y = s2.y, + }; + + ifnot (_eqs (s, s1s2)) + failed ("struct_combine"); + + ifnot (struct_field_exists (s, "y")) + failed ("struct_field_exists y"); + if (struct_field_exists (s, "xxxx")) + failed ("struct_field_exists xxxx"); +} + define slsh_main () { start_test ("structfuns"); - test_structfuns (); + test_struct_filter (); + test_struct_combine (); end_test (); }
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_timestamp.sl
Added
@@ -0,0 +1,94 @@ +() = evalfile ("./common.sl"); + +require ("timestamp"); + +private define test_timestamp (t_expected, dates) +{ + variable bad = 0; + foreach (dates) + { + variable ts = (); + variable t = timestamp_parse (ts); + if (t != t_expected) + { + () = fprintf (stderr, "ERROR: %S --> %S, expected %S\n", ts, t, t_expected); + bad++; + } + } + return bad; +} + +define slsh_main () +{ + start_test ("timestamp"); + + variable t_expected, dates, bad = 0; + + t_expected = 1588455117; + dates = + { + "Tue, 2 May 2020 22.31.57 +0100", + "May 2 17:31:57 2020 EDT", + "2020-05-02T21:31:57Z", + "2020-05-02T21:31:57+00:00", + "2020-05-02T17:31:57-04:00", + "20200502T173157-0400", + "Tue, 02 May 2020 21:31:57 +0000", + "Tue, 2 May 2020 21:31:57 +0000", + "Tuesday, 02-May-20 21:31:57 UTC", + "Tuesday, 02-May-20 9:31:57PM UTC", + "Tuesday, 2-May-20 21:31:57 UTC", + "Tuesday, 2-May-2020 21:31:57 UTC", + "Tuesday, 2-May-2020, 21:31:57Z", + "2020-05-02T21:31:57+00:00", + "5/02/2020, 5:31:57 PM EDT", + "5/2/2020, 5:31:57 PM EDT", + "5/2/20, 5:31:57 PM EDT", + "Tue May 2 17:31:57 2020 EDT", + "May 2, 17:31:57, 2020 EDT", + }; + bad += test_timestamp (t_expected, dates); + + t_expected = 1591137060; + dates = + { + "June 2, 2020 5:31 PM EST", + "Jun 2, 2020 5:31 PM EST", + "Thu Jun 2, 2020 5:31 PM EST", + "Thursday, Jun 2, 2020 5:31 PM EST", + "Thursday, June 2, 2020 5:31 PM EST", + }; + bad += test_timestamp (t_expected, dates); + + t_expected = 1611445148; + dates = + { + "Sat, 23 Jan 2021 23:39:08 +0000 (UTC)", + }; + bad += test_timestamp (t_expected, dates); + + t_expected = 97027200; + dates = + { + "1973-01-28T00:00:00Z", + }; + bad += test_timestamp (t_expected, dates); + + t_expected = 1597014697; + dates = + { + "2020-08-09T23:11:37Z", + "Sun Aug 9 19:11:37 2020 EDT", + }; + bad += test_timestamp (t_expected, dates); + + % Test the current line without a timezone specified + variable now = _time(); + dates = strftime ("%b %d, %Y %H:%M:%S", localtime(now)); + bad += test_timestamp (now, dates); + + if (bad) failed ("%d timestamps failed to parse", bad); + + end_test (); +} +
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/timestamp.sl
Added
@@ -0,0 +1,207 @@ +% Copyright (C) 2020-2021, 2022 John E. Davis +% +% This file is part of the S-Lang Library and may be distributed under the +% terms of the GNU General Public License. See the file COPYING for +% more information. +%--------------------------------------------------------------------------- +% The code here attemps to convert a human readable representation of a +% timestamp, such as Wed May 13 02:38:34 2020 to a Unix time (number +% of secs since the Unix epoch) +% +% Public funtions: +% +% timestamp_parse: +% Parses a timestamp and Returns the number of seconds since +% the Unix EPOCH (1970-01-01T00:00:00Z) +% +private variable Months + = "jan", "feb", "mar", "apr", "may", "jun", + "jul", "aug", "sep", "oct", "nov", "dec"; + +% There is an extensive list of timezone abbreviations at +% <https://www.timeanddate.com/time/zones/>. The problem with +% abbreviations is that they are not unique. For example, CST +% could refer to Austrailia, North America, or China. +% The ones here are used by slrn. +private variable TZMap = Assoc_TypeInt_Type, 0; +TZMap"EDT" = -400; % US Eastern Daylight Time +TZMap"EST" = -500; % US Eastern Standard Time +TZMap"CDT" = -500; % US Central Daylight Time +TZMap"CST" = -600; % US Central +TZMap"MDT" = -600; % US Mountain Daylight Time +TZMap"MST" = -700; % US Mountain +TZMap"PDT" = -700; % US Pacific Daylight Time +TZMap"PST" = -800; % US Pacific +TZMap"GMT" = 0; +TZMap"UTC" = 0; +TZMap"Z" = 0; +TZMap"CET" = 100; % Central European +TZMap"MET" = 100; % Middle European +TZMap"MEZ" = 100; % Middle European +TZMap"EET" = 200; % Eastern European +TZMap"MSK" = 300; % Moscow +TZMap"HKT" = 800; % Hong Kong +TZMap"JST" = 900; % Japan Standard +TZMap"KST" = 900; % Korean Standard +TZMap"CAST" = 930; % Central Autsralian +TZMap"EAST" = 1000; % Eastern Autsralian +TZMap"NZST" = 1200; % New Zealand Autsralian + +private define map_tzstr_string (tzstr) +{ + return TZMapstrtrim (strup(tzstr)); +} + +private variable Cumulative_Days_Per_Month = + int (cumsum (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)); + +private variable TS_Formats = {}; +private define add_ts_format (re, indices, month_is_int) +{ + variable s = struct + { + re = re, + month_is_int = month_is_int, + indices = indices, + }; + + list_append (TS_Formats, s); +} +% Tue 12 May 2020 04:37:54 PM EDT +add_ts_format (`^a-zA-Z,*` % weekday + + ` *\(\d\d?\) -\(a-zA-Z+\) -\(\d\d\d*\),?` % day month year + + ` *\(\d\d?\):.\(\d\d\):.?\(\d*\)` % hh:mm:ss + + ` *\(.*\)`, % AM/PM + tz + 1,2,3,4,5,6,7, 0); + +% Sun, Dec 04, 1994 11:05:52 GMT +add_ts_format (`^a-zA-Z,+` + + ` +\(a-zA-Z\{3,\}\) \(\d+\),? *\(\d\d\d*\)`% month, day, year + + ` +\(\d\d?\):\(\d\d\):?\(\d*\)`% hh:mm:ss + + ` *\(.*\)`, % tz + 2,1,3,4,5,6,7, 0); + +% Dec 04, 1994 11:05:52 GMT +add_ts_format (`^\(a-zA-Z\{3,\}\) \(\d+\),? *\(\d\d\d*\)`% month, day, year + + ` +\(\d\d?\):\(\d\d\):?\(\d*\)`% hh:mm:ss + + ` *\(.*\)`, % tz + 2,1,3,4,5,6,7, 0); + +% 2020-09-12T21:17:30 <tz-offset> +add_ts_format (`^\(\d\d\d\d\)-?\(\d\d\)-?\(\d\d\)` + + `T\(\d\d\):?\(\d\d\):?\(\d\d\)` + + ` *\(.*\)`, + 3,2,1,4,5,6,7, 1); + +% 5/12/2020, 5:31:57 PM +add_ts_format (`\(\d\d?\)/\(\d\d?\)/\(\d\d\d*\),?` + + ` *\(\d\d?\):\(\d\d\):?\(\d*\)` + + ` *\(.*\)`, + 2,1,3,4,5,6,7, 1); + +% Dec 4 11:05:52 2020 +add_ts_format (`^\(a-zA-Z\{3,\}\) +\(\d+\),?` % month, day + + ` +\(\d\d?\):\(\d\d\):?\(\d*\),?`% hh:mm:ss + + ` +\(\d\d\d*\)` % year + + ` *\(.*\)`, % tz + 2,1,6,3,4,5,7, 0); + +% Tue Dec 4 11:05:52 2020 +add_ts_format (`^A-Za-z,+` + + ` +\(a-zA-Z\{3,\}\) +\(\d+\),?` % month, day + + ` +\(\d\d?\):\(\d\d\):?\(\d*\),?`% hh:mm:ss + + ` +\(\d\d\d*\)` % year + + ` *\(.*\)`, % tz + 2,1,6,3,4,5,7, 0); + +private variable Last_TS_Index = 0; +private define guess_local_timezone_offset () +{ + variable now = _time(), tm = gmtime(now); + tm.tm_isdst = -1; % Force a lookup to see if DST is in effect + variable secs = now - mktime (tm); + variable hours = secs/3600; + return 100*hours + (secs - 3600*hours)/60; +} + +define timestamp_parse (timestamp) +{ + timestamp = strtrim (timestamp); + variable day, month, year, hours, minutes, secs, tz, tzstr; + variable num = length (TS_Formats); + loop (num) + { + variable fmt = TS_FormatsLast_TS_Index; + + variable matches = string_matches (timestamp, fmt.re); + if (matches == NULL) + { + Last_TS_Index = (Last_TS_Index + 1) mod num; + continue; + } + variable ind = fmt.indices; + day = atoi (matchesind0); + month = matchesind1; + year = atoi (matchesind2); + hours = atoi (matchesind3); + minutes = atoi (matchesind4); + secs = atoi (matchesind5); + tzstr = matchesind6; + + if (fmt.month_is_int) + month = atoi (month) - 1; % 0 to 11 + else + { + if (strbytelen (month) > 3) month = month0,1,2; + month = wherefirst (Months == strlow(month)); + if (month == NULL) return NULL; + } + break; + } + then return NULL; + + if (year < 100) + { + % No century + year += 1900; + if (year < 1950) year += 100; + } + tzstr = strtrim (tzstr); + + % Take care of AM/PM + if (((tzstr0 == 'A') || (tzstr0 == 'P')) + && (tzstr1 == 'M') + && ((tzstr2 == 0) || (tzstr2 == ' '))) + { + if (tzstr0 == 'P') + hours += 12; + tzstr = strtrim (tzstr2:); + } + + tzstr = strreplace (tzstr, ":", ""); + if (tzstr == "") + tz = guess_local_timezone_offset (); + else + { + tz = atoi (tzstr); + if ((tz == 0) && (tzstr0 != '+') && (tzstr0 != '-')) + tz = map_tzstr_string (tzstr); + } + + day--; % offset from 0 + % Compute the cumulative number of days, accounting for a leap year + day += Cumulative_Days_Per_Monthmonth; + if ((month > 2) + && (0 == (year mod 4)) + && ((year mod 100) || (0 == (year mod 400)))) + day++; + + year -= 1970; % Unix EPOCH
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/tm/Makefile -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/tm/Makefile
Changed
@@ -7,7 +7,7 @@ HLP_FILES = arrayfuns.hlp glob.hlp require.hlp structfuns.hlp cmdopt.hlp \ readascii.hlp profile.hlp print.hlp process.hlp setfuns.hlp fswalk.hlp \ - listfuns.hlp + listfuns.hlp timestamp.hlp all: help-files help-files: $(HLP_FILES)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/tm/fswalk.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/tm/fswalk.tm
Changed
@@ -1,34 +1,43 @@ \function{fswalk_new} \synopsis{Create an object to walk the filesystem tree} -\usage{obj = fswalk_new (Ref_Type dirfunc, Ref_Type filefunc; qualifiers)} +\usage{obj = fswalk_new (Ref_Type enterdir_func, Ref_Type file_func, Ref_Type leavedir_func; qualifiers)} \description The \sfun{fswalk_new} function creates an object that is useful - for exploring a filesystem tree. It requires two arguments that + for exploring a filesystem tree. It requires at least two arguments that are references to functions to be called when a directory or file is - encountered. Each of these functions is passed at least two + encountered. The third argument (\exmp{leavedir_func}) is optional. + Each of these functions is passed at least two arguments: the name of the file or directory (including leading path elements relative to the directory where processing started), and - the stat structure of the of the file or directory. Qualifiers may + the stat structure of the file or directory. Qualifiers may be used to specify additional arguments. The object's \exmp{walk} method is the one that actually walks the filesystem. - The directory callback function must return an integer value that + The \exmp{enterdir_func} callback function is called when a + directory is encountered. It must return an integer value that indicates how it should be processed. If the function returns 0, then the directory will be skipped (pruned). A positive value indicates that the directory will processed. If the function returns a negative value, then no further processing by the walk - function will take place and control will pass to the user. + function will take place and control will pass back to the caller. The + value of this function may be NULL. - The file callback function must also return an integer that + The \exmp{file_func} callback function must return an integer that indicates how processing should continue. If it returns a positive value, then additional files in the corresponding directory will be processed. If it returns 0, then no further files or subdirectories of the directory will be processed, and processing will continue to take place in the parent directory. Otherwise, the return value is negative, which indicates that processing should be stopped and - control will pass back to the caller. + control will pass back to the caller. The value of this function + may be NULL. + + If the \exmp{leavedir_func} has been specified and is non-NULL, then + it will be called after the directory has been processed. It must + return an integer. A return value of -1 is used to indicate that an + error has occurred, and that further processing should stop. \qualifiers The following qualifiers are supported: @@ -36,12 +45,17 @@ dargs={args...} #v- \exmp{dargs} is a list of additional arguments that will be added when - calling the directory callback function. + calling the \exmp{enterdir_func} callback. #v+ fargs={args...} #v- \exmp{fargs} is a list of additional arguments that will be added when - calling the file callback function. + calling the \exmp{file_func} callback function. +#v+ + largs={args...} +#v- + \exmp{largs} is a list of additional arguments that will be added when + calling the \exmp{leavedir_func} callback. #v+ followlinks=val #v-
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/tm/process.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/tm/process.tm
Changed
@@ -99,6 +99,35 @@ #v- If this qualifier exists, its value will be passed as the second argument to the \exmp{pre_exec_hook} callback function. +#v+ + exec_hook=&func +#v- + This qualifier may be used to specify the function that actually + executes the child process. It is expected to take 2 arguments: + the \exmp{argv} array and the value of the \exmp{exec_hook_arg} + qualifier. The function should invoke the \ifun{execvp} system + and return its value. Only in very special cases, such as testing + the process code itself, should this hook be needed. +#v+ + exec_hook_arg=VAL +#v- + The value of this qualifier will be passed to the \exmp{exec_hook} + callback function. +#v+ + exit_hook=&func +#v- + This qualifier may be used to specify the function to be called + just before the child process exits in the case of a failure. + executes the child process. The function will be passed 2 + arguments: the \exmp{argv} array and the value of the + \exmp{exit_hook_arg} qualifier. The function should not return a + value. Only in very special cases, such as testing the process + code itself, should this hook be needed. +#v+ + exit_hook_arg=VAL +#v- + The value of this qualifier will be passed to the \exmp{exit_hook} + callback function. Note that the read and write qualifiers specify the nature of the file descriptors from the child process's view. That is, those
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/tm/timestamp.tm
Added
@@ -0,0 +1,26 @@ +\function{timestamp_parse} +\synopsis{Parse a timestamps to Unix time} +\usage{Long_Type timestamp_parse (String_Type timestamp)} +\description + The \sfun{timestamp_parse} function parses the string representation + of a timestamp and returns it expessed as the number of seconds + since the Unix Epoch. + + The \exmp{timestamp} string is assumed to conform to one of the + following standards: RFCs 822, 1036, 1123, 2822, 3339, and ISO-8601. + Examples include: +#v+ + "2020-05-02T17:09:58+00:00" + "Sunday, 02-May-20 17:09:58 UTC" + "Sun, 2 May 2020 17:09:58 +0000" + "5/2/2020, 5:31:57 PM EDT" + "2020-02-14T170958+0000" + "5/02/2020, 5:31:57 PM", +#v- + If a timezone specifier is missing, the local timezone will be + assumed. + + Upon success, the functions returns the number of seconds since + 1970-01-01T00:00:00 UTC. If the format of the timestamp is not + recognized as the function, NULL will be returned. +\seealso{_time, ctime, strftime, gmtime, timegm, mktime}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/readline.c -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/readline.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2005-2017,2018 John E. Davis +Copyright (C) 2005-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -950,11 +950,11 @@ case 3: if (-1 == SLang_pop_anytype (&cb->cd)) return; - /* drop */ + /* fall through */ case 2: if (NULL == (cb->update_hook = SLang_pop_function ())) goto free_and_return; - /* drop */ + /* fall through */ case 1: if (NULL == (cb->mmt = pop_sri_type (&cb->sri))) goto free_and_return;
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/scripts/slcov
Added
@@ -0,0 +1,358 @@ +#!/usr/bin/env slsh +() = evalfile ("cmdopt"); +() = evalfile ("csv"); + +private variable Version = "0.1.0"; +private variable Output_Fp; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +_boseos_info = 0; + +private variable Hits_Hash = Assoc_TypeUInt_Type, 0; +private define bos_handler (file, line) +{ + variable h = strcat (file, "\t", string(line)); + Hits_Hashh += 1; +} + +private variable Func_Hits = Assoc_TypeUInt_Type, 0; +private define bof_handler (func, file) +{ + variable h = strcat (file, "\t", func); + %() = fprintf (stderr, "bof_handler: %S\n", h); + Func_Hitsh += 1; +} + +#ifexists _set_bof_compile_hook +private variable Func_List = Assoc_TypeInt_Type, 0; +private define bof_compile_hook (file, fname) +{ + Func_Liststrcat (file, "\t", fname) = 1; +} + +private define bos_compile_hook (file, line) +{ + Hits_Hashstrcat (file, "\t", string(line)) = 0; +} +#endif + +define slcov_enable () +{ + ()=_set_bos_handler (&bos_handler); + ()=_set_bof_handler (&bof_handler); + _boseos_info = 3; + _bofeof_info = 1; +#ifexists _set_bof_compile_hook + ()=_set_bof_compile_hook (&bof_compile_hook); + ()=_set_bos_compile_hook (&bos_compile_hook); +#endif +} + +define slcov_disable () +{ + ()=_set_bos_handler (NULL); + ()=_set_eos_handler (NULL); + ()=_set_bof_handler (NULL); + _boseos_info = 0; + _bofeof_info = 0; +#ifexists _set_bof_compile_hook + ()=_set_bof_compile_hook (NULL); + ()=_set_bos_compile_hook (NULL); +#endif +} + +private define make_absolute_filename (file) +{ + file = path_concat (getcwd(), file); + file = strreplace (file, "/./", "/"); + ifnot (is_substr (file, "../")) return file; + variable components = strchop (file, '/', 0); + file = "/"; + foreach (components) + { + variable c = (); + if (c == "..") + file = path_dirname (file); + else + file = path_concat (file, c); + } + return file; +} + +private define output_trace_file (fp, csv) +{ + variable file = NULL, i; + _for i (0, length (csv.file)-1, 1) + { + if (file != csv.filei) + { + if (file != NULL) () = fputs ("end_of_record\n", fp); + () = fputs ("TN:\n", fp); + file = csv.filei; + % Use an absolute pathname to faciliate merging output files + () = fprintf (fp, "SF:%s\n", make_absolute_filename (file)); + variable jj, j = where ((csv.file == file) and (csv.function != "")); + foreach jj (j) + () = fprintf (fp, "FN:%d,%s\n", csv.linenojj, csv.functionjj); + + foreach jj (j) + { + () = fprintf (fp, "FNDA:%d,%s\n", csv.fhitsjj, csv.functionjj); + } + + () = fprintf (fp, "FNF:%d\n", length(j)); + () = fprintf (fp, "FNH:%d\n", length(j)); % FIXME + } + variable h = csv.hitsi; + if ((h == -1) || ((h == 0) && (csv.functioni != ""))) continue; + () = fprintf (fp, "DA:%d,%d\n", csv.linenoi, h); + } + if (file != NULL) () = fputs ("end_of_record\n", fp); +} + +define slcov_write_report (fp, use_gcov) +{ + variable s = struct + { + file = {}, lineno = {}, hits = {}, + }; + + variable key, val, fields, file, files = Assoc_TypeInt_Type; + foreach key, val (Hits_Hash) + { + fields = strchop (key, '\t', 0); + file = fields0; + list_append (s.file, file); + list_append (s.lineno, atoi (fields1)); + list_append (s.hits, val); + filesfile = 1; + } + s.file = list_to_array (s.file); + s.lineno = list_to_array (s.lineno); + s.hits = list_to_array (s.hits); + + variable csv = struct + { + file = String_Type0, lineno = Int_Type0, + hits = Int_Type0, function = String_Type0, + fhits = Int_Type0, + }; + + foreach file (assoc_get_keys (files)) + { + if (file == __FILE__) continue; + variable fpin = fopen (file, "r"); + if (fpin == NULL) + { + filesfile = 0; + continue; + } + variable i, + fre = `^^%"*define \t+\(a-zA-Z0-9_+\)`, + line, lines = fgetslines(fpin), + num = length(lines), + hits = -1Int_Typenum, + funcs = ""Int_Typenum, + fhits = Int_Typenum; + +#ifnexists _set_bos_compile_hook + variable stmt_res = + + `^^#%*-(@!+/*&|<>^=`, + `^ \t*continue\>`, + `^ \t*break\>`, + `^ \t*return\>`, + `^ \t*throw\>`, + ; + variable not_stmt_res = + + `^ \t*0-9"'{}+-/*&!=|`, % continuation + `^ \ta-z0-9_+,`, % continuation + `^"%*\\\$`, % continuation of multiline string + `^ \t*(a-z0-9_, \t*) \t^=`, % matches (a,b,..) ^= + `^ \t*try\>`, + `^ \t*return \t*;`, % return; + ; +#endif + () = fclose (fpin); + + _for i (0, num-1, 1) + { + line = linesi; + variable matches = string_matches (line, fre); + if (matches != NULL) + { + variable func = matches1; +#ifexists _set_bof_compile_hook + ifnot (Func_Listfile + "\t" + func) + continue; % not compiled, probably #ifdef'd out +#endif + hitswhere (funcs == func) = -1; % probably a forward declaration + funcsi = func; + fhitsi = Func_Hitsfile + "\t" + func; + continue; + } +#ifnexists _set_bos_compile_hook + variable re; + foreach re (stmt_res) + { + if (string_match (line, re))
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/slsh.c -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/slsh.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2005-2017,2018 John E. Davis +Copyright (C) 2005-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -512,7 +512,7 @@ static int output_copyright (void) { output_version (); - fprintf (stdout, "Copyright (C) 2005-2017,2018 John E. Davis <jed@jedsoft.org>\r\n"); + fprintf (stdout, "Copyright (C) 2005-2021,2022 John E. Davis <jed@jedsoft.org>\r\n"); fprintf (stdout, "This is free software with ABSOLUTELY NO WARRANTY.\r\n"); fprintf (stdout, "\n");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/slsh.h -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/slsh.h
Changed
@@ -1,5 +1,5 @@ /* -*- mode: C; mode: fold -*- -Copyright (C) 2010-2017,2018 John E. Davis +Copyright (C) 2010-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/Makefile.in -> _service:tar_scm:slang-2.3.3.tar.bz2/src/Makefile.in
Changed
@@ -159,7 +159,7 @@ @echo "" @echo $(NORMAL_LIB) created in $(OBJDIR) -$(ELFDIR_ELF_LIB): $(ELFDIR) $(CONFIG_H) $(ELFOBJS) $(VERSION_SCRIPT) +$(ELFDIR_ELF_LIB): $(ELFDIR_TSTAMP) $(CONFIG_H) $(ELFOBJS) $(VERSION_SCRIPT) -$(RM) $(ELFDIR_ELF_LIB) cd $(ELFDIR) && $(ELF_LINK_CMD) -o $(ELFLIB_BUILD_NAME) $(OFILES) $(LDFLAGS) $(ELF_DEP_LIBS) if $(ELFLIB_MAJOR) != $(ELFLIB_BUILD_NAME) ; then \ @@ -203,7 +203,7 @@ @echo installing $(OBJDIR_NORMAL_LIB) in $(DEST_LIBDIR)/ $(INSTALL_DATA) $(OBJDIR_NORMAL_LIB) $(DEST_LIBDIR)/ $(RANLIB) $(DEST_LIBDIR)/$(NORMAL_LIB) -install-elf-and-links: +install-elf-and-links: $(DEST_LIBDIR) -$(RM) $(DEST_LIBDIR)/$(ELFLIB) -$(RM) $(DEST_LIBDIR)/$(ELFLIB_MAJOR) @echo installing $(ELFLIB_BUILD_NAME) in $(DEST_LIBDIR)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/_slang.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/_slang.h
Changed
@@ -3,7 +3,7 @@ /* header file for S-Lang internal structures that users do not (should not) need. Use slang.h for that purpose. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -466,7 +466,10 @@ extern int _pSLstruct_push_field (SLang_Struct_Type *s, SLFUTURE_CONST char *name, int do_free); extern int _pSLstruct_pop_field (SLang_Struct_Type *s, SLFUTURE_CONST char *name, int do_free); -extern int _pSLang_get_qualifiers_intrin (SLang_Struct_Type **); +extern int _pSLang_get_qualifiers_intrin (SLang_Struct_Type **); /* Value is not to be freed by caller */ + +extern int _pSLang_get_qualifiers (SLang_Struct_Type **); /* Caller must free when done */ +extern int _pSLang_set_qualifiers (SLang_Struct_Type *); struct _pSLang_Ref_Type { @@ -562,8 +565,6 @@ extern char *_pSLstringize_object (SLang_Object_Type *); extern int _pSLdump_objects (char *, SLang_Object_Type *, unsigned int, int); -extern SLang_Object_Type *_pSLang_get_run_stack_pointer (void); -extern SLang_Object_Type *_pSLang_get_run_stack_base (void); extern int _pSLang_dump_stack (void); extern int _pSLang_peek_at_stack2 (SLtype *); extern int _pSLang_restart_arg_list (int nargs); @@ -638,6 +639,8 @@ extern int _pSLcall_bof_handler (SLFUTURE_CONST char *, SLFUTURE_CONST char *); extern int _pSLcall_eof_handler (void); extern int _pSLcall_debug_hook (SLFUTURE_CONST char *file, int linenum); +extern int _pSLcall_bos_compile_hook (const char *file, long linenum); +extern int _pSLcall_bof_compile_hook (const char *file, const char *func); /* extern int _pSLcall_debug_hook (char *file, int linenum, char *funct); */ #endif @@ -903,8 +906,8 @@ extern SLclass_Type _pSLang_get_class_type (SLtype); extern void _pSLang_set_class_info (SLtype, SLang_Class_Type *); extern int _pSLarray_bin_op (SLang_Object_Type *, SLang_Object_Type *, int); -extern int _pSLarray1d_push_elem (SLang_Array_Type *at, SLindex_Type idx); #endif +extern int _pSLarray1d_push_elem (SLang_Array_Type *at, SLindex_Type idx); extern int _pSLarith_bin_op (SLang_Object_Type *, SLang_Object_Type *, int); /* Does not perform any range checking. It is up to the caller.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/config.hin -> _service:tar_scm:slang-2.3.3.tar.bz2/src/config.hin
Changed
@@ -188,6 +188,7 @@ #undef HAVE_SYS_UTSNAME_H #undef HAVE_UNAME +#undef HAVE_FLOCK #undef HAVE_ALARM #undef HAVE_PAUSE
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/pcconf.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/pcconf.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sl-feat.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sl-feat.h
Changed
@@ -10,10 +10,9 @@ #define SLANG_HAS_ASSOC_ARRAYS 1 #define SLANG_HAS_COMPLEX 1 -#define SLANG_HAS_FLOAT 1 /* This is the old space-speed trade off. To reduce memory usage and code - * size, set this to zero. + * size, set this to zero at the risk of resulting in slower running code. */ #define SLANG_OPTIMIZE_FOR_SPEED 2 @@ -89,3 +88,7 @@ #else # define SLANG_HAS_MULTILINE_RLINE 0 #endif + +/* The interpreter is crippled without floating point. Make it manditory. */ +#undef SLANG_HAS_FLOAT +#define SLANG_HAS_FLOAT 1
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slagetput.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slagetput.inc
Changed
@@ -1,4 +1,6 @@ /* -*- mode: C -*- */ + + #ifdef AGET_FROM_INDEX_ARRAY_FUN static int AGET_FROM_INDEX_ARRAY_FUN (GENERIC_TYPE *src_data, SLindex_Type num_elements, SLang_Array_Type *ind_at, int is_range, @@ -11,13 +13,15 @@ SLarray_Range_Array_Type *r = (SLarray_Range_Array_Type *)ind_at->data; SLindex_Type idx = r->first_index, delta = r->delta; SLindex_Type j, jmax = (SLindex_Type) ind_at->num_elements; + int ispos; if (jmax == 0) return 0; - if ((idx >= 0) - && ((idx + delta * (jmax-1)) >= 0) - && ((idx + delta * (jmax-1)) < num_elements)) + if (-1 == check_range_indices (idx, delta, jmax, num_elements, &ispos)) + return -1; + + if (ispos) { for (j = 0; j < jmax; j++) { @@ -30,17 +34,7 @@ for (j = 0; j < jmax; j++) { SLindex_Type i = idx; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } + if (i < 0) i += num_elements; dest_dataj = src_datai; idx += delta; } @@ -55,17 +49,7 @@ { SLindex_Type i = *indices; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } + CHECK_INDEX(i,num_elements,return -1); *dest_data++ = src_datai; indices++; } @@ -86,13 +70,15 @@ SLarray_Range_Array_Type *r = (SLarray_Range_Array_Type *)ind_at->data; SLindex_Type idx = r->first_index, delta = r->delta; SLindex_Type j, jmax = (SLindex_Type) ind_at->num_elements; + int ispos; if (jmax == 0) return 0; - if ((idx >= 0) - && ((idx + delta * (jmax-1)) >= 0) - && ((idx + delta * (jmax-1)) < num_elements)) + if (-1 == check_range_indices (idx, delta, jmax, num_elements, &ispos)) + return -1; + + if (ispos) { for (j = 0; j < jmax; j++) { @@ -106,17 +92,7 @@ for (j = 0; j < jmax; j++) { SLindex_Type i = idx; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } + if (i < 0) i += num_elements; dest_datai = *(GENERIC_TYPE *)src_data; idx += delta; src_data += data_increment; @@ -132,17 +108,7 @@ { SLindex_Type i = *indices; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } + CHECK_INDEX(i,num_elements,return -1); dest_datai = *(GENERIC_TYPE *)src_data; src_data += data_increment; indices++;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slang.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slang.c
Changed
@@ -1,7 +1,7 @@ /* -*- mode: C; mode: fold; -*- */ /* slang.c --- guts of S-Lang interpreter */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -169,7 +169,6 @@ int SLang_Num_Function_Args = 0; static int *Num_Args_Stack; static unsigned int Recursion_Depth; -static SLang_Object_Type *Frame_Pointer; static int Next_Function_Num_Args; static unsigned int Frame_Pointer_Depth; @@ -222,9 +221,10 @@ static int Lang_Return = 0; /* static int Lang_Continue = 0; */ -static SLang_Object_Type *Run_Stack; -static SLang_Object_Type *Stack_Pointer; -static SLang_Object_Type *Stack_Pointer_Max; +static SLang_Object_Type *Run_Stack = NULL; +static SLang_Object_Type *Run_Stack_Stack_Pointer = NULL; +static SLang_Object_Type *Run_Stack_Stack_Pointer_Max = NULL; +static SLang_Object_Type *Run_Stack_Frame_Pointer = NULL; static SLang_Object_Type *Local_Variable_Stack; static SLang_Object_Type *Local_Variable_Stack_Max; @@ -302,7 +302,7 @@ { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; IF_UNLIKELY(y == Run_Stack) { (void) SLang_set_error (SL_STACK_UNDERFLOW); @@ -312,7 +312,7 @@ y--; *x = *y; - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; return 0; } @@ -326,7 +326,7 @@ { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; if (Run_Stack + 2 > y) { @@ -338,7 +338,7 @@ } *b = *(--y); *a = *(--y); - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; return 0; } #endif @@ -353,7 +353,7 @@ register SLang_Object_Type *y; unsigned int i; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; if (Run_Stack + n > y) { @@ -369,20 +369,20 @@ y--; xi = *y; } - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; return 0; } _INLINE_ static int peek_at_stack (void) { - IF_UNLIKELY(Stack_Pointer == Run_Stack) + IF_UNLIKELY(Run_Stack_Stack_Pointer == Run_Stack) { (void) SLang_set_error (SL_STACK_UNDERFLOW); return -1; } - return (int) (Stack_Pointer - 1)->o_data_type; + return (int) (Run_Stack_Stack_Pointer - 1)->o_data_type; } int SLang_peek_at_stack (void) @@ -393,15 +393,15 @@ int _pSLang_peek_at_stack2 (SLtype *_typep) { SLtype type; - if (Stack_Pointer == Run_Stack) + if (Run_Stack_Stack_Pointer == Run_Stack) { (void) SLang_set_error (SL_STACK_UNDERFLOW); return -1; } - type = (Stack_Pointer - 1)->o_data_type; + type = (Run_Stack_Stack_Pointer - 1)->o_data_type; if (type == SLANG_ARRAY_TYPE) - *_typep = (Stack_Pointer - 1)->v.array_val->data_type; + *_typep = (Run_Stack_Stack_Pointer - 1)->v.array_val->data_type; else *_typep = type; return (int) type; @@ -409,14 +409,14 @@ int SLang_peek_at_stack_n (unsigned int n) { - unsigned int stklen = (unsigned int)(Stack_Pointer - Run_Stack); + unsigned int stklen = (unsigned int)(Run_Stack_Stack_Pointer - Run_Stack); - if (n >= stklen) + IF_UNLIKELY(n >= stklen) { (void) SLang_set_error (SL_STACK_UNDERFLOW); return -1; } - return (int) (Stack_Pointer - (n+1))->o_data_type; + return (int) (Run_Stack_Stack_Pointer - (n+1))->o_data_type; } static int pop_ctrl_integer (int *i) @@ -429,7 +429,7 @@ /* Most of the time, either an integer or a char will be on the stack. * Optimize these cases. */ - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; IF_UNLIKELY(y == Run_Stack) { (void) SLang_set_error (SL_STACK_UNDERFLOW); @@ -440,13 +440,13 @@ type = (int) y->o_data_type; if (type == SLANG_INT_TYPE) { - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; *i = y->v.int_val; return 0; } if (type == SLANG_CHAR_TYPE) { - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; *i = y->v.char_val; return 0; } @@ -472,7 +472,7 @@ type = SLang_peek_at_stack_n (n); if (type == SLANG_ARRAY_TYPE) - type = (Stack_Pointer - (n+1))->v.array_val->data_type; + type = (Run_Stack_Stack_Pointer - (n+1))->v.array_val->data_type; return type; } @@ -510,24 +510,60 @@ free_object (obj, cl); } +static int increase_stack_size (int min_amount) +{ + SLang_Object_Type *new_stack; + size_t stack_size, new_stack_size, stack_depth, frame_pointer_offset; + + stack_depth = Run_Stack_Stack_Pointer - Run_Stack; + stack_size = Run_Stack_Stack_Pointer_Max - Run_Stack; + new_stack_size = stack_size + min_amount; + frame_pointer_offset = Run_Stack_Frame_Pointer - Run_Stack; + + if (new_stack_size > SLANG_MAX_STACK_LEN) + { + SLang_verror (SL_STACK_OVERFLOW, "Maximum stack size exceeded"); + return -1; + } + if (min_amount < SLANG_INITIAL_STACK_LEN) + { + new_stack_size = stack_size + SLANG_INITIAL_STACK_LEN; + if (new_stack_size > SLANG_MAX_STACK_LEN) + new_stack_size = SLANG_MAX_STACK_LEN; + } + + if (NULL == (new_stack = (SLang_Object_Type *)_SLrecalloc ((SLFUTURE_VOID *)Run_Stack, new_stack_size, sizeof(SLang_Object_Type)))) + return -1; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slang.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slang.h
Changed
@@ -2,7 +2,7 @@ #define DAVIS_SLANG_H_ /* -*- mode: C; mode: fold; -*- */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -22,8 +22,8 @@ USA. */ -#define SLANG_VERSION 20302 -#define SLANG_VERSION_STRING "2.3.2" +#define SLANG_VERSION 20303 +#define SLANG_VERSION_STRING "2.3.3" /* #ifdef __DATE__ */ /* # define SLANG_VERSION_STRING SLANG_VERSION_STRING0 " " __DATE__ */ /* #else */ @@ -229,6 +229,7 @@ #endif typedef int (*FVOID_STAR)(void); +typedef void (*SLFvoid_Star)(void); #if defined(__MSDOS__) && defined(__BORLANDC__) # define SLFREE(buf) farfree((void far *)(buf)) @@ -1333,6 +1334,7 @@ /* This is an interface to atexit */ SL_EXTERN int SLang_add_cleanup_function (void (*)(void)); +/* The SLmake_nstring functions return malloced strings, and not slang hashed slstrings */ SL_EXTERN char *SLmake_string (SLFUTURE_CONST char *); SL_EXTERN char *SLmake_nstring (SLFUTURE_CONST char *, SLstrlen_Type); /* Returns a null terminated string made from the first n characters of the @@ -1505,7 +1507,7 @@ typedef struct SLKeymap_Function_Type { SLFUTURE_CONST char *name; - int (*f)(void); + FVOID_STAR f; } SLKeymap_Function_Type; @@ -2240,7 +2242,7 @@ SLtype from_type, SLtype to_type); #define MAKE_INTRINSIC_N(n,f,out,in,a1,a2,a3,a4,a5,a6,a7) \ - {(n), NULL, SLANG_INTRINSIC, (FVOID_STAR) (f), \ + {(n), NULL, SLANG_INTRINSIC, (FVOID_STAR)(SLFvoid_Star)(f), \ {a1,a2,a3,a4,a5,a6,a7}, (in), (out)} #define MAKE_INTRINSIC_7(n,f,out,a1,a2,a3,a4,a5,a6,a7) \
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarith.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarith.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -141,37 +141,20 @@ /* Here are a bunch of functions to convert from one type to another. To * facilitate the process, macros will be used. */ - -#define DEFUN_1(f,from_type,to_type) \ -static void f (to_type *y, from_type *x, SLuindex_Type n) \ -{ \ - SLuindex_Type i; \ - for (i = 0; i < n; i++) yi = (to_type) xi; \ -} - -#define DEFUN_2(f,from_type,to_type,copy_fun) \ -static VOID_STAR f (VOID_STAR xp, SLuindex_Type n) \ -{ \ - from_type *x; \ - to_type *y; \ - x = (from_type *) xp; \ - if (NULL == (y = (to_type *) _SLcalloc (n, sizeof (to_type)))) return NULL; \ - copy_fun (y, x, n); \ - return (VOID_STAR) y; \ -} typedef VOID_STAR (*Convert_Fun_Type)(VOID_STAR, SLuindex_Type); -#if SLANG_HAS_FLOAT -#define TO_DOUBLE_FUN(name,type) \ - static double name (VOID_STAR x) { return (double) *(type *) x; } +typedef int (*Bin_Fun_Type) (int, + SLtype, VOID_STAR, SLuindex_Type, + SLtype, VOID_STAR, SLuindex_Type, + VOID_STAR); +#if SLANG_HAS_FLOAT typedef SLCONST struct { unsigned int sizeof_type; double (*to_double_fun)(VOID_STAR); } To_Double_Fun_Table_Type; - #endif /* Each element of the matrix determines how the row maps onto the column. @@ -187,8 +170,9 @@ */ typedef struct { - FVOID_STAR copy_function; + SLFvoid_Star copy_function; Convert_Fun_Type convert_function; + Bin_Fun_Type bin_op_function; } Binary_Matrix_Type; @@ -212,228 +196,6 @@ } #endif /* SLANG_HAS_FLOAT */ -#define GENERIC_BINARY_FUNCTION int_int_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE int -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define ABS_FUNCTION abs -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define TRAP_DIV_ZERO 1 -#define GENERIC_UNARY_FUNCTION int_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION int_arith_unary_op -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION int_int_scalar_bin_op -#endif -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_int_obj(SLANG_INT_TYPE,(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION int_cmp_function -#include "slarith.inc" - -#define GENERIC_BINARY_FUNCTION uint_uint_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE unsigned int -#define GENERIC_TYPE_IS_UNSIGNED -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define TRAP_DIV_ZERO 1 -#define GENERIC_UNARY_FUNCTION uint_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION uint_arith_unary_op -#define ABS_FUNCTION(a) (a) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -#if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION uint_uint_scalar_bin_op -#endif -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_int_obj(SLANG_UINT_TYPE,(int)(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION uint_cmp_function -#define TO_BINARY_FUNCTION uint_to_binary -#include "slarith.inc" - -#if LONG_IS_NOT_INT -#define GENERIC_BINARY_FUNCTION long_long_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE long -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define TRAP_DIV_ZERO 1 -#define GENERIC_UNARY_FUNCTION long_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION long_arith_unary_op -#define ABS_FUNCTION(a) (((a) >= 0) ? (a) : -(a)) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION long_long_scalar_bin_op -#endif -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_long_obj(SLANG_LONG_TYPE,(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION long_cmp_function -#include "slarith.inc" - -#define GENERIC_BINARY_FUNCTION ulong_ulong_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE unsigned long -#define GENERIC_TYPE_IS_UNSIGNED -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define TRAP_DIV_ZERO 1 -#define GENERIC_UNARY_FUNCTION ulong_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION ulong_arith_unary_op -#define ABS_FUNCTION(a) (a) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -#if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION ulong_ulong_scalar_bin_op -#endif -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_long_obj(SLANG_ULONG_TYPE,(long)(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION ulong_cmp_function -#define TO_BINARY_FUNCTION ulong_to_binary -#include "slarith.inc" -#else -#define long_long_bin_op int_int_bin_op -#define ulong_ulong_bin_op uint_uint_bin_op -#define long_unary_op int_unary_op -#define ulong_unary_op uint_unary_op -#define long_cmp_function int_cmp_function -#define ulong_cmp_function uint_cmp_function -#define ulong_to_binary uint_to_binary -#endif /* LONG_IS_NOT_INT */ - -#ifdef HAVE_LONG_LONG -# if LLONG_IS_NOT_LONG -# define GENERIC_BINARY_FUNCTION llong_llong_bin_op -# define GENERIC_BIT_OPERATIONS -# define GENERIC_TYPE long long -# define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -# define POW_RESULT_TYPE double -# define MOD_FUNCTION(a,b) ((a) % (b)) -# define TRAP_DIV_ZERO 1 -# define GENERIC_UNARY_FUNCTION llong_unary_op -# define GENERIC_ARITH_UNARY_FUNCTION llong_arith_unary_op -# define ABS_FUNCTION(a) (((a) >= 0) ? (a) : -(a)) -# define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -# if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION llong_llong_scalar_bin_op -# endif -# define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_llong_obj(SLANG_LLONG_TYPE,(x)) -# define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -# define CMP_FUNCTION llong_cmp_function -# include "slarith.inc" - -# define GENERIC_BINARY_FUNCTION ullong_ullong_bin_op -# define GENERIC_BIT_OPERATIONS -# define GENERIC_TYPE unsigned long long -# define GENERIC_TYPE_IS_UNSIGNED -# define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -# define POW_RESULT_TYPE double -# define MOD_FUNCTION(a,b) ((a) % (b)) -# define TRAP_DIV_ZERO 1 -# define GENERIC_UNARY_FUNCTION ullong_unary_op -# define GENERIC_ARITH_UNARY_FUNCTION ullong_arith_unary_op -# define ABS_FUNCTION(a) (a) -# define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -# if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION ullong_ullong_scalar_bin_op -# endif -# define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_llong_obj(SLANG_ULLONG_TYPE,(long long)(x)) -# define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -# define CMP_FUNCTION ullong_cmp_function -# define TO_BINARY_FUNCTION ullong_to_binary -# include "slarith.inc" -# else -# define llong_llong_bin_op long_long_bin_op -# define ullong_ullong_bin_op ulong_ulong_bin_op -# define llong_llong_scalar_bin_op long_long_scalar_bin_op
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarith.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarith.inc
Changed
@@ -8,12 +8,50 @@ /* The following macros should be properly defined before including this file: * + * For unary operations: (op a) + * GENERIC_UNARY_FUNCTION Name of the unary function + * GENERIC_A_TYPE: The class data type + * GENERIC_A_IS_UNSIGNED Indicates that the type is unsigned + * GENERIC_BIT_OPERATIONS If defined, include SLANG_BNOT + * ABS_FUNCTION: Name of the abs function + * + * For binary operations involving arrays: (a op b) * GENERIC_BINARY_FUNCTION: The name of the binary function - * GENERIC_TYPE: The class data type + * GENERIC_A_TYPE: The class data type for 'a' + * GENERIC_B_TYPE: The class data type for 'b + * GENERIC_B_TYPE_UNSIGNED: Define it 'b' is unsigned + * JUST_BOOLEAN_BINARY_OPS If defined, only "==", "!=", "or", "and" implemented + * GENERIC_BIT_OPERATIONS Include bit ops: "&", "xor", "|", "<<", ">>" + * POW_FUNCTION Used to compute the a^b operation + * POW_RESULT_TYPE The type of the result of a^b + * TRAP_DIV_ZERO required: if 1, throw SL_DIVIDE_ERROR exception * MOD_FUNCTION: The function to use for mod - * ABS_FUNCTION: Name of the abs function - * SIGN_FUNCTION: Name of the sign function - * GENERIC_UNARY_FUNCTION Name of the unary function + * + * For scalar (non-array) binary operations ( a op b) + * SCALAR_BINARY_FUNCTION: The name of the scalar binary function + * GENERIC_A_TYPE: The class data type for 'a' + * GENERIC_B_TYPE: The class data type for 'b' + * GENERIC_B_TYPE_UNSIGNED Define it 'b' is unsigned + * PUSH_SCALAR_OBJ_FUN Used to push the result of (a op b) + * POW_FUNCTION Used to compute the a^b operation + * PUSH_POW_OBJ_FUN Function used to push the result of (a^b) + * TRAP_DIV_ZERO required: If 1 throw SL_DIVIDE_ERROR exception + * GENERIC_BIT_OPERATIONS Include bit op: "&", "xor", "|", "<<", ">>" + * MOD_FUNCTION: The function to use for mod + * + * Copy functions: Copy the an array of type A to B + * GENERIC_COPY_FUNCTION Name of function + * GENERIC_A_TYPE Specifies the type A + * GENERIC_B_TYPE Specifies the type B + * + * Convert functions: Creates an array of type B initialized to values of A + * GENERIC_CONVERT_FUNCTION The name of the function + * GENERIC_A_TYPE Specifies the type A + * GENERIC_B_TYPE Specifies the type B + * + * Conversion to a double: returns a single double via a typecast + * TO_DOUBLE_FUNCTION Name of the function + * GENERIC_A_TYPE The type of that is typecast to double * * If GENERIC_BIT_OPERATIONS is defined, the bit-level binary operators * will get included. If the data type has a power operation (SLANG_POW), @@ -23,6 +61,94 @@ * * If division by zero errors should be trapped, the define TRAP_DIV_ZERO to 1 */ + +#define UNROLL_SOME_LOOPS 1 +#if UNROLL_SOME_LOOPS +# define UNROLL_THIS_ab(_c, _a, _op, _b, _n, _na) \ + (_n) = 0; \ + while ((_n) + 4 <= (_na)) \ + { \ + (_c)(_n) = _a(_n) _op _b(_n); \ + (_c)(_n)+1 = _a(_n)+1 _op _b(_n)+1; \ + (_c)(_n)+2 = _a(_n)+2 _op _b(_n)+2; \ + (_c)(_n)+3 = _a(_n)+3 _op _b(_n)+3; \ + n += 4; \ + } \ + while ((_n) < (_na)) { (_c)(_n) = _a(_n) _op _b(_n); (_n)++; } (void)0 + +# define UNROLL_THIS_a(_c, _a, _op, _b, _n, _na) \ + (_n) = 0; \ + while ((_n) + 4 <= (_na)) \ + { \ + (_c)(_n) = _a(_n) _op _b; \ + (_c)(_n)+1 = _a(_n)+1 _op _b; \ + (_c)(_n)+2 = _a(_n)+2 _op _b; \ + (_c)(_n)+3 = _a(_n)+3 _op _b; \ + n += 4; \ + } \ + while ((_n) < (_na)) { (_c)(_n) = _a(_n) _op _b; (_n)++; } (void)0 + +# define UNROLL_THIS_b(_c, _a, _op, _b, _n, _na) \ + (_n) = 0; \ + while ((_n) + 4 <= (_na)) \ + { \ + (_c)(_n) = _a _op _b(_n); \ + (_c)(_n)+1 = _a _op _b(_n)+1; \ + (_c)(_n)+2 = _a _op _b(_n)+2; \ + (_c)(_n)+3 = _a _op _b(_n)+3; \ + n += 4; \ + } \ + while ((_n) < (_na)) { (_c)(_n) = _a _op _b(_n); (_n)++; } (void)0 +#endif /* UNROLL_SOME_LOOPS */ + +#ifndef TRAP_DIV_ZERO +# define TRAP_DIV_ZERO 0 +#endif + +#if TRAP_DIV_ZERO +# ifdef GENERIC_B_TYPE_UNSIGNED +# define PERFORM_DIVIDE(_c, _a, _b) \ + if ((_b) == 0) \ + { \ + SLang_set_error (SL_DIVIDE_ERROR); \ + return -1; \ + } \ + else (_c) = (_a) / (_b) +# define PERFORM_MOD(_c, _a, _b) \ + if ((_b) == 0) \ + { \ + SLang_set_error (SL_DIVIDE_ERROR); \ + return -1; \ + }\ + else (_c) = MOD_FUNCTION((_a), (_b)) + +# else + +# define PERFORM_DIVIDE(_c, _a, _b) \ + if ((_b) == 0) \ + { \ + SLang_set_error (SL_DIVIDE_ERROR); \ + return -1; \ + } \ + else if ((_b) == -1) (_c) = -(_a); \ + else (_c) = (_a) / (_b) + +# define PERFORM_MOD(_c, _a, _b) \ + if ((_b) == 0) \ + { \ + SLang_set_error (SL_DIVIDE_ERROR); \ + return -1; \ + }\ + else if (_b == -1) (_c) = 0; \ + else (_c) = MOD_FUNCTION((_a), (_b)) + +# endif /* GENERIC_B_TYPE_UNSIGNED */ +#else +# define PERFORM_DIVIDE(_c, _a, _b) (_c) = (_a) / (_b) +# define PERFORM_MOD(_c, _a, _b) (_c) = MOD_FUNCTION((_a), (_b)) +#endif /* TRAP_DIV_ZERO */ + + #ifdef GENERIC_BINARY_FUNCTION static int GENERIC_BINARY_FUNCTION @@ -31,9 +157,11 @@ SLtype b_type, VOID_STAR bp, SLuindex_Type nb, VOID_STAR cp) { - GENERIC_TYPE *a, *b; + GENERIC_A_TYPE *a; + GENERIC_B_TYPE *b; + # ifndef JUST_BOOLEAN_BINARY_OPS - GENERIC_TYPE *c; + GENERIC_C_TYPE *c; # endif # ifdef POW_FUNCTION POW_RESULT_TYPE *d; @@ -47,10 +175,10 @@ (void) a_type; /* Both SLANG_INT_TYPE */ (void) b_type; - a = (GENERIC_TYPE *) ap; - b = (GENERIC_TYPE *) bp; + a = (GENERIC_A_TYPE *) ap; + b = (GENERIC_B_TYPE *) bp; #ifndef JUST_BOOLEAN_BINARY_OPS - c = (GENERIC_TYPE *) cp; + c = (GENERIC_C_TYPE *) cp; #endif cc = (char *) cp; @@ -83,7 +211,7 @@ } else if (nb == 1) { - GENERIC_TYPE xb = *b; + GENERIC_B_TYPE xb = *b; if (xb == 2) for (n = 0; n < na; n++) dn = (double)an * (double)an; @@ -93,7 +221,7 @@ } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; + GENERIC_A_TYPE xa = *a; for (n = 0; n < nb; n++) dn = POW_FUNCTION(xa, bn); } @@ -109,22 +237,31 @@ # else if (na == nb) {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarith2.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarith2.inc
Changed
@@ -1,1418 +1,4057 @@ /* DO NOT EDIT -- this file was generated by src/util/mkslarith2.sl */ -/* ------------ signed char ---------- */ -DEFUN_1(copy_char_to_char,signed char,signed char) -#define char_to_char NULL -#define copy_char_to_uchar copy_char_to_char -#define char_to_uchar NULL -DEFUN_1(copy_char_to_short,signed char,short) -#define char_to_short NULL -DEFUN_1(copy_char_to_ushort,signed char,unsigned short) -#define char_to_ushort NULL -DEFUN_1(copy_char_to_int,signed char,int) -DEFUN_2(char_to_int,signed char,int,copy_char_to_int) -DEFUN_1(copy_char_to_uint,signed char,unsigned int) -DEFUN_2(char_to_uint,signed char,unsigned int,copy_char_to_uint) -#if LONG_IS_INT -# define copy_char_to_long copy_char_to_int -#else -DEFUN_1(copy_char_to_long,signed char,long) -#endif -#if LONG_IS_INT -# define char_to_long char_to_int -#else -DEFUN_2(char_to_long,signed char,long,copy_char_to_long) -#endif -#if LONG_IS_INT -# define copy_char_to_ulong copy_char_to_uint -#else -DEFUN_1(copy_char_to_ulong,signed char,unsigned long) -#endif -#if LONG_IS_INT -# define char_to_ulong char_to_uint -#else -DEFUN_2(char_to_ulong,signed char,unsigned long,copy_char_to_ulong) -#endif -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_char_to_llong,signed char,long long) -DEFUN_2(char_to_llong,signed char,long long,copy_char_to_llong) -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_char_to_ullong,signed char,unsigned long long) -DEFUN_2(char_to_ullong,signed char,unsigned long long,copy_char_to_ullong) -#endif /* defined(HAVE_LONG_LONG) */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_char_to_float,signed char,float) -DEFUN_2(char_to_float,signed char,float,copy_char_to_float) -#endif /* SLANG_HAS_FLOAT */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_char_to_double,signed char,double) -DEFUN_2(char_to_double,signed char,double,copy_char_to_double) -#endif /* SLANG_HAS_FLOAT */ -#if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_char_to_ldouble,signed char,long double) -DEFUN_2(char_to_ldouble,signed char,long double,copy_char_to_ldouble) -#endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(char_to_one_double,signed char) -#endif +/* signed char */ +/* (signed char, signed char) */ +#define GENERIC_BINARY_FUNCTION char_char_bin_op +#define GENERIC_A_TYPE signed char +#define GENERIC_B_TYPE signed char +#define GENERIC_C_TYPE int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define char_char_scalar_bin_op int_int_scalar_bin_op +#define GENERIC_UNARY_FUNCTION char_unary_op +#define ABS_FUNCTION(a) abs(a) +#define CMP_FUNCTION char_cmp_function +#define TO_DOUBLE_FUNCTION char_to_one_double +#define GENERIC_COPY_FUNCTION copy_char_to_char +#define char_to_char char_to_int +#include "slarith.inc" -/* ------------ unsigned char ---------- */ -#define copy_uchar_to_char copy_char_to_char -#define uchar_to_char NULL -#define copy_uchar_to_uchar copy_char_to_char -#define uchar_to_uchar NULL -DEFUN_1(copy_uchar_to_short,unsigned char,short) -#define uchar_to_short NULL -DEFUN_1(copy_uchar_to_ushort,unsigned char,unsigned short) -#define uchar_to_ushort NULL -DEFUN_1(copy_uchar_to_int,unsigned char,int) -DEFUN_2(uchar_to_int,unsigned char,int,copy_uchar_to_int) -DEFUN_1(copy_uchar_to_uint,unsigned char,unsigned int) -DEFUN_2(uchar_to_uint,unsigned char,unsigned int,copy_uchar_to_uint) -#if LONG_IS_INT -# define copy_uchar_to_long copy_uchar_to_int -#else -DEFUN_1(copy_uchar_to_long,unsigned char,long) -#endif -#if LONG_IS_INT -# define uchar_to_long uchar_to_int -#else -DEFUN_2(uchar_to_long,unsigned char,long,copy_uchar_to_long) -#endif -#if LONG_IS_INT -# define copy_uchar_to_ulong copy_uchar_to_uint -#else -DEFUN_1(copy_uchar_to_ulong,unsigned char,unsigned long) -#endif -#if LONG_IS_INT -# define uchar_to_ulong uchar_to_uint -#else -DEFUN_2(uchar_to_ulong,unsigned char,unsigned long,copy_uchar_to_ulong) -#endif -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_uchar_to_llong,unsigned char,long long) -DEFUN_2(uchar_to_llong,unsigned char,long long,copy_uchar_to_llong) -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_uchar_to_ullong,unsigned char,unsigned long long) -DEFUN_2(uchar_to_ullong,unsigned char,unsigned long long,copy_uchar_to_ullong) -#endif /* defined(HAVE_LONG_LONG) */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_uchar_to_float,unsigned char,float) -DEFUN_2(uchar_to_float,unsigned char,float,copy_uchar_to_float) -#endif /* SLANG_HAS_FLOAT */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_uchar_to_double,unsigned char,double) -DEFUN_2(uchar_to_double,unsigned char,double,copy_uchar_to_double) -#endif /* SLANG_HAS_FLOAT */ -#if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_uchar_to_ldouble,unsigned char,long double) -DEFUN_2(uchar_to_ldouble,unsigned char,long double,copy_uchar_to_ldouble) -#endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(uchar_to_one_double,unsigned char) -#endif +/* (signed char, unsigned char) */ +#define char_uchar_bin_op NULL +#define GENERIC_A_TYPE signed char +#define GENERIC_B_TYPE unsigned char +#define GENERIC_B_TYPE_UNSIGNED 1 +#define GENERIC_C_TYPE int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define copy_char_to_uchar copy_char_to_char +#define char_to_uchar char_to_int +#include "slarith.inc" -/* ------------ short ---------- */ -DEFUN_1(copy_short_to_char,short,signed char) -#define short_to_char NULL -DEFUN_1(copy_short_to_uchar,short,unsigned char) -#define short_to_uchar NULL -DEFUN_1(copy_short_to_short,short,short) -#define short_to_short NULL -#define copy_short_to_ushort copy_short_to_short -#define short_to_ushort NULL -DEFUN_1(copy_short_to_int,short,int) -DEFUN_2(short_to_int,short,int,copy_short_to_int) -DEFUN_1(copy_short_to_uint,short,unsigned int) -DEFUN_2(short_to_uint,short,unsigned int,copy_short_to_uint) -#if LONG_IS_INT -# define copy_short_to_long copy_short_to_int -#else -DEFUN_1(copy_short_to_long,short,long) -#endif -#if LONG_IS_INT -# define short_to_long short_to_int -#else -DEFUN_2(short_to_long,short,long,copy_short_to_long) -#endif -#if LONG_IS_INT -# define copy_short_to_ulong copy_short_to_uint -#else -DEFUN_1(copy_short_to_ulong,short,unsigned long) -#endif -#if LONG_IS_INT -# define short_to_ulong short_to_uint -#else -DEFUN_2(short_to_ulong,short,unsigned long,copy_short_to_ulong) -#endif -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_short_to_llong,short,long long) -DEFUN_2(short_to_llong,short,long long,copy_short_to_llong) -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_short_to_ullong,short,unsigned long long) -DEFUN_2(short_to_ullong,short,unsigned long long,copy_short_to_ullong) -#endif /* defined(HAVE_LONG_LONG) */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_short_to_float,short,float) -DEFUN_2(short_to_float,short,float,copy_short_to_float) -#endif /* SLANG_HAS_FLOAT */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_short_to_double,short,double) -DEFUN_2(short_to_double,short,double,copy_short_to_double) -#endif /* SLANG_HAS_FLOAT */ -#if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_short_to_ldouble,short,long double)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarray.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarray.c
Changed
@@ -1,6 +1,6 @@ /* Array manipulation routines for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -22,6 +22,7 @@ #include "slinclud.h" #include <math.h> +#include <limits.h> /* #define SL_APP_WANTS_FOREACH */ #include "slang.h" @@ -61,7 +62,7 @@ case SLANG_NULL_TYPE: /* convert_scalar = 0; */ /* commented out for 2.0.5 to fix array_map NULL bug */ - /* drop */ + /* fall through */ default: if (convert_scalar == 0) { @@ -123,19 +124,18 @@ ofs = 0; for (i = 0; i < num_dims; i++) { - size_t new_ofs; SLindex_Type d = dimsi; - if (d < 0) - d = d + max_dimsi; - - new_ofs = ofs * (size_t)max_dims i + (size_t) d; - if ((max_dimsi != 0) - && ((new_ofs - (size_t)d)/max_dimsi != ofs)) + if ((d < 0) || (d >= max_dimsi)) { - throw_size_error (SL_Index_Error); - return NULL; + if (d < 0) + d = d + max_dimsi; + if ((d < 0) || (d >= max_dimsi)) + { + SLang_set_error (SL_Index_Error); + return NULL; + } } - ofs = new_ofs; + ofs = ofs * (size_t)max_dims i + (size_t) d; } } if (ofs >= at->num_elements) @@ -231,7 +231,8 @@ return (*at->cl->cl_init_array_object) (at->data_type, data); } -int _pSLarray_next_index (SLindex_Type *dims, SLindex_Type *max_dims, unsigned int num_dims) +static int next_index (SLindex_Type *dims, SLindex_Type *max_dims, + unsigned int num_dims, unsigned int *changed_indexp) { while (num_dims) { @@ -240,9 +241,10 @@ num_dims--; dims_i = dims num_dims + 1; - if (dims_i < (int) max_dims num_dims) + if (dims_i < (SLindex_Type) max_dims num_dims) { dims num_dims = dims_i; + *changed_indexp = num_dims; return 0; } dims num_dims = 0; @@ -251,6 +253,12 @@ return -1; } +int _pSLarray_next_index (SLindex_Type *dims, SLindex_Type *max_dims, unsigned int num_dims) +{ + unsigned int changed_index; + return next_index (dims, max_dims, num_dims, &changed_index); +} + static int do_method_for_all_elements (SLang_Array_Type *at, int (*method)(SLang_Array_Type *, SLindex_Type *, @@ -259,7 +267,7 @@ { SLindex_Type dims SLARRAY_MAX_DIMS; SLindex_Type *max_dims; - unsigned int num_dims; + unsigned int num_dims, changed_index; if (at->num_elements == 0) return 0; @@ -274,7 +282,7 @@ if (-1 == (*method) (at, dims, client_data)) return -1; } - while (0 == _pSLarray_next_index (dims, max_dims, num_dims)); + while (0 == next_index (dims, max_dims, num_dims, &changed_index)); return 0; } @@ -312,6 +320,26 @@ free_array (at); } +/* Here, a and b are assumed to be non-negative */ +static int check_overflow_mult_i (SLindex_Type a, SLindex_Type b, SLindex_Type *cp) +{ + if ((a < 0) || (b < 0) || ((b > 0) && (a > INT_MAX/b))) + return -1; + + *cp = a*b; + + return 0; +} + +static int check_overflow_mult_ui (SLuindex_Type a, SLindex_Type b, SLuindex_Type *cp) +{ + if ((b < 0) || ((b > 0) && (a > UINT_MAX/(SLuindex_Type)b))) + return -1; + + *cp = a*(SLuindex_Type)b; + return 0; +} + SLang_Array_Type * SLang_create_array1 (SLtype type, int read_only, VOID_STAR data, SLindex_Type *dims, unsigned int num_dims, int no_init) @@ -366,16 +394,14 @@ num_elements = 1; for (i = 0; i < num_dims; i++) { - SLindex_Type new_num_elements; at->dimsi = dimsi; - new_num_elements = dimsi * num_elements; - if (dimsi && (new_num_elements/dimsi != num_elements)) + + if (-1 == check_overflow_mult_i (num_elements, dimsi, &num_elements)) { throw_size_error (SL_Index_Error); free_array (at); return NULL; } - num_elements = new_num_elements; } /* Now set the rest of the unused dimensions to 1. This makes it easier @@ -395,10 +421,12 @@ return at; } - size = (num_elements * sizeof_type); - if ((size/sizeof_type != num_elements) || (size < 0)) + /* SLmalloc is currently limited to the use of unsigned integers. + * So include the size of the type as well. + */ + if (-1 == check_overflow_mult_i (num_elements, sizeof_type, &size)) { - throw_size_error (SL_INVALID_PARM); + throw_size_error (SL_Index_Error); free_array (at); return NULL; } @@ -563,7 +591,7 @@ } imax = at->num_elements; - + vdata = (VOID_STAR) _SLcalloc (imax, at->sizeof_type); if (vdata == NULL) return -1; @@ -588,6 +616,13 @@ } } +static void do_index_error (SLuindex_Type i, SLindex_Type n) +{ + _pSLang_verror (SL_Index_Error, "Array index %lu out of allowed range 0<=index<%ld", + (unsigned long)i, (long)n); +} + + /* If *is_index_array!=0, then only one index object is returned, which is * to index all the elements, and not just a single dimension. */ @@ -655,6 +690,7 @@ SLindex_Type first_index, last_index; SLindex_Type delta = r->delta; SLindex_Type n; + int ok = 1; if (num_indices == 1)/* could be index array */ n = (SLindex_Type)num_elements;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarrfun.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarrfun.c
Changed
@@ -1,6 +1,6 @@ /* Advanced array manipulation routines for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -795,7 +795,7 @@ (*fun)(a, b, c, a_loops, a_stride, b_loops, b_inc, ai_dims); (void) SLang_push_array (c, 1); - /* drop */ + /* fall through */ free_and_return: SLang_free_array (a); @@ -912,7 +912,8 @@ old_num_dims = 1; } - fcon = (SLarray_Contract_Fun_Type *) c->f; + /* Use double cast to avoid gcc warning */ + fcon = (SLarray_Contract_Fun_Type *) (SLFvoid_Star) c->f; fmap = c->f; if (use_contraction @@ -1537,7 +1538,7 @@ /* Usage: array_swap (a, i, j ,dim); (dim not yet supported) */ static void array_swap (void) { - int i, j; + SLindex_Type i, j; int len; unsigned char *src, *dst; size_t sizeof_type; @@ -1554,15 +1555,16 @@ have_dim = 1; } - if ((-1 == SLang_pop_integer (&j)) - || (-1 == SLang_pop_integer (&i))) + if ((-1 == SLang_pop_array_index (&j)) + || (-1 == SLang_pop_array_index (&i)) + || (-1 == pop_writable_array (&at))) return; if (i == j) - return; /* leave array on stack */ - - if (-1 == pop_writable_array (&at)) - return; + { + SLang_free_array (at); + return; + } if (have_dim) { @@ -1835,7 +1837,7 @@ case 3: if (-1 == SLang_pop_array_index (&istart)) return -1; - /* drop */ + /* fall through */ case 2: if (-1 == SLstack_exch (0, 1)) return -1;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarrmis.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarrmis.c
Changed
@@ -1,6 +1,6 @@ /* Misc Array Functions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slassoc.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slassoc.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -506,7 +506,7 @@ goto free_and_return; ret = 0; - /* drop */ + /* fall through */ free_and_return: @@ -530,12 +530,12 @@ if (-1 == SLreverse_stack (2)) return -1; has_default_value = 1; - /* drop */ + /* fall through */ case 1: if (0 == SLang_pop_datatype (&type)) break; num_dims--; - /* drop */ + /* fall through */ default: SLdo_pop_n (num_dims); _pSLang_verror (SL_SYNTAX_ERROR, "Usage: Assoc_Type DataType_Type");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slboseos.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slboseos.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -28,6 +28,8 @@ static SLang_Name_Type *EOS_Callback_Handler = NULL; static SLang_Name_Type *BOF_Callback_Handler = NULL; static SLang_Name_Type *EOF_Callback_Handler = NULL; +static SLang_Name_Type *BOF_Compile_Hook = NULL; +static SLang_Name_Type *BOS_Compile_Hook = NULL; static void set_bos_eos_handlers (SLang_Name_Type *bos, SLang_Name_Type *eos) { @@ -51,6 +53,20 @@ EOF_Callback_Handler = eof; } +static void unset_bof_compile_hook (void) +{ + if (BOF_Compile_Hook != NULL) + SLang_free_function (BOF_Compile_Hook); + BOF_Compile_Hook = NULL; +} + +static void unset_bos_compile_hook (void) +{ + if (BOS_Compile_Hook != NULL) + SLang_free_function (BOS_Compile_Hook); + BOS_Compile_Hook = NULL; +} + static int Handler_Active = 0; int _pSLcall_bos_handler (SLFUTURE_CONST char *file, int line) @@ -113,6 +129,7 @@ return status; } + int _pSLcall_bof_handler (SLFUTURE_CONST char *fun, SLFUTURE_CONST char *file) { int status = 0, err; @@ -169,6 +186,42 @@ return status; } +int _pSLcall_bos_compile_hook (const char *file, long linenum) +{ + if (_pSLang_Error || (NULL == BOS_Compile_Hook)) + return 0; + + if (file == NULL) file = ""; + if ((-1 == SLang_start_arg_list ()) + || (-1 == SLang_push_string ((char *)file)) + || (-1 == SLclass_push_int_obj (SLANG_INT_TYPE, (int) linenum)) + || (-1 == SLang_end_arg_list ()) + || (-1 == SLexecute_function (BOS_Compile_Hook))) + { + unset_bos_compile_hook (); + return -1; + } + return 0; +} + +int _pSLcall_bof_compile_hook (const char *file, const char *func) +{ + if (_pSLang_Error || (NULL == BOF_Compile_Hook)) + return 0; + + if (file == NULL) file = ""; + if ((-1 == SLang_start_arg_list ()) + || (-1 == SLang_push_string ((char *)file)) + || (-1 == SLang_push_string ((char *)func)) + || (-1 == SLang_end_arg_list ()) + || (-1 == SLexecute_function (BOF_Compile_Hook))) + { + unset_bof_compile_hook (); + return -1; + } + return 0; +} + static int pop_new_push_old (SLang_Name_Type **handler) { SLang_Name_Type *new_handler; @@ -214,6 +267,16 @@ (void) pop_new_push_old (&EOF_Callback_Handler); } +static void set_bof_compile_hook (void) +{ + (void) pop_new_push_old (&BOF_Compile_Hook); +} + +static void set_bos_compile_hook (void) +{ + (void) pop_new_push_old (&BOS_Compile_Hook); +} + #if SLANG_HAS_DEBUGGER_SUPPORT static SLang_Name_Type *Debug_Hook = NULL; static int Debug_Handler_Active = 0; @@ -366,6 +429,8 @@ MAKE_INTRINSIC_0("_set_eos_handler", set_eos_handler, SLANG_VOID_TYPE), MAKE_INTRINSIC_0("_set_bof_handler", set_bof_handler, SLANG_VOID_TYPE), MAKE_INTRINSIC_0("_set_eof_handler", set_eof_handler, SLANG_VOID_TYPE), + MAKE_INTRINSIC_0("_set_bof_compile_hook", set_bof_compile_hook, SLANG_VOID_TYPE), + MAKE_INTRINSIC_0("_set_bos_compile_hook", set_bos_compile_hook, SLANG_VOID_TYPE), #if SLANG_HAS_DEBUGGER_SUPPORT MAKE_INTRINSIC_0("_set_frame_variable", set_frame_variable, SLANG_VOID_TYPE), MAKE_INTRINSIC_IS("_get_frame_variable", get_frame_variable, SLANG_VOID_TYPE),
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slbstr.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slbstr.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -899,7 +899,7 @@ (void) SLang_push_bstring (bstr); SLbstring_free (bstr); } - /* drop */ + /* fall through */ free_and_return: for (i = 0; i < nargs; i++)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slclass.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slclass.c
Changed
@@ -1,6 +1,6 @@ /* User defined objects */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcmd.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcmd.c
Changed
@@ -1,6 +1,6 @@ /* cmd line facility for slang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -252,6 +252,7 @@ /* variable argument number */ case 'v': if (token_present == 0) break; + /* fall through */ case 'V': if (token_present == 0) { @@ -272,6 +273,7 @@ case 's': if (token_present == 0) break; + /* fall through */ case 'S': if (token_present == 0) { @@ -288,6 +290,7 @@ /* integer argument */ case 'i': if (token_present == 0) break; + /* fall through */ case 'I': if ((token_present == 0) || (SLANG_INT_TYPE != guess_type)) { @@ -303,6 +306,7 @@ #if SLANG_HAS_FLOAT case 'f': if (token_present == 0) break; + /* fall through */ case 'F': if ((token_present == 0) || (SLANG_STRING_TYPE == guess_type)) { @@ -316,6 +320,7 @@ /* Generic type */ case 'g': if (token_present == 0) break; + /* fall through */ case 'G': if (token_present == 0) {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcmplex.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcmplex.c
Changed
@@ -1,6 +1,6 @@ /* Complex Data Type definition for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcommon.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcommon.c
Changed
@@ -2,7 +2,7 @@ * links to the library. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcompat.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcompat.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slconfig.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slconfig.h
Changed
@@ -1,6 +1,6 @@ /* This configuration file is for all non-Unix OS */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -173,6 +173,7 @@ #if defined(__unix__) || (defined(VMS) && (__VMS_VER >= VMS_VERSION_700)) # define HAVE_KILL 1 # define HAVE_CHOWN 1 +# define HAVE_FLOCK 1 #endif #undef HAVE_LSTAT
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcurses.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcurses.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcurses.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcurses.h
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -25,6 +25,10 @@ # include <slang.h> #endif +#ifdef __cplusplus +extern "C" { +#endif + /* This is a temporary hack until lynx is fixed to not include this file. */ #ifndef LYCURSES_H @@ -105,7 +109,7 @@ #define scanw SLcurses_scanw #endif -extern SLcurses_Window_Type *SLcurses_Stdscr; +SL_EXTERN SLcurses_Window_Type *SLcurses_Stdscr; #define WINDOW SLcurses_Window_Type #define stdscr SLcurses_Stdscr @@ -204,7 +208,7 @@ extern int SLcurses_endwin (void); #define endwin SLcurses_endwin -extern int SLcurses_Is_Endwin; +SL_EXTERN int SLcurses_Is_Endwin; #define isendwin() SLcurses_Is_Endwin #define keypad(w,x) ((w)->use_keypad = (x)) @@ -242,7 +246,7 @@ (w)->scroll_max=(w)->nrows, \ wscrl((w), -1)) -extern SLcurses_Char_Type SLcurses_Acs_Map 128; +SL_EXTERN SLcurses_Char_Type SLcurses_Acs_Map 128; #define acs_map SLcurses_Acs_Map #define ACS_ULCORNER (acs_mapSLSMG_ULCORN_CHAR) @@ -300,7 +304,7 @@ #define COLOR_CYAN SLSMG_COLOR_CYAN #define COLOR_WHITE SLSMG_COLOR_LGRAY -extern int SLcurses_Num_Colors; +SL_EXTERN int SLcurses_Num_Colors; #define COLORS SLcurses_Num_Colors #define COLOR_PAIRS (SLcurses_Num_Colors*SLcurses_Num_Colors) @@ -338,7 +342,7 @@ extern int SLcurses_winsch (SLcurses_Window_Type *, int); #define winsch SLcurses_winsch -extern int SLcurses_Esc_Delay;/* ESC expire time in milliseconds (ncurses compatible) */ +SL_EXTERN int SLcurses_Esc_Delay;/* ESC expire time in milliseconds (ncurses compatible) */ #define ESCDELAY SLcurses_Esc_Delay extern int SLcurses_clearok (SLcurses_Window_Type *, int); @@ -366,7 +370,9 @@ /* These have no place in C */ #define TRUE 1 #define FALSE 0 -#define bool int +#if !defined(_STDBOOL) /* MSVC v18+ */ +# define bool int +#endif /* Lynx compatability */ #else @@ -387,3 +393,7 @@ #define endwin SLsmg_reset_smg(),SLang_reset_tty #endif + +#ifdef __cplusplus +} +#endif
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sldisply.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sldisply.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -98,8 +98,8 @@ * * The bits are split so we can maintain ABI compatibility on 64 bit machines. */ -#if SLTT_HAS_TRUECOLOR_SUPPORT && (SIZEOF_LONG == 8) static int Has_True_Color = 0; +#if SLTT_HAS_TRUECOLOR_SUPPORT && (SIZEOF_LONG == 8) # if 0 # define FG_MASK_LOW 0x0000000000FFFFFFULL # define FG_MASK_HIGH 0x0200000000000000ULL @@ -153,8 +153,11 @@ # define MAKE_COLOR(fg, bg) (((fg)<<8) | ((bg)<<16)) #endif -int SLtt_Screen_Cols = 80; -int SLtt_Screen_Rows = 24; +#define DEFAULT_SCREEN_COLS (80) +#define DEFAULT_SCREEN_ROWS (24) + +int SLtt_Screen_Cols = DEFAULT_SCREEN_COLS; +int SLtt_Screen_Rows = DEFAULT_SCREEN_ROWS; int SLtt_Term_Cannot_Insert = 0; int SLtt_Term_Cannot_Scroll = 0; int SLtt_Use_Ansi_Colors = 0; @@ -308,14 +311,70 @@ static int Cursor_Set; /* 1 if cursor position known, 0 * if not. -1 if only row is known */ -/* This is used only in relative-cursor-addressing mode */ -static SLsmg_Char_Type Display_Start_CharsSLTT_MAX_SCREEN_ROWS; - #define MAX_OUTPUT_BUFFER_SIZE 4096 - static unsigned char Output_BufferMAX_OUTPUT_BUFFER_SIZE; static unsigned char *Output_Bufferp = Output_Buffer; +/* This is used only in relative-cursor-addressing mode */ +static SLsmg_Char_Type Display_Start_Chars_BufDEFAULT_SCREEN_ROWS; +static SLsmg_Char_Type *Display_Start_Chars = Display_Start_Chars_Buf; +static unsigned int Display_Start_Chars_Nrows = DEFAULT_SCREEN_ROWS; + +static SLsmg_Char_Type Smart_Puts_Static_BufferDEFAULT_SCREEN_COLS+1; +static SLsmg_Char_Type *Smart_Puts_Buffer = Smart_Puts_Static_Buffer; +static unsigned int Smart_Puts_Buffer_Ncols = DEFAULT_SCREEN_COLS; + +/* Reallocate buffers for large screens and update SLtt_Screen_Rows/Cols vars */ +static int resize_screen_buffers (unsigned int r, unsigned int c) +{ + int status; + + if (c <= Smart_Puts_Buffer_Ncols) + SLtt_Screen_Cols = c; + else + { + SLsmg_Char_Type *s; + + s = (SLsmg_Char_Type *)SLmalloc(sizeof(SLsmg_Char_Type)*(c+1)); + if (s != NULL) + { + if (Smart_Puts_Buffer != Smart_Puts_Static_Buffer) + SLfree ((char *)Smart_Puts_Buffer); + Smart_Puts_Buffer = s; + Smart_Puts_Buffer_Ncols = c; + SLtt_Screen_Cols = c; + } + else + { + /* No update -- keep screen size */ + status = -1; + } + } + + if (r <= Display_Start_Chars_Nrows) + SLtt_Screen_Rows = r; + else + { + SLsmg_Char_Type *s; + + s = (SLsmg_Char_Type *)SLcalloc(r,sizeof(SLsmg_Char_Type)); + if (s != NULL) + { + if (Display_Start_Chars != Display_Start_Chars_Buf) + SLfree ((char *)Display_Start_Chars); + Display_Start_Chars = s; + Display_Start_Chars_Nrows = r; + SLtt_Screen_Rows = r; + } + else + { + /* No update -- keep screen size */ + status = -1; + } + } + return status; +} + unsigned long SLtt_Num_Chars_Output = 0; int _pSLusleep (unsigned long usecs) @@ -456,7 +515,8 @@ int zero_pad; int field_width; int variables 26; - int stack 64; +#define STACK_SIZE 64 + int stack STACK_SIZE; unsigned int stack_len; int parms 10; #define STACK_POP (stack_len ? stack--stack_len : 0) @@ -483,7 +543,7 @@ fmt_max = fmt + strlen (fmt); - while ((fmt < fmt_max) && (b < bmax)) + while ((fmt < fmt_max) && (b < bmax) && (stack_len < STACK_SIZE)) { unsigned char ch = *fmt++; @@ -534,7 +594,7 @@ break; zero_pad = 1; fmt++; - /* drop */ + /* fall through */ case '2': case '3': @@ -560,7 +620,7 @@ } field_width = (ch - '0'); - /* drop */ + /* fall through */ case 'd': z = STACK_POP; @@ -711,7 +771,7 @@ /* z == 0 and test has failed. So, skip past this entire if * expression to the matching else or matching endif. */ - /* drop */ + /* fall through */ case 'e': /* else */ parse_level = 0; @@ -1092,13 +1152,13 @@ SLtt_flush_output (); } -static void write_string_with_care (SLCONST char *); +static void write_string_with_care (SLCONST char *, unsigned int); static void del_eol (void) { if ((Cursor_c == 0) && (Use_Relative_Cursor_Addressing) - && (Cursor_r < SLTT_MAX_SCREEN_ROWS)) + && (Cursor_r < SLtt_Screen_Rows)) { Display_Start_CharsCursor_r.nchars = 0; } @@ -1112,7 +1172,7 @@ while (Cursor_c < SLtt_Screen_Cols) { - write_string_with_care (" "); + write_string_with_care (" ", 1); Cursor_c++; } Cursor_c = SLtt_Screen_Cols - 1; @@ -1792,13 +1852,10 @@ /* The whole point of this routine is to prevent writing to the last column * and last row on terminals with automatic margins. */ -static void write_string_with_care (SLCONST char *str) +static void write_string_with_care (SLCONST char *str, unsigned int len) { - SLstrlen_Type len; - - if (str == NULL) return; + if ((str == NULL) || (len == 0)) return; - len = strlen (str); if (Automatic_Margins && (Cursor_r + 1 == SLtt_Screen_Rows)) { if (_pSLtt_UTF8_Mode == 0) @@ -1816,38 +1873,55 @@ } else { - SLstrlen_Type nchars = SLutf8_strlen((SLuchar_Type *)str, 1); + SLstrlen_Type nchars; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sldostty.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sldostty.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -495,7 +495,7 @@ break; /* ^space = ^@ */ scan = 3; /* send back Ctrl-@ => ^@^C */ - /* drop */ + /* fall through */ case 0xe0: case 0: /* extended key code */ ch = _pSLpc_convert_scancode (scan, 0, 1);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slerr.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slerr.c
Changed
@@ -1,6 +1,6 @@ /* error handling common to all routines. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slerrno.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slerrno.c
Changed
@@ -2,7 +2,7 @@ * way so that they may be used in slang scripts. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -82,6 +82,10 @@ # define EAGAIN -1 #endif {"Try again", EAGAIN, "EAGAIN"}, +#ifndef EWOULDBLOCK +# define EWOULDBLOCK -1 +#endif + {"Operation would block", EWOULDBLOCK, "EWOULDBLOCK"}, #ifndef ENOMEM # define ENOMEM -1 #endif @@ -566,7 +570,7 @@ if (e != NULL) /* already initialized */ return 0; - if ((-1 == SLadd_intrinsic_function ("errno_string", (FVOID_STAR) intrin_errno_string, + if ((-1 == SLadd_intrinsic_function ("errno_string", (FVOID_STAR)(SLFvoid_Star)intrin_errno_string, SLANG_STRING_TYPE, 0)) || (-1 == SLadd_intrinsic_variable ("errno", (VOID_STAR)&_pSLerrno_errno, SLANG_INT_TYPE, 1))) return -1;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slexcept.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slexcept.c
Changed
@@ -1,6 +1,6 @@ /* Exception Handling */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -315,15 +315,15 @@ if (-1 == SLang_pop (&Object_Thrown)) return -1; Object_Thrownp = &Object_Thrown; - /* drop */ + /* fall through */ case 2: if (-1 == SLang_pop_slstring (&msg)) { free_thrown_object (); return -1; } + /* fall through */ case 1: - /* drop */ if (-1 == _pSLerr_pop_exception (&e)) { SLang_free_slstring (msg);/* NULL ok */
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slfile.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slfile.c
Changed
@@ -1,6 +1,6 @@ /* file stdio intrinsics for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slfpu.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slfpu.c
Changed
@@ -1,6 +1,6 @@ /* Floating point exceptions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slgetkey.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slgetkey.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -45,8 +45,8 @@ SLang_Input_Buffer_Len--; imax = SLang_Input_Buffer_Len; - SLMEMCPY ((char *) SLang_Input_Buffer, - (char *) (SLang_Input_Buffer + 1), imax); + memmove ((char *) SLang_Input_Buffer, + (char *) (SLang_Input_Buffer + 1), imax); } else if (SLANG_GETKEY_ERROR == (ch = _pSLsys_getkey ())) return ch; @@ -86,11 +86,9 @@ int SLang_buffer_keystring (unsigned char *s, unsigned int n) { - if (n + SLang_Input_Buffer_Len + 3 > SL_MAX_INPUT_BUFFER_LEN) return -1; - SLMEMCPY ((char *) SLang_Input_Buffer + SLang_Input_Buffer_Len, - (char *) s, n); + memcpy ((char *) SLang_Input_Buffer + SLang_Input_Buffer_Len, (char *) s, n); SLang_Input_Buffer_Len += n; return 0; }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slimport.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slimport.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slintall.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slintall.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slischar.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slischar.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slistruc.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slistruc.c
Changed
@@ -1,6 +1,6 @@ /* Intrinsic Structure type implementation */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slkeymap.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slkeymap.c
Changed
@@ -4,7 +4,7 @@ * structures. Also included are routines for managing the keymaps. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slkeypad.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slkeypad.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sllimits.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sllimits.h
Changed
@@ -1,6 +1,6 @@ /* sllimits.h */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -25,11 +25,16 @@ /* slstring.c: Size of the hash table used for strings (prime numbers) */ #define SLSTRING_HASH_TABLE_SIZE 140009 /* was 32327, 25013, 10007 */ /* Other large primes: 70001, 100003, 300007,... */ -/* slang.c: maximum size of run time stack */ +/* slang.c: The stack size grows dynamically from SLANG_INITIAL_STACK_LEN + * in increments of SLANG_INITIAL_STACK_LEN up to a maximum size of + * SLANG_MAX_STACK_LEN. + */ #ifdef __MSDOS_16BIT__ -# define SLANG_MAX_STACK_LEN 500 +# define SLANG_INITIAL_STACK_LEN 512 +# define SLANG_MAX_STACK_LEN 1024 #else -# define SLANG_MAX_STACK_LEN 2500 +# define SLANG_INITIAL_STACK_LEN (2*1024) +# define SLANG_MAX_STACK_LEN (1024*1024) #endif /* slang.c: This sets the size on the depth of function calls. @@ -93,12 +98,8 @@ #define SLANG_INNERPROD_BLOCK_SIZE 29 #if !defined(__MSDOS_16BIT__) -# define SLTT_MAX_SCREEN_COLS 512 -# define SLTT_MAX_SCREEN_ROWS 512 # define SLTT_MAX_COLORS 0x8000 /* consistent with SLSMG_COLOR_MASK */ #else -# define SLTT_MAX_SCREEN_ROWS 64 -# define SLTT_MAX_SCREEN_COLS 75 /* #define SLTT_MAX_COLORS 0x8000 */ /* use slvideo.c default */ #endif
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sllist.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sllist.c
Changed
@@ -1,6 +1,6 @@ /* List of objects */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -494,7 +494,7 @@ c1->num_elements = num; c->num_elements -= num; c->elementsc->num_elements = *obj; - /* drop */ + /* fall through */ the_return: @@ -1233,7 +1233,7 @@ } ret = 0; - /* drop */ + /* fall through */ free_and_return: SLang_free_object (&obj);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sllower.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sllower.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmalloc.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmalloc.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmath.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmath.c
Changed
@@ -1,6 +1,6 @@ /* sin, cos, etc, for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -1278,7 +1278,7 @@ case 3: if (-1 == SLang_pop_int (&use_factorial)) return; - /* drop */ + /* fall through */ case 2: break; @@ -1390,7 +1390,7 @@ } (void) SLang_push_array (y_at, 1); - /* drop */ + /* fall through */ free_and_return: free_array_or_scalar (&ast); SLang_free_array (coeff_at); @@ -1991,10 +1991,10 @@ for (i = 0; i < imax; i++) ci = LDEXP_FUN(ai, e_ptri); } - /* drop */ + /* fall through */ push_free_and_return: (void) SLang_push_array (c_at, 0); - /* drop */ + /* fall through */ free_and_return: if (e_at != NULL) SLang_free_array (e_at); SLang_free_array (c_at); @@ -2083,7 +2083,7 @@ if (0 == SLang_push_array (s_at, 0)) (void) SLang_push_array (c_at, 0); - /* drop */ + /* fall through */ free_and_return: if (c_at != NULL) SLang_free_array (c_at); if (s_at != NULL) SLang_free_array (s_at);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmemchr.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmemchr.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmemcmp.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmemcmp.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmemcpy.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmemcpy.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmemset.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmemset.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmisc.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmisc.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -145,7 +145,7 @@ case 'u': isunicode = 1; - /* drop */ + /* fall through */ case 'x': /* hex */ base = 16; max = '9'; @@ -644,7 +644,7 @@ _pSLang_verror (SL_SYNTAX_ERROR, "8 or 9 are not permitted in binary or octal numbers"); return -1; } - /* drop */ + /* fall through */ case '7': case '6': case '5': @@ -656,6 +656,7 @@ _pSLang_verror (SL_SYNTAX_ERROR, "Only digits 0 and 1 are permitted in binary numbers"); return -1; } + /* fall through */ case '1': case '0': ch1 -= '0'; @@ -756,7 +757,7 @@ _pSLang_verror (SL_SYNTAX_ERROR, "8 or 9 are not permitted in binary or octal numbers"); return -1; } - /* drop */ + /* fall through */ case '7': case '6': case '5': @@ -768,6 +769,7 @@ _pSLang_verror (SL_SYNTAX_ERROR, "Only digits 0 and 1 are permitted in binary numbers"); return -1; } + /* fall through */ case '1': case '0': ch1 -= '0';
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slnspace.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slnspace.c
Changed
@@ -1,7 +1,7 @@ /* -*- mode: C; mode: fold; -*- */ /* slnspace.c --- Name Space implementation */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slos2tty.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slos2tty.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slospath.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slospath.c
Changed
@@ -1,6 +1,6 @@ /* Pathname intrinsic functions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slpack.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slpack.c
Changed
@@ -1,6 +1,6 @@ /* Pack objects as a binary string */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -320,6 +320,7 @@ case 'S': case 'A': ft->pad = ' '; + /* fall through */ case 'a': case 's': case 'z': @@ -857,7 +858,7 @@ at->num_refs++; bt = at; } - else/* drop */ + else/* fall through */ #endif if (NULL == (bt = SLang_duplicate_array (at))) return NULL;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slparse.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slparse.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -3130,7 +3130,7 @@ _pSLparse_error (SL_SYNTAX_ERROR, "Expecting ')'", ctok, 0); break; } - /* drop */ + /* fall through */ default: simple_expression (ctok);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slpath.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slpath.c
Changed
@@ -1,6 +1,6 @@ /* Pathname and filename functions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slposdir.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slposdir.c
Changed
@@ -1,6 +1,6 @@ /* file intrinsics for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -184,84 +184,176 @@ return SLang_push_cstruct ((VOID_STAR) &s, Stat_Struct); } -static void stat_cmd (char *file) +typedef struct { - struct stat st; - int status; - int opt_attrs; -#if defined(__MSDOS__) || defined(__WIN32__) - unsigned int len = strlen (file); - int is_malloced = 0; + int type; + int fd; + char *path; + SLFile_FD_Type *f; + SLang_MMT_Type *mmt; + FILE *fp; +} +Stat_Arg_Type; - if (len && ((filelen-1 == '\\') || (filelen-1 == '/'))) + +static void free_stat_arg (Stat_Arg_Type *sa) +{ + switch (sa->type) { - file = SLmake_nstring (file, len-1); - if (file == NULL) - return; + default: + case SLANG_INT_TYPE: + break; + + case SLANG_FILE_FD_TYPE: + if (sa->f != NULL) SLfile_free_fd (sa->f); + break; - is_malloced = 1; + case SLANG_FILE_PTR_TYPE: + if (sa->mmt != NULL) SLang_free_mmt (sa->mmt); + break; + + case SLANG_STRING_TYPE: + SLang_free_slstring (sa->path); + break; } -#endif +} - while ((-1 == (status = stat (file, &st))) - && (is_interrupt (errno))) - continue; +static int pop_stat_arg (Stat_Arg_Type *sa) +{ + int status; - if (status == 0) - { -#ifdef __WIN32__ - opt_attrs = GetFileAttributes (file); -#else - opt_attrs = 0; -#endif + memset (sa, 0, sizeof(Stat_Arg_Type)); - push_stat_struct (&st, opt_attrs); - } - else + sa->type = SLang_peek_at_stack (); + switch (sa->type) { - _pSLerrno_errno = errno; - SLang_push_null (); - } + default: + case SLANG_INT_TYPE: + status = SLang_pop_int (&sa->fd); + break; + case SLANG_FILE_FD_TYPE: + if (0 == (status = SLfile_pop_fd (&sa->f))) + status = SLfile_get_fd (sa->f, &sa->fd); + break; + + case SLANG_FILE_PTR_TYPE: + if (0 == (status = SLang_pop_fileptr (&sa->mmt, &sa->fp))) + sa->fd = fileno (sa->fp); + break; + + case SLANG_STRING_TYPE: + case SLANG_BSTRING_TYPE: + sa->type = SLANG_STRING_TYPE; + if (0 == (status = SLang_pop_slstring (&sa->path))) + { #if defined(__MSDOS__) || defined(__WIN32__) - if (is_malloced) - SLfree (file); + char *file = sa->path; + unsigned int len = strlen (file); + + if (len && ((filelen-1 == '\\') || (filelen-1 == '/'))) + { + file = SLmake_nstring (file, len-1); + if (file == NULL) + status = -1; + else + { + SLang_free_slstring (sa->path); + sa->path = file; + } + } +#endif + } + break; + } + + if (status == -1) + { + free_stat_arg (sa); +#ifdef EINVAL + (void) SLerrno_set_errno (EINVAL); #endif + } + return status; } -static void lstat_cmd (char *file) +static int do_xstat (int x) { -#ifdef HAVE_LSTAT + Stat_Arg_Type sa; struct stat st; - int opt_attrs; + int status = 0; + int opt_attrs = 0; + + if (-1 == pop_stat_arg (&sa)) + return -1; - while (-1 == lstat (file, &st)) + switch (x) { - if (is_interrupt (errno)) - continue; + case 'l': + if (sa.type == SLANG_STRING_TYPE) + { +#ifdef HAVE_LSTAT + while ((-1 == (status = lstat (sa.path, &st))) + && (is_interrupt (errno))) + ; + break; +#endif + } + /* fall through */ + default: + case 's': + if (sa.type == SLANG_STRING_TYPE) + { + while ((-1 == (status = stat (sa.path, &st))) + && (is_interrupt (errno))) + ; +#ifdef __WIN32__ + if (status == 0) opt_attrs = GetFileAttributes (sa.path); +#endif + } + else + { + while ((-1 == (status = fstat (sa.fd, &st))) + && (is_interrupt (errno))) + ; +#ifdef __WIN32__ + if (status == 0) + { + /* GetFileAttributes for fd??? */ + } +#endif + } + break; + } + if (status == 0) + { + status = push_stat_struct (&st, opt_attrs); + } + else + { _pSLerrno_errno = errno; - SLang_push_null (); - return;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slposio.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slposio.c
Changed
@@ -1,7 +1,7 @@ /* This module implements an interface to posix system calls */ /* file stdio intrinsics for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -999,6 +999,26 @@ return status; } +#ifdef HAVE_FLOCK +static int flock_cmd (int *op) +{ + SLFile_FD_Type *f; + SLang_MMT_Type *mmt; + int fd, status; + + if (-1 == pop_fd (&fd, &f, &mmt)) + return 0; /* invalid descriptor */ + + while ((-1 == (status = flock (fd, *op))) + && is_interrupt (errno, 0)) + ; + + if (mmt != NULL) SLang_free_mmt (mmt); + if (f != NULL) SLfile_free_fd (f); + return status; +} +#endif + #define I SLANG_INT_TYPE #define V SLANG_VOID_TYPE #define F SLANG_FILE_FD_TYPE @@ -1024,6 +1044,9 @@ #if defined(TTYNAME_R) MAKE_INTRINSIC_0("ttyname", posix_ttyname, V), #endif +#ifdef HAVE_FLOCK + MAKE_INTRINSIC_1("flock", flock_cmd, I, I), +#endif SLANG_END_INTRIN_FUN_TABLE }; #undef I @@ -1075,6 +1098,19 @@ #ifdef O_LARGEFILE MAKE_ICONSTANT("O_LARGEFILE", O_LARGEFILE), #endif +#ifdef LOCK_SH + MAKE_ICONSTANT("LOCK_SH", LOCK_SH), +#endif +#ifdef LOCK_NB + MAKE_ICONSTANT("LOCK_NB", LOCK_NB), +#endif +#ifdef LOCK_EX + MAKE_ICONSTANT("LOCK_EX", LOCK_EX), +#endif +#ifdef LOCK_UN + MAKE_ICONSTANT("LOCK_UN", LOCK_UN), +#endif + SLANG_END_ICONST_TABLE };
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slprepr.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slprepr.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slproc.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slproc.c
Changed
@@ -1,6 +1,6 @@ /* Process specific system calls */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slregexp.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slregexp.c
Changed
@@ -1,6 +1,6 @@ /* ed style regular expressions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -50,24 +50,25 @@ #define SET_BIT(b, n) b(unsigned int) (n) >> 3 |= 1 << ((unsigned int) (n) % 8) #define TEST_BIT(b, n) (b(unsigned int)(n) >> 3 & (1 << ((unsigned int) (n) % 8))) -#define LITERAL 1 -#define RANGE 2 /* ... */ -#define ANY 3 /* . */ -#define BOL 4 /* ^ */ -#define EOL 5 /* $ */ -#define NTH_MATCH 6 /* \1 \2 ... \9 */ -#define OPAREN 7 /* \( */ -#define CPAREN 0x8 /* \) */ -#define ANY_DIGIT 0x9 /* \d */ -#define BOW 0xA /* \< */ -#define EOW 0xB /* \> */ -#if 0 -#define NOT_LITERAL 0xC /* \~ */ -#endif -#define STAR 0x80 /* * */ -#define LEAST_ONCE 0x40 /* + */ -#define MAYBE_ONCE 0x20 /* ? */ -#define MANY 0x10 /* {n,m} */ +#define LITERAL 0x01 +#define RANGE 0x02 /* ... */ +#define ANY 0x03 /* . */ +#define BOL 0x04 /* ^ */ +#define EOL 0x05 /* $ */ +#define NTH_MATCH 0x06 /* \1 \2 ... \9 */ +#define OPAREN 0x07 /* \( */ +#define CPAREN 0x08 /* \) */ +#define ANY_DIGIT 0x09 /* \d */ +#define ANY_NONDIGIT 0x0A /* \D */ +#define ANY_SPACE 0x0B /* \s */ +#define ANY_NONSPACE 0x0C /* \S */ +#define BOW 0x0D /* \< */ +#define EOW 0x0E /* \> */ +#define STAR 0x10 /* * */ +#define LEAST_ONCE 0x20 /* + */ +#define MAYBE_ONCE 0x40 /* ? */ +#define MANY 0x80 /* {n,m} */ + /* The rest are additions */ #define YES_CASE (STAR | BOL) #define NO_CASE (STAR | EOL) @@ -78,14 +79,8 @@ /* FIXME: UTF8 */ static unsigned char Word_Chars256; #define IS_WORD_CHAR(x) Word_Chars(unsigned int) (x) - -#if 0 -static int ctx->open_paren_number; -static char Closed_Paren_Matches10; - -static SLRegexp_Type *This_Reg; -static unsigned char *This_Str; -#endif +static unsigned char Space_Chars256; +#define IS_WHITESPACE(x) (0 != Space_Chars(unsigned int)(x)) typedef struct { @@ -116,6 +111,42 @@ return (str); } +#define CASES(_X, _expr_str) \ + case _X: \ + if ((str >= estr) || (0 == (_expr_str))) return NULL; \ + str++; \ + break; \ + case MAYBE_ONCE | _X: \ + save_str = str; \ + if ((str < estr) && (_expr_str)) str++; \ + goto match_rest; \ + case LEAST_ONCE | _X: \ + if ((str >= estr) || (0 == (_expr_str))) return NULL; \ + str++; \ + /* fall through */ \ + case STAR | _X: \ + save_str = str; \ + while ((str < estr) && (_expr_str)) str++; \ + goto match_rest; \ + case MANY | _X: \ + /* minimum number to match--- could be 0 */ \ + n = n0 = (int) (unsigned char) *regexp++; \ + /* maximum number to match */ \ + n1 = (int) (unsigned char) *regexp++; \ + while (n && (str < estr) && (_expr_str)) \ + { \ + n--; str++; \ + } \ + if (n) return NULL; \ + save_str = str; \ + n = n1 - n0; \ + while (n && (str < estr) && (_expr_str)) \ + { \ + n--; str++; \ + } \ + goto match_rest + + /* returns pointer to the end of regexp or NULL */ static SLCONST unsigned char *regexp_looking_at (Re_Context_Type *ctx, SLCONST unsigned char *str, SLCONST unsigned char *estr, @@ -170,53 +201,7 @@ break; } break; -#ifdef NOT_LITERAL - case NOT_LITERAL: - if ((str >= estr) || (*regexp == UPPERCASE(*str))) return (NULL); - str++; regexp++; - break; - - case MAYBE_ONCE | NOT_LITERAL: - save_str = str; - if ((str < estr) && (*regexp != UPPERCASE(*str))) str++; - regexp++; - goto match_rest; - - case NOT_LITERAL | LEAST_ONCE: /* match at least once */ - if ((str >= estr) || (UPPERCASE(*str) == UPPERCASE(*regexp))) return (NULL); - str++; - /* drop */ - case STAR | NOT_LITERAL: - save_str = str; p1 = *regexp; - while ((str < estr) && (UPPERCASE(*str) != p1)) str++; - regexp++; - goto match_rest; - - /* this type consists of the expression + two bytes that - determine number of matches to perform */ - case MANY | NOT_LITERAL: - p1 = *regexp; regexp++; - n = n0 = (int) (unsigned char) *regexp++; - /* minimum number to match--- could be 0 */ - n1 = (int) (unsigned char) *regexp++; - /* maximum number to match */ - while (n && (str < estr) && (p1 != UPPERCASE(*str))) - { - n--; - str++; - } - if (n) return (NULL); - - save_str = str; - n = n1 - n0; - while (n && (str < estr) && (p1 != UPPERCASE(*str))) - { - n--; - str++; - } - goto match_rest; -#endif /* NOT_LITERAL */ case LITERAL: if ((str >= estr) || (*regexp != UPPERCASE(*str))) return (NULL); str++; regexp++; @@ -231,7 +216,7 @@ case LITERAL | LEAST_ONCE: /* match at least once */ if ((str >= estr) || (UPPERCASE(*str) != UPPERCASE(*regexp))) return (NULL); str++; - /* drop */ + /* fall through */ case STAR | LITERAL: save_str = str; p1 = *regexp; while ((str < estr) && (UPPERCASE(*str) == p1)) str++; @@ -264,7 +249,8 @@ goto match_rest; case NTH_MATCH: - if ((str = do_nth_match(ctx, (int) (unsigned char) *regexp, str, estr)) == NULL) return(NULL); + if (NULL == (str = do_nth_match(ctx, (int) (unsigned char) *regexp, str, estr))) + return(NULL); regexp++; break; @@ -278,7 +264,7 @@ case LEAST_ONCE | NTH_MATCH: if ((str = do_nth_match(ctx, (int) (unsigned char) *regexp, str, estr)) == NULL) return(NULL); - /* drop */ + /* fall through */ case STAR | NTH_MATCH: save_str = str; while (NULL != (tmpstr = do_nth_match(ctx, (int) (unsigned char) *regexp, str, estr))) @@ -328,7 +314,7 @@ case LEAST_ONCE | RANGE: if ((str >= estr) || (0 == TEST_BIT(regexp, UPPERCASE(*str)))) return NULL; str++; - /* drop */ + /* fall through */
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slrline.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slrline.c
Changed
@@ -1,6 +1,6 @@ /* SLang_read_line interface --- uses SLang tty stuff */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -1211,7 +1211,7 @@ if (key->type == SLKEY_F_INTRINSIC) { int (*func)(SLrline_Type *); - func = (int (*)(SLrline_Type *)) key->f.f; + func = (int (*)(SLrline_Type *))(SLFvoid_Star) key->f.f; (void) (*func)(rli); @@ -1361,7 +1361,7 @@ return rl_select_line (This_RLI, next); } -#define AKEY(name,func) {name,(int (*)(void))func} +#define AKEY(name,func) {name,(FVOID_STAR)(SLFvoid_Star)func} static SLKeymap_Function_Type SLReadLine_Functions = { @@ -1436,7 +1436,7 @@ for (ch = ' '; ch < 256; ch++) { simple0 = (char) ch; - SLkm_define_key (simple, (FVOID_STAR) rl_self_insert, km); + SLkm_define_key (simple, (FVOID_STAR)(SLFvoid_Star)rl_self_insert, km); } #else ch = ' '; @@ -1450,61 +1450,61 @@ #endif /* NOT __DECC */ simple0 = SLang_Abort_Char; - SLkm_define_key (simple, (FVOID_STAR) rl_abort, km); + SLkm_define_key (simple, (FVOID_STAR)(SLFvoid_Star)rl_abort, km); #ifdef REAL_UNIX_SYSTEM simple0 = (char) 4; #else simple0 = (char) 26; #endif - SLkm_define_key (simple, (FVOID_STAR) rl_eof_insert, km); + SLkm_define_key (simple, (FVOID_STAR)(SLFvoid_Star) rl_eof_insert, km); #ifndef IBMPC_SYSTEM - SLkm_define_key ("^A", (FVOID_STAR) rl_prev_line, km); - SLkm_define_key ("^B", (FVOID_STAR) rl_next_line, km); - SLkm_define_key ("^C", (FVOID_STAR) rl_right, km); - SLkm_define_key ("^D", (FVOID_STAR) rl_left, km); - SLkm_define_key ("^OA", (FVOID_STAR) rl_prev_line, km); - SLkm_define_key ("^OB", (FVOID_STAR) rl_next_line, km); - SLkm_define_key ("^OC", (FVOID_STAR) rl_right, km); - SLkm_define_key ("^OD", (FVOID_STAR) rl_left, km); + SLkm_define_key ("^A", (FVOID_STAR)(SLFvoid_Star) rl_prev_line, km); + SLkm_define_key ("^B", (FVOID_STAR)(SLFvoid_Star) rl_next_line, km); + SLkm_define_key ("^C", (FVOID_STAR)(SLFvoid_Star) rl_right, km); + SLkm_define_key ("^D", (FVOID_STAR)(SLFvoid_Star) rl_left, km); + SLkm_define_key ("^OA", (FVOID_STAR)(SLFvoid_Star) rl_prev_line, km); + SLkm_define_key ("^OB", (FVOID_STAR)(SLFvoid_Star) rl_next_line, km); + SLkm_define_key ("^OC", (FVOID_STAR)(SLFvoid_Star) rl_right, km); + SLkm_define_key ("^OD", (FVOID_STAR)(SLFvoid_Star) rl_left, km); #else - SLkm_define_key ("^@H", (FVOID_STAR) rl_prev_line, km); - SLkm_define_key ("^@P", (FVOID_STAR) rl_next_line, km); - SLkm_define_key ("^@M", (FVOID_STAR) rl_right, km); - SLkm_define_key ("^@K", (FVOID_STAR) rl_left, km); - SLkm_define_key ("^@S", (FVOID_STAR) rl_del, km); - SLkm_define_key ("^@O", (FVOID_STAR) SLrline_eol, km); - SLkm_define_key ("^@G", (FVOID_STAR) SLrline_bol, km); - - SLkm_define_key ("\xE0H", (FVOID_STAR) rl_prev_line, km); - SLkm_define_key ("\xE0P", (FVOID_STAR) rl_next_line, km); - SLkm_define_key ("\xE0M", (FVOID_STAR) rl_right, km); - SLkm_define_key ("\xE0K", (FVOID_STAR) rl_left, km); - SLkm_define_key ("\xE0S", (FVOID_STAR) rl_del, km); - SLkm_define_key ("\xE0O", (FVOID_STAR) SLrline_eol, km); - SLkm_define_key ("\xE0G", (FVOID_STAR) SLrline_bol, km); + SLkm_define_key ("^@H", (FVOID_STAR)(SLFvoid_Star) rl_prev_line, km); + SLkm_define_key ("^@P", (FVOID_STAR)(SLFvoid_Star) rl_next_line, km); + SLkm_define_key ("^@M", (FVOID_STAR)(SLFvoid_Star) rl_right, km); + SLkm_define_key ("^@K", (FVOID_STAR)(SLFvoid_Star) rl_left, km); + SLkm_define_key ("^@S", (FVOID_STAR)(SLFvoid_Star) rl_del, km); + SLkm_define_key ("^@O", (FVOID_STAR)(SLFvoid_Star) SLrline_eol, km); + SLkm_define_key ("^@G", (FVOID_STAR)(SLFvoid_Star) SLrline_bol, km); + + SLkm_define_key ("\xE0H", (FVOID_STAR)(SLFvoid_Star) rl_prev_line, km); + SLkm_define_key ("\xE0P", (FVOID_STAR)(SLFvoid_Star) rl_next_line, km); + SLkm_define_key ("\xE0M", (FVOID_STAR)(SLFvoid_Star) rl_right, km); + SLkm_define_key ("\xE0K", (FVOID_STAR)(SLFvoid_Star) rl_left, km); + SLkm_define_key ("\xE0S", (FVOID_STAR)(SLFvoid_Star) rl_del, km); + SLkm_define_key ("\xE0O", (FVOID_STAR)(SLFvoid_Star) SLrline_eol, km); + SLkm_define_key ("\xE0G", (FVOID_STAR)(SLFvoid_Star) SLrline_bol, km); #endif - SLkm_define_key ("^C", (FVOID_STAR) rl_abort, km); - SLkm_define_key ("^E", (FVOID_STAR) SLrline_eol, km); - SLkm_define_key ("^G", (FVOID_STAR) rl_abort, km); - SLkm_define_key ("^I", (FVOID_STAR) rl_complete, km); - SLkm_define_key ("^A", (FVOID_STAR) SLrline_bol, km); - SLkm_define_key ("\r", (FVOID_STAR) rl_enter, km); - SLkm_define_key ("\n", (FVOID_STAR) rl_enter, km); - SLkm_define_key ("^K", (FVOID_STAR) rl_deleol, km); - SLkm_define_key ("^L", (FVOID_STAR) rl_deleol, km); - SLkm_define_key ("^U", (FVOID_STAR) rl_delbol, km); - SLkm_define_key ("^V", (FVOID_STAR) rl_del, km); - SLkm_define_key ("^D", (FVOID_STAR) rl_del, km); - SLkm_define_key ("^F", (FVOID_STAR) rl_right, km); - SLkm_define_key ("^B", (FVOID_STAR) rl_left, km); - SLkm_define_key ("^?", (FVOID_STAR) rl_bdel, km); - SLkm_define_key ("^H", (FVOID_STAR) rl_bdel, km); - SLkm_define_key ("^P", (FVOID_STAR) rl_prev_line, km); - SLkm_define_key ("^N", (FVOID_STAR) rl_next_line, km); - SLkm_define_key ("^R", (FVOID_STAR) rl_redraw, km); - SLkm_define_key ("`", (FVOID_STAR) rl_quote_insert, km); - SLkm_define_key ("\033\\", (FVOID_STAR) rl_trim, km); + SLkm_define_key ("^C", (FVOID_STAR)(SLFvoid_Star) rl_abort, km); + SLkm_define_key ("^E", (FVOID_STAR)(SLFvoid_Star) SLrline_eol, km); + SLkm_define_key ("^G", (FVOID_STAR)(SLFvoid_Star) rl_abort, km); + SLkm_define_key ("^I", (FVOID_STAR)(SLFvoid_Star) rl_complete, km); + SLkm_define_key ("^A", (FVOID_STAR)(SLFvoid_Star) SLrline_bol, km); + SLkm_define_key ("\r", (FVOID_STAR)(SLFvoid_Star) rl_enter, km); + SLkm_define_key ("\n", (FVOID_STAR)(SLFvoid_Star) rl_enter, km); + SLkm_define_key ("^K", (FVOID_STAR)(SLFvoid_Star) rl_deleol, km); + SLkm_define_key ("^L", (FVOID_STAR)(SLFvoid_Star) rl_deleol, km); + SLkm_define_key ("^U", (FVOID_STAR)(SLFvoid_Star) rl_delbol, km); + SLkm_define_key ("^V", (FVOID_STAR)(SLFvoid_Star) rl_del, km); + SLkm_define_key ("^D", (FVOID_STAR)(SLFvoid_Star) rl_del, km); + SLkm_define_key ("^F", (FVOID_STAR)(SLFvoid_Star) rl_right, km); + SLkm_define_key ("^B", (FVOID_STAR)(SLFvoid_Star) rl_left, km); + SLkm_define_key ("^?", (FVOID_STAR)(SLFvoid_Star) rl_bdel, km); + SLkm_define_key ("^H", (FVOID_STAR)(SLFvoid_Star) rl_bdel, km); + SLkm_define_key ("^P", (FVOID_STAR)(SLFvoid_Star) rl_prev_line, km); + SLkm_define_key ("^N", (FVOID_STAR)(SLFvoid_Star) rl_next_line, km); + SLkm_define_key ("^R", (FVOID_STAR)(SLFvoid_Star) rl_redraw, km); + SLkm_define_key ("`", (FVOID_STAR)(SLFvoid_Star) rl_quote_insert, km); + SLkm_define_key ("\033\\", (FVOID_STAR)(SLFvoid_Star) rl_trim, km); if (_pSLang_Error) return -1; RL_Keymap = km; @@ -2099,14 +2099,14 @@ if (Active_Rline_Info == NULL) return; - if (NULL == (f = (int (*)(SLrline_Type *)) (SLang_find_key_function(fun, Active_Rline_Info->keymap)))) + if (NULL == (f = (int (*)(SLrline_Type *))(SLFvoid_Star)SLang_find_key_function(fun, Active_Rline_Info->keymap))) { _pSLang_verror (SL_UndefinedName_Error, "rline internal function %s does not exist", fun); return; } (void) (*f)(Active_Rline_Info); - /* Active_Rline_Info->last_fun = (FVOID_STAR) f; */ + /* Active_Rline_Info->last_fun = (FVOID_STAR)(SLFvoid_Star) f; */ } static void rline_get_line_intrinsic (void) @@ -2327,6 +2327,8 @@ (void) SLang_push_function (last_key->f.slang_fun); return; } + break; + case SLKEY_F_KEYSYM: (void) SLang_push_uint (last_key->f.keysym); return;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slscanf.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slscanf.c
Changed
@@ -1,6 +1,6 @@ /* sscanf function for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -175,7 +175,7 @@ *xp = sign * strtod_l (buf, NULL, C_Locale); return 1; } - /* drop */ + /* fall through */ # endif # ifdef HAVE_STRTOD @@ -646,6 +646,7 @@ goto return_error; case 'D': is_long = 1; + /* fall through */ case 'd': if (is_short) { @@ -666,6 +667,7 @@ case 'U': is_long = 1; + /* fall through */ case 'u': if (is_short) { @@ -686,7 +688,7 @@ case 'I': is_long = 1; - /* drop */ + /* fall through */ case 'i': if ((s + 1 >= smax) || (*s != '0')) @@ -703,7 +705,7 @@ case 'O': is_long = 1; - /* drop */ + /* fall through */ case 'o': map = map8; base = 8; @@ -715,7 +717,7 @@ case 'X': is_long = 1; - /* drop */ + /* fall through */ case 'x': base = 16; map = map16; @@ -728,7 +730,7 @@ case 'E': case 'F': is_long = 1; - /* drop */ + /* fall through */ case 'e': case 'f': case 'g':
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slscroll.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slscroll.c
Changed
@@ -1,6 +1,6 @@ /* SLang Scrolling Window Routines */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slsearch.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slsearch.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slsig.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slsig.c
Changed
@@ -1,6 +1,6 @@ /* interpreter signal handling functions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -747,7 +747,7 @@ case 3: if (-1 == SLang_pop_double (&interval)) goto free_and_return; - /* drop */ + /* fall through */ case 2: default: if ((-1 == SLang_pop_double (&value))
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slsignal.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slsignal.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slsmg.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slsmg.c
Changed
@@ -1,6 +1,6 @@ /* SLang Screen management routines */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -41,9 +41,14 @@ #define TRASHED 0x2 static int Screen_Trashed; -static Screen_Type SL_ScreenSLTT_MAX_SCREEN_ROWS; +#define DEFAULT_NUM_SCREEN_ROWS (25) +static Screen_Type SL_Screen_StaticDEFAULT_NUM_SCREEN_ROWS; +static Screen_Type *SL_Screen = SL_Screen_Static; +static unsigned int SL_Screen_Num_Rows = DEFAULT_NUM_SCREEN_ROWS; + +static unsigned int Screen_Rows; +static unsigned int Screen_Cols; static int Start_Col, Start_Row; -static unsigned int Screen_Cols, Screen_Rows; static int This_Row, This_Col; static SLsmg_Color_Type This_Color; @@ -317,7 +322,7 @@ break; } mode = ACS_MODE_ASCII; - /* drop */ + /* fall through */ case ACS_MODE_ASCII: default: acs = UTF8_ACS_Map; @@ -1560,8 +1565,9 @@ static int init_smg (int mode) { - unsigned int i, len; SLsmg_Char_Type *old, *neew; + unsigned int num_screen_rows; + unsigned int i, len; Smg_Mode = mode; @@ -1569,10 +1575,22 @@ Bce_Color_Offset = _pSLtt_get_bce_color_offset (); #endif - Screen_Rows = *tt_Screen_Rows; - if (Screen_Rows > SLTT_MAX_SCREEN_ROWS) - Screen_Rows = SLTT_MAX_SCREEN_ROWS; + num_screen_rows = *tt_Screen_Rows; + if (num_screen_rows <= SL_Screen_Num_Rows) + Screen_Rows = num_screen_rows; + else + { + Screen_Type *s; + if (NULL != (s = (Screen_Type *)SLmalloc (num_screen_rows*sizeof(Screen_Type)))) + { + SL_Screen_Num_Rows = num_screen_rows; + if (SL_Screen != SL_Screen_Static) + SLfree ((char *)SL_Screen); + SL_Screen = s; + Screen_Rows = num_screen_rows; + } + } Screen_Cols = *tt_Screen_Cols; This_Col = This_Row = Start_Col = Start_Row = 0;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slstd.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slstd.c
Changed
@@ -2,7 +2,7 @@ /* Standard intrinsic functions for S-Lang. Included here are string and array operations */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slstdio.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slstdio.c
Changed
@@ -1,6 +1,6 @@ /* file stdio intrinsics for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -266,7 +266,7 @@ && (0 == SLang_push_mmt (mmt))) return 0; - /* drop */ + /* fall through */ return_error: if (fp != NULL) (*close_fun) (fp); @@ -473,10 +473,13 @@ return ret; } -static int read_one_line (FILE *fp, char **strp, SLstrlen_Type *lenp, int trim_trailing) +/* If trim = 1, trim trailing whitespace, if 2 trim leading, if 3 trim both */ +#define TRIM_TRAILING (0x1) +#define TRIM_LEADING (0x2) +static int read_one_line (FILE *fp, char **strp, SLstrlen_Type *lenp, int trim) { char buf512; - char *str; + char *str, *str0; size_t len; *strp = NULL; @@ -520,7 +523,7 @@ if (str == NULL) return 0; - if (trim_trailing) + if (trim & TRIM_TRAILING) { unsigned int len1 = len; while (len1) @@ -535,8 +538,18 @@ len = len1; } + str0 = str; + if (trim & TRIM_LEADING) + { + unsigned int i = 0; + while ((i < len) && (isspace ((unsigned char) stri))) + i++; + str += i; + len -= i; + } + *strp = SLang_create_nslstring (str, len); - if (str != buf) SLfree (str); + if (str0 != buf) SLfree (str0); if (*strp == NULL) return -1; @@ -569,7 +582,7 @@ return (int) len; } -static void stdio_fgetslines_internal (FILE *fp, unsigned int n) +static void stdio_fgetslines_internal (FILE *fp, unsigned int n, int trim) { unsigned int num_lines, max_num_lines; char **list; @@ -596,7 +609,7 @@ char *line; SLstrlen_Type len; - status = read_one_line (fp, &line, &len, 0); + status = read_one_line (fp, &line, &len, trim); if (status == -1) goto return_error; @@ -656,9 +669,10 @@ static void stdio_fgetslines (void) { - unsigned int n; FILE *fp; SLang_MMT_Type *mmt; + unsigned int n; + int trim; n = (unsigned int)-1; @@ -674,7 +688,9 @@ return; } - stdio_fgetslines_internal (fp, n); + if (0 == SLang_get_int_qualifier ("trim", &trim, 0)) + stdio_fgetslines_internal (fp, n, trim); + SLang_free_mmt (mmt); } @@ -889,7 +905,7 @@ SLang_free_array (at); } s = NULL; - /* drop */ + /* fall through */ the_return: if (s != NULL) SLfree (s); @@ -953,7 +969,7 @@ if ((ret == -1) && ferror (fp)) _pSLerrno_errno = errno; - /* drop */ + /* fall through */ the_return: if (b != NULL) SLbstring_free (b);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slstring.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slstring.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -126,16 +126,26 @@ switch(len) /* all the case statements fall through */ { case 11: c+=((_pSLuint32_Type)s10<<24); + /* fall through */ case 10: c+=((_pSLuint32_Type)s9<<16); + /* fall through */ case 9 : c+=((_pSLuint32_Type)s8<<8); + /* fall through */ /* the first byte of c is reserved for the length */ case 8 : b+=((_pSLuint32_Type)s7<<24); + /* fall through */ case 7 : b+=((_pSLuint32_Type)s6<<16); + /* fall through */ case 6 : b+=((_pSLuint32_Type)s5<<8); + /* fall through */ case 5 : b+=s4; + /* fall through */ case 4 : a+=((_pSLuint32_Type)s3<<24); + /* fall through */ case 3 : a+=((_pSLuint32_Type)s2<<16); + /* fall through */ case 2 : a+=((_pSLuint32_Type)s1<<8); + /* fall through */ case 1 : a+=s0; /* case 0: nothing left to add */ }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slstrops.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slstrops.c
Changed
@@ -1,7 +1,7 @@ /* -*- mode: C; mode: fold; -*- */ /* string manipulation functions for S-Lang. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -875,7 +875,7 @@ goto free_and_return; } (void) SLang_push_wchar (wch); - /* drop */ + /* fall through */ free_and_return: SLang_free_slstring ((char *)str); } @@ -913,7 +913,7 @@ goto free_and_return; } (void) SLang_push_wchar (wch); - /* drop */ + /* fall through */ free_and_return: SLang_free_slstring ((char *)str); } @@ -1221,11 +1221,11 @@ for (i = 0; i < num; i++) int_at_datai = (*func)(aos.str, bos.spi, cd); - /* drop */ + /* fall through */ push_and_return: status = SLang_push_array (int_at, 1); - /* drop */ + /* fall through */ free_and_return: free_array_or_string (&aos); free_array_or_string (&bos); @@ -1323,6 +1323,7 @@ SLstrlen_Type n; char *c; + if ((a == NULL) || (b == NULL)) return 0; (void) cd; if (NULL == (c = strstr(a, b))) @@ -1955,6 +1956,12 @@ * to be. */ want_width = width = 0; + if (ch == '0') + { + *f++ = '0'; + ch = *p++; + } + if (ch == '*') { if (SLang_pop_uinteger(&width)) return (out); @@ -1963,12 +1970,6 @@ } else { - if (ch == '0') - { - *f++ = '0'; - ch = *p++; - } - while ((ch <= '9') && (ch >= '0')) { width = width * 10 + (ch - '0'); @@ -2054,12 +2055,12 @@ f1--; } - /* drop */ + /* fall through */ case 'S': if (ch == 'S') _pSLstring_intrinsic (); ch = 's'; - /* drop */ + /* fall through */ case 's': if (-1 == SLang_pop_slstring(&str)) return (out); @@ -2164,7 +2165,7 @@ /* Pointer type?? Why?? */ if (-1 == SLdo_pop ()) return out; - str = (char *) _pSLang_get_run_stack_pointer (); + str = ((char *)NULL + SLstack_depth ()); use_string = 1; use_long = 0; break; @@ -2234,21 +2235,18 @@ { char *p; char *fmt; - SLang_Object_Type *ptr; int ofs; if (-1 == (ofs = SLreverse_stack (n + 1))) return -1; - ptr = _pSLang_get_run_stack_base () + ofs; - if (SLang_pop_slstring(&fmt)) return -1; p = SLdo_sprintf (fmt); _pSLang_free_slstring (fmt); - SLdo_pop_n (_pSLang_get_run_stack_pointer () - ptr); + SLdo_pop_n (SLstack_depth () - ofs); if (_pSLang_Error) { @@ -2413,32 +2411,95 @@ /*}}}*/ /* Regular expression routines for strings */ -static SLRegexp_Type *Regexp; -static unsigned int Regexp_Match_Byte_Offset; +#define NUM_CACHED_REGEXP 5 +typedef struct +{ + SLRegexp_Type *regexp; + char *pattern; + unsigned int match_byte_offset; +} +Regexp_Type; +static unsigned int Cache_IndicesNUM_CACHED_REGEXP; +static Regexp_Type Regexp_CacheNUM_CACHED_REGEXP; -static int string_match_internal (char *str, char *pat, int n) /*{{{*/ +static int init_regexp_cache (void) { - char *match; - size_t len; - size_t byte_offset; + unsigned int i; - if (Regexp != NULL) + for (i = 0; i < NUM_CACHED_REGEXP; i++) + Cache_Indicesi = i; + + return 0; +} + +static Regexp_Type *get_regexp (char *pat) +{ + Regexp_Type *r; + unsigned int i, j; + + for (i = 0; i < NUM_CACHED_REGEXP; i++) { - SLregexp_free (Regexp); - Regexp = NULL; + r = Regexp_Cache + Cache_Indicesi; + if (r->pattern != pat) continue; /* slstring comparison */ + + if ((r->regexp == NULL) + && (NULL == (r->regexp = SLregexp_compile (pat, 0)))) + return NULL; + + goto update_cache_and_return; } + /* Here, r is set to Regexp_Cache + Cache_Indicesi */ + + SLang_free_slstring (r->pattern); /* NULL ok */ + if (NULL == (r->pattern = SLang_create_slstring (pat))) + return NULL; + + SLregexp_free (r->regexp); /* NULL ok */ + if (NULL == (r->regexp = SLregexp_compile (pat, 0))) + return NULL; + + /* Drop */ + +update_cache_and_return: + i = r - Regexp_Cache; + if (i == Cache_Indices0) return r; + + j = 1; + while (j < NUM_CACHED_REGEXP) + { + if (i != Cache_Indicesj) + { + j++; + continue; + } + + while (j > 0) + {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slstruct.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slstruct.c
Changed
@@ -1,6 +1,6 @@ /* Structure type implementation */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -1291,7 +1291,7 @@ while (list->next != NULL) list = list->next; list->next = item; } - /* drop */ + /* fall through */ } SLang_free_function (item->binary_func); item->binary_func = nt; @@ -1997,7 +1997,7 @@ case 2: if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE)) return; - /* drop */ + /* fall through */ case 1: if (-1 == SLang_pop_struct (&s)) { @@ -2429,7 +2429,7 @@ } s = create_struct (n, field_names, field_types, field_values); - /* drop */ + /* fall through */ return_error: SLfree ((char *) field_values);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sltermin.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sltermin.c
Changed
@@ -3,7 +3,7 @@ */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -93,6 +93,26 @@ #define MAGIC_LEGACY 0432 #define MAGIC_32BIT 01036 +typedef struct +{ + int num_bool; + char **bool_caps; /* malloced */ + unsigned char *bool_values; /* malloced */ + + int num_numeric; + char **numeric_caps; /* NOT malloced */ + unsigned char *numeric_values; /* malloced */ + + int num_string; + char **string_caps; /* NOT malloced */ + unsigned char *string_offsets; /* malloced */ + + char *heap; /* malloced */ + char *cap_name_heap; /* NOT malloced */ +} +Extended_Cap_Type; + + /* In this structure, all char * fields are malloced EXCEPT if the * structure is SLTERMCAP. In that case, only terminal_names is malloced * and the other fields are pointers into it. @@ -120,6 +140,9 @@ unsigned int string_table_size; char *string_table; + size_t read_offset; /* number of bytes currently read */ + + Extended_Cap_Type *ext; }; static char *tcap_getstr (SLCONST char *, SLterminfo_Type *); @@ -133,6 +156,9 @@ unsigned char buf12; int magic; +#ifdef SLANG_UNTIC + (void) fprintf (stdout,"# Trying %s\n", file); +#endif /* Alan Cox reported a security problem here if the application using the * library is setuid. So, I need to make sure open the file as a normal * user. Unfortunately, there does not appear to be a portable way of @@ -173,6 +199,8 @@ h->num_string_offsets = make_integer16 (buf + 8); h->string_table_size = make_integer16 (buf + 10); + h->read_offset = 12; + return fp; } @@ -184,7 +212,7 @@ */ /* returns pointer to malloced space */ -static unsigned char *read_terminfo_section (FILE *fp, unsigned int size) +static void *read_terminfo_section (FILE *fp, SLterminfo_Type *t, unsigned int size) { char *s; @@ -194,12 +222,14 @@ SLfree (s); return NULL; } + t->read_offset += size; + return (unsigned char *) s; } static char *read_terminal_names (FILE *fp, SLterminfo_Type *t) { - return t->terminal_names = (char *) read_terminfo_section (fp, t->name_section_size); + return t->terminal_names = (char *) read_terminfo_section (fp, t, t->name_section_size); } /* @@ -220,7 +250,7 @@ unsigned int size = (t->name_section_size + t->boolean_section_size) % 2; size += t->boolean_section_size; - return t->boolean_flags = read_terminfo_section (fp, size); + return t->boolean_flags = (unsigned char *)read_terminfo_section (fp, t, size); } /* @@ -232,7 +262,7 @@ static unsigned char *read_numbers (FILE *fp, SLterminfo_Type *t) { - return t->numbers = read_terminfo_section (fp, t->sizeof_number * t->num_numbers); + return t->numbers = (unsigned char *)read_terminfo_section (fp, t, t->sizeof_number * t->num_numbers); } /* The strings section is also similar. Each capability is stored as a @@ -246,7 +276,7 @@ static unsigned char *read_string_offsets (FILE *fp, SLterminfo_Type *t) { - return t->string_offsets = (unsigned char *) read_terminfo_section (fp, 2 * t->num_string_offsets); + return t->string_offsets = (unsigned char *) read_terminfo_section (fp, t, 2 * t->num_string_offsets); } /* The final section is the string table. It contains all the values of @@ -256,7 +286,133 @@ static char *read_string_table (FILE *fp, SLterminfo_Type *t) { - return t->string_table = (char *) read_terminfo_section (fp, t->string_table_size); + return t->string_table = (char *) read_terminfo_section (fp, t, t->string_table_size); +} + +static void free_ext_caps (Extended_Cap_Type *ext) +{ + if (ext == NULL) return; + + SLfree ((char *)ext->bool_values); + SLfree ((char *)ext->numeric_values); + SLfree ((char *)ext->string_offsets); + SLfree ((char *)ext->heap); + SLfree ((char *)ext->bool_caps); + + SLfree ((char *)ext); +} + +static int try_read_extended_caps (FILE *fp, SLterminfo_Type *t) +{ + Extended_Cap_Type *ext; + size_t size; + char **cap_names; + unsigned char *b; + char *heap_max, *cap_name_heap; + unsigned int i, num_caps, heap_size; + unsigned char buf11; + + size = 10; + b = buf; + if (t->read_offset % 2) + { + size++; + b++; + } + + if (size != fread (buf, 1, size, fp)) + return 0; /* assume no extended caps */ + t->read_offset += size; + + if (NULL == (ext = (Extended_Cap_Type *)SLmalloc (sizeof(Extended_Cap_Type)))) + return -1; + memset (ext, 0, sizeof(Extended_Cap_Type)); + + ext->num_bool = make_integer16(b); + ext->num_numeric = make_integer16(b+2); + ext->num_string = make_integer16(b+4); + (void) make_integer16(b+6); /* number of valid strings (not cancelled or absent) */ + heap_size = make_integer16(b+8); /* size of the area containing all strings */ + + /* The heap should be large enough to hold all the strings */ + num_caps = ext->num_bool + ext->num_numeric + ext->num_string; + if ((ext->num_bool < 0) || (ext->num_numeric < 0) || (ext->num_string < 0) + || (heap_size < 2*(num_caps + ext->num_string))) + goto return_failure; + + size = ext->num_bool; + if (size % 2) size++; /* so numbers will start on an even byte bndry */ + if (NULL == (ext->bool_values = (unsigned char *)read_terminfo_section (fp, t, size))) + goto return_failure; + + size = t->sizeof_number * ext->num_numeric; + if (NULL == (ext->numeric_values = (unsigned char *)read_terminfo_section (fp, t, size))) + goto return_failure; + + /* Now read the offsets for the strings. These also include offsets for all + * capability names. + */ + size = 2 * ext->num_string; + /* Now add the offsets for _all_ the extended cap names */ + size += 2 * num_caps; + if (NULL == (ext->string_offsets = (unsigned char *)read_terminfo_section (fp, t, size))) + goto return_failure; + + /* Now read the heap that contains all the strings. The heaps contains two + * areas: the first contains the values the string-valued capabilities. The + * seccond area contains the names of all the extended capabilities. Unfortunately + * the file format lacks explicit information about where the second area begins. + * So it will have to be deduced. + */
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sltime.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sltime.c
Changed
@@ -1,6 +1,6 @@ /* time related system calls */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -360,8 +360,17 @@ { if (a->tm_year != b->tm_year) return a->tm_year - b->tm_year; +#if 1 + /* give tm_mon/tm_mday precedence over tm_yday */ + if (a->tm_mon != b->tm_mon) + return a->tm_mon - b->tm_mon; + if (a->tm_mday != b->tm_mday) + return a->tm_mday - b->tm_mday; +#else if (a->tm_yday != b->tm_yday) return a->tm_yday - b->tm_yday; +#endif + if (a->tm_hour - b->tm_hour) return a->tm_hour - b->tm_hour; return (a->tm_min - b->tm_min)*60 + (a->tm_sec - b->tm_sec);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sltoken.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sltoken.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -270,7 +270,7 @@ case FLOAT_TOKEN: case DOUBLE_TOKEN: case COMPLEX_TOKEN: - /* drop */ + /* fall through */ #endif default: if (NULL != (s = lookup_op_token_string (type))) @@ -844,12 +844,7 @@ is_binary = -1; break; } - if ((isunicode == 0) -#if 0 - && ((wch < 127) - || (utf8_encode == 0)) -#endif - ) + if (isunicode == 0) { if (wch == 0) is_binary = 1; @@ -1040,6 +1035,8 @@ if (ch == '\\') { + int cr = 0; + if (is_multiline_raw) { slen++ = ch; @@ -1048,15 +1045,23 @@ } ch = prep_get_char (); + if (ch == '\r') + { + cr = 1; + ch = prep_get_char (); + } + if ((ch == '\n') || (ch == 0)) { + /* ignore the \r, if present */ is_continued = 1; break; } slen++ = '\\'; if (len < maxlen) { - slen++ = ch; + if (cr) slen++ = '\r'; + if (len < maxlen) slen++ = ch; has_bs = 1; } continue; @@ -2277,7 +2282,7 @@ break; default: - SLang_verror (SL_Internal_Error, "Unsupported multline token: 0x%X", tok->type); + SLang_verror (SL_Internal_Error, "Unsupported multiline token: 0x%X", tok->type); return -1; }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sltypes.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sltypes.c
Changed
@@ -1,6 +1,6 @@ /* Basic type operations for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -598,8 +598,8 @@ int SLang_assign_to_ref (SLang_Ref_Type *ref, SLtype type, VOID_STAR v) { - SLang_Object_Type *stkptr; SLang_Class_Type *cl; + int stack_depth; cl = _pSLclass_get_class (type); @@ -623,11 +623,11 @@ if (-1 == (*cl->cl_apush) (type, v)) return -1; - stkptr = _pSLang_get_run_stack_pointer (); + stack_depth = SLstack_depth (); if (0 == _pSLang_deref_assign (ref)) return 0; - if (stkptr != _pSLang_get_run_stack_pointer ()) + if (stack_depth != SLstack_depth ()) SLdo_pop (); return -1;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slupper.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slupper.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slutf8.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slutf8.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slutty.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slutty.c
Changed
@@ -1,6 +1,6 @@ /* slutty.c --- Unix Low level terminal (tty) functions for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slvideo.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slvideo.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold -*- */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slvmstty.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slvmstty.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slw32tty.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slw32tty.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slwclut.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slwclut.c
Changed
@@ -1,6 +1,6 @@ /* slwclut.c: wide character lookup tables */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slwcwidth.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slwcwidth.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slxstrng.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slxstrng.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/aix4.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/aix4.inc
Changed
@@ -1,6 +1,6 @@ -/* This file was autogenerated using parsecaps.sl /tmp/Caps.aix4 */ +/* This file was autogenerated by parsecaps.sl */ -static Tgetstr_Map_Type Tgetstr_Map = +static Tgetstr_Map_Type Tgetstr_Map = { {"!1", 339 UNTIC_COMMENT("shifted save key")}, {"!2", 340 UNTIC_COMMENT("shifted suspend key")}, @@ -10,6 +10,7 @@ {"#3", 327 UNTIC_COMMENT("shifted insert-character key")}, {"#4", 328 UNTIC_COMMENT("shifted left-arrow key")}, {"%0", 304 UNTIC_COMMENT("redo key")}, + {"%1", 178 UNTIC_COMMENT("help key")}, {"%2", 296 UNTIC_COMMENT("mark key")}, {"%3", 297 UNTIC_COMMENT("message key")}, {"%4", 298 UNTIC_COMMENT("move key")}, @@ -52,8 +53,10 @@ {"@1", 288 UNTIC_COMMENT("begin key")}, {"@2", 289 UNTIC_COMMENT("cancel key")}, {"@3", 290 UNTIC_COMMENT("close key")}, + {"@4", 175 UNTIC_COMMENT("command-request key")}, {"@5", 291 UNTIC_COMMENT("copy key")}, {"@6", 292 UNTIC_COMMENT("create key")}, + {"@7", 177 UNTIC_COMMENT("end key")}, {"@8", 293 UNTIC_COMMENT("enter/send key")}, {"@9", 294 UNTIC_COMMENT("exit key")}, {"AB", 434 UNTIC_COMMENT("Set background color to #1, using ANSI escape")}, @@ -122,17 +125,17 @@ {"Fp", 267 UNTIC_COMMENT("F61 function key")}, {"Fq", 268 UNTIC_COMMENT("F62 function key")}, {"Fr", 269 UNTIC_COMMENT("F63 function key")}, - {"G1", 476 UNTIC_COMMENT("single upper right")}, - {"G2", 474 UNTIC_COMMENT("single upper left")}, - {"G3", 475 UNTIC_COMMENT("single lower left")}, - {"G4", 477 UNTIC_COMMENT("single lower right")}, - {"GC", 484 UNTIC_COMMENT("single intersection")}, - {"GD", 481 UNTIC_COMMENT("tee pointing down")}, - {"GH", 482 UNTIC_COMMENT("single horizontal line")}, - {"GL", 479 UNTIC_COMMENT("tee pointing left")}, - {"GR", 478 UNTIC_COMMENT("tee pointing right")}, - {"GU", 480 UNTIC_COMMENT("tee pointing up")}, - {"GV", 483 UNTIC_COMMENT("single vertical line")}, + {"G1", 469 UNTIC_COMMENT("single upper right")}, + {"G2", 467 UNTIC_COMMENT("single upper left")}, + {"G3", 468 UNTIC_COMMENT("single lower left")}, + {"G4", 470 UNTIC_COMMENT("single lower right")}, + {"GC", 477 UNTIC_COMMENT("single intersection")}, + {"GD", 474 UNTIC_COMMENT("tee pointing down")}, + {"GH", 475 UNTIC_COMMENT("single horizontal line")}, + {"GL", 472 UNTIC_COMMENT("tee pointing left")}, + {"GR", 471 UNTIC_COMMENT("tee pointing right")}, + {"GU", 473 UNTIC_COMMENT("tee pointing up")}, + {"GV", 476 UNTIC_COMMENT("single vertical line")}, {"Gm", 432 UNTIC_COMMENT("Curses should get button events, parameter #1 not documented.")}, {"HU", 353 UNTIC_COMMENT("hang-up phone")}, {"IC", 108 UNTIC_COMMENT("insert #1 characters (P*)")}, @@ -153,6 +156,10 @@ {"KY", 195 UNTIC_COMMENT("special mapped key 4 output")}, {"KZ", 197 UNTIC_COMMENT("special mapped key 5 output")}, {"Km", 429 UNTIC_COMMENT("Mouse event has occurred")}, + {"Kr", 199 UNTIC_COMMENT("special mapped key 6 input")}, + {"Ks", 201 UNTIC_COMMENT("special mapped key 7 input")}, + {"Kt", 203 UNTIC_COMMENT("special mapped key 8 input")}, + {"Ku", 205 UNTIC_COMMENT("special mapped key 9 input")}, {"Kv", 188 UNTIC_COMMENT("special mapped key 1 input")}, {"Kw", 190 UNTIC_COMMENT("special mapped key 2 input")}, {"Kx", 192 UNTIC_COMMENT("special mapped key 3 input")}, @@ -163,7 +170,7 @@ {"LO", 286 UNTIC_COMMENT("turn on soft labels")}, {"Lf", 347 UNTIC_COMMENT("label format")}, {"MC", 344 UNTIC_COMMENT("clear right and left soft margins")}, - {"ML", 345 UNTIC_COMMENT("set left soft margin at current column. See smgl. (ML is not in BSD termcap).")}, + {"ML", 345 UNTIC_COMMENT("set left soft margin at current column. (ML is not in BSD termcap).")}, {"ML", 442 UNTIC_COMMENT("Set both left and right margins to #1, #2. (ML is not in BSD termcap).")}, {"MR", 346 UNTIC_COMMENT("set right soft margin at current column")}, {"MT", 443 UNTIC_COMMENT("Sets both top and bottom margins to #1, #2")}, @@ -208,17 +215,12 @@ {"WG", 352 UNTIC_COMMENT("go to window #1")}, {"XF", 284 UNTIC_COMMENT("XOFF character")}, {"XN", 283 UNTIC_COMMENT("XON character")}, - {"Xh", 460 UNTIC_COMMENT("Enter horizontal highlight mode")}, - {"Xl", 461 UNTIC_COMMENT("Enter left highlight mode")}, - {"Xo", 462 UNTIC_COMMENT("Enter low highlight mode")}, - {"Xr", 463 UNTIC_COMMENT("Enter right highlight mode")}, - {"Xt", 464 UNTIC_COMMENT("Enter top highlight mode")}, - {"Xv", 465 UNTIC_COMMENT("Enter vertical highlight mode")}, {"Xy", 444 UNTIC_COMMENT("Repeat bit image cell #1 #2 times")}, + {"YI", 460 UNTIC_COMMENT("Set page length to #1 hundredth of an inch (some implementations use sL for termcap).")}, {"YZ", 451 UNTIC_COMMENT("Set page length to #1 lines")}, {"Yv", 446 UNTIC_COMMENT("Move to beginning of same row")}, {"Yw", 447 UNTIC_COMMENT("Give name for color #1")}, - {"Yx", 448 UNTIC_COMMENT("Define rectangualar bit image region")}, + {"Yx", 448 UNTIC_COMMENT("Define rectangular bit image region")}, {"Yy", 449 UNTIC_COMMENT("End a bit-image region")}, {"Yz", 450 UNTIC_COMMENT("Change to ribbon color #1")}, {"ZA", 378 UNTIC_COMMENT("Change number of characters per inch to #1")}, @@ -277,7 +279,7 @@ {"ae", 38 UNTIC_COMMENT("end alternate character set (P)")}, {"al", 53 UNTIC_COMMENT("insert line (P*)")}, {"as", 25 UNTIC_COMMENT("start alternate character set (P)")}, - {"bc", 471 UNTIC_COMMENT("move left, if not ^H")}, + {"bc", 464 UNTIC_COMMENT("move left, if not ^H")}, {"bl", 1 UNTIC_COMMENT("audible signal (bell) (P)")}, {"bm", 272 UNTIC_COMMENT("start bottom-line mode")}, {"bt", 0 UNTIC_COMMENT("back tab (P)")}, @@ -335,7 +337,7 @@ {"ho", 12 UNTIC_COMMENT("home cursor (if no cup)")}, {"hu", 137 UNTIC_COMMENT("half a line up")}, {"i1", 48 UNTIC_COMMENT("initialization string")}, - {"i2", 468 UNTIC_COMMENT("secondary initialization string")}, + {"i2", 461 UNTIC_COMMENT("secondary initialization string")}, {"i3", 50 UNTIC_COMMENT("initialization string")}, {"iP", 138 UNTIC_COMMENT("path name of program for initialization")}, {"ic", 52 UNTIC_COMMENT("insert character (P)")}, @@ -344,7 +346,6 @@ {"ip", 54 UNTIC_COMMENT("insert padding after inserted character")}, {"is", 49 UNTIC_COMMENT("initialization string")}, {"k0", 65 UNTIC_COMMENT("F0 function key")}, - {"k0", 173 UNTIC_COMMENT("backtab key")}, {"k1", 66 UNTIC_COMMENT("F1 function key")}, {"k2", 68 UNTIC_COMMENT("F2 function key")}, {"k3", 69 UNTIC_COMMENT("F3 function key")}, @@ -367,6 +368,7 @@ {"kL", 60 UNTIC_COMMENT("delete-line key")}, {"kM", 62 UNTIC_COMMENT("sent by rmir or smir in insert mode")}, {"kN", 81 UNTIC_COMMENT("next-page key")}, + {"kO", 173 UNTIC_COMMENT("backtab key")}, {"kP", 82 UNTIC_COMMENT("previous-page key")}, {"kQ", 183 UNTIC_COMMENT("quit key")}, {"kR", 85 UNTIC_COMMENT("scroll-backward key")}, @@ -379,25 +381,19 @@ {"ka", 56 UNTIC_COMMENT("clear-all-tabs key")}, {"kb", 55 UNTIC_COMMENT("backspace key")}, {"kd", 61 UNTIC_COMMENT("down-arrow key")}, - {"kd", 175 UNTIC_COMMENT("command-request key")}, {"ke", 88 UNTIC_COMMENT("leave 'keyboard_transmit' mode")}, {"kh", 76 UNTIC_COMMENT("home key")}, {"ki", 174 UNTIC_COMMENT("do request key")}, {"kl", 79 UNTIC_COMMENT("left-arrow key")}, + {"kn", 179 UNTIC_COMMENT("newline key")}, {"ko", 187 UNTIC_COMMENT("tab key")}, - {"ko", 472 UNTIC_COMMENT("list of self-mapped keycaps")}, + {"ko", 465 UNTIC_COMMENT("list of self-mapped keycaps")}, {"kp", 181 UNTIC_COMMENT("previous-command key")}, - {"kq", 178 UNTIC_COMMENT("help key")}, {"kr", 83 UNTIC_COMMENT("right-arrow key")}, - {"kr", 199 UNTIC_COMMENT("special mapped key 6 input")}, {"ks", 89 UNTIC_COMMENT("enter 'keyboard_transmit' mode")}, - {"ks", 201 UNTIC_COMMENT("special mapped key 7 input")}, {"kt", 58 UNTIC_COMMENT("clear-tab key")}, - {"kt", 203 UNTIC_COMMENT("special mapped key 8 input")}, {"ku", 87 UNTIC_COMMENT("up-arrow key")}, - {"ku", 205 UNTIC_COMMENT("special mapped key 9 input")}, {"kv", 180 UNTIC_COMMENT("next-pane key")}, - {"kw", 177 UNTIC_COMMENT("end key")}, {"kz", 185 UNTIC_COMMENT("scroll left")}, {"l0", 90 UNTIC_COMMENT("label on function key f0 if not f0")}, {"l1", 91 UNTIC_COMMENT("label on function key f1 if not f1")}, @@ -413,21 +409,20 @@ {"le", 14 UNTIC_COMMENT("move left one space")}, {"ll", 18 UNTIC_COMMENT("last line, first column (if no cup)")}, {"lv", 274 UNTIC_COMMENT("start left-vertical mode")}, - {"ma", 473 UNTIC_COMMENT("map arrow keys rogue(1) motion keys")}, + {"ma", 466 UNTIC_COMMENT("map motion-keys for vi version 2")}, {"mb", 26 UNTIC_COMMENT("turn on blinking")}, {"md", 27 UNTIC_COMMENT("turn on bold (extra bright) mode")}, {"me", 39 UNTIC_COMMENT("turn off all attributes")}, {"mh", 30 UNTIC_COMMENT("turn on half-bright mode")}, {"mk", 32 UNTIC_COMMENT("turn on blank mode (characters invisible)")}, - {"ml", 485 UNTIC_COMMENT("lock memory above cursor")}, + {"ml", 478 UNTIC_COMMENT("lock memory above cursor")}, {"mm", 102 UNTIC_COMMENT("turn on meta mode (8th-bit on)")}, {"mo", 101 UNTIC_COMMENT("turn off meta mode")}, {"mp", 33 UNTIC_COMMENT("turn on protected mode")}, {"mr", 34 UNTIC_COMMENT("turn on reverse video mode")}, - {"mu", 486 UNTIC_COMMENT("unlock memory")}, + {"mu", 479 UNTIC_COMMENT("unlock memory")}, {"nd", 17 UNTIC_COMMENT("non-destructive space (move right one space)")}, - {"nl", 179 UNTIC_COMMENT("newline key")}, - {"nl", 470 UNTIC_COMMENT("use to move down")}, + {"nl", 463 UNTIC_COMMENT("use to move down")}, {"nw", 103 UNTIC_COMMENT("newline (behave like cr followed by lf)")}, {"oc", 372 UNTIC_COMMENT("Set all color pairs to the original ones")}, {"op", 371 UNTIC_COMMENT("Set default pair to its original value")}, @@ -447,14 +442,12 @@ {"rc", 126 UNTIC_COMMENT("restore cursor to position of last save_cursor")}, {"rf", 125 UNTIC_COMMENT("name of reset file")}, {"rp", 121 UNTIC_COMMENT("repeat char #1 #2 times (P*)")}, - {"rs", 469 UNTIC_COMMENT("terminal reset string")}, + {"rs", 462 UNTIC_COMMENT("terminal reset string")}, {"rv", 273 UNTIC_COMMENT("start right-vertical mode")}, {"s0", 438 UNTIC_COMMENT("Shift to codeset 0 (EUC set 0, ASCII)")}, {"s1", 439 UNTIC_COMMENT("Shift to codeset 1")}, {"s2", 440 UNTIC_COMMENT("Shift to codeset 2")}, {"s3", 441 UNTIC_COMMENT("Shift to codeset 3")}, - {"sA", 466 UNTIC_COMMENT("Define second set of video attributes #1-#6")}, - {"sL", 467 UNTIC_COMMENT("YI Set page length to #1 hundredth of an inch")}, {"sa", 131 UNTIC_COMMENT("define video attributes #1-#9 (PG9)")}, {"sc", 128 UNTIC_COMMENT("save current cursor position (P)")},
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/default.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/default.inc
Changed
@@ -1,6 +1,6 @@ -/* This file was autogenerated using parsecaps.sl /tmp/Caps */ +/* This file was autogenerated by parsecaps.sl */ -static Tgetstr_Map_Type Tgetstr_Map = +static Tgetstr_Map_Type Tgetstr_Map = { {"!1", 212 UNTIC_COMMENT("shifted save key")}, {"!2", 213 UNTIC_COMMENT("shifted suspend key")}, @@ -150,7 +150,7 @@ {"LO", 156 UNTIC_COMMENT("turn on soft labels")}, {"Lf", 273 UNTIC_COMMENT("label format")}, {"MC", 270 UNTIC_COMMENT("clear right and left soft margins")}, - {"ML", 271 UNTIC_COMMENT("set left soft margin at current column. See smgl. (ML is not in BSD termcap).")}, + {"ML", 271 UNTIC_COMMENT("set left soft margin at current column. (ML is not in BSD termcap).")}, {"ML", 368 UNTIC_COMMENT("Set both left and right margins to #1, #2. (ML is not in BSD termcap).")}, {"MR", 272 UNTIC_COMMENT("set right soft margin at current column")}, {"MT", 369 UNTIC_COMMENT("Sets both top and bottom margins to #1, #2")}, @@ -192,10 +192,11 @@ {"Xt", 390 UNTIC_COMMENT("Enter top highlight mode")}, {"Xv", 391 UNTIC_COMMENT("Enter vertical highlight mode")}, {"Xy", 370 UNTIC_COMMENT("Repeat bit image cell #1 #2 times")}, + {"YI", 393 UNTIC_COMMENT("Set page length to #1 hundredth of an inch (some implementations use sL for termcap).")}, {"YZ", 377 UNTIC_COMMENT("Set page length to #1 lines")}, {"Yv", 372 UNTIC_COMMENT("Move to beginning of same row")}, {"Yw", 373 UNTIC_COMMENT("Give name for color #1")}, - {"Yx", 374 UNTIC_COMMENT("Define rectangualar bit image region")}, + {"Yx", 374 UNTIC_COMMENT("Define rectangular bit image region")}, {"Yy", 375 UNTIC_COMMENT("End a bit-image region")}, {"Yz", 376 UNTIC_COMMENT("Change to ribbon color #1")}, {"ZA", 304 UNTIC_COMMENT("Change number of characters per inch to #1")}, @@ -344,7 +345,7 @@ {"la", 92 UNTIC_COMMENT("label on function key f10 if not f10")}, {"le", 14 UNTIC_COMMENT("move left one space")}, {"ll", 18 UNTIC_COMMENT("last line, first column (if no cup)")}, - {"ma", 399 UNTIC_COMMENT("map arrow keys rogue(1) motion keys")}, + {"ma", 399 UNTIC_COMMENT("map motion-keys for vi version 2")}, {"mb", 26 UNTIC_COMMENT("turn on blinking")}, {"md", 27 UNTIC_COMMENT("turn on bold (extra bright) mode")}, {"me", 39 UNTIC_COMMENT("turn off all attributes")}, @@ -383,7 +384,6 @@ {"s2", 366 UNTIC_COMMENT("Shift to codeset 2")}, {"s3", 367 UNTIC_COMMENT("Shift to codeset 3")}, {"sA", 392 UNTIC_COMMENT("Define second set of video attributes #1-#6")}, - {"sL", 393 UNTIC_COMMENT("YI Set page length to #1 hundredth of an inch")}, {"sa", 131 UNTIC_COMMENT("define video attributes #1-#9 (PG9)")}, {"sc", 128 UNTIC_COMMENT("save current cursor position (P)")}, {"se", 43 UNTIC_COMMENT("exit standout mode")}, @@ -419,11 +419,12 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetnum_Map = + +static Tgetstr_Map_Type Tgetnum_Map = { {"BT", 30 UNTIC_COMMENT("number of buttons on mouse")}, {"Co", 13 UNTIC_COMMENT("maximum number of colors on screen")}, - {"MW", 12 UNTIC_COMMENT("maximum number of defineable windows")}, + {"MW", 12 UNTIC_COMMENT("maximum number of definable windows")}, {"NC", 15 UNTIC_COMMENT("video attributes that cannot be used with colors")}, {"Nl", 8 UNTIC_COMMENT("number of labels on screen")}, {"Ya", 16 UNTIC_COMMENT("numbers of bytes buffered before printing")}, @@ -463,7 +464,8 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetflag_Map = + +static Tgetstr_Map_Type Tgetflag_Map = { {"5i", 22 UNTIC_COMMENT("printer will not echo on screen")}, {"HC", 23 UNTIC_COMMENT("cursor is hard to see")}, @@ -491,7 +493,7 @@ {"hc", 7 UNTIC_COMMENT("hardcopy terminal")}, {"hl", 29 UNTIC_COMMENT("terminal uses only HLS color notation (Tektronix)")}, {"hs", 9 UNTIC_COMMENT("has extra status line")}, - {"hz", 18 UNTIC_COMMENT("cannot print ~'s (hazeltine)")}, + {"hz", 18 UNTIC_COMMENT("cannot print ~'s (Hazeltine)")}, {"in", 10 UNTIC_COMMENT("insert mode distinguishes nulls")}, {"km", 8 UNTIC_COMMENT("Has a meta key (i.e., sets 8th-bit)")}, {"mi", 13 UNTIC_COMMENT("safe to move while in insert mode")}, @@ -512,3 +514,4 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/hpux11.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/hpux11.inc
Changed
@@ -1,6 +1,6 @@ -/* This file was autogenerated using parsecaps.sl /tmp/Caps.hpux11 */ +/* This file was autogenerated by parsecaps.sl */ -static Tgetstr_Map_Type Tgetstr_Map = +static Tgetstr_Map_Type Tgetstr_Map = { {"!1", 267 UNTIC_COMMENT("shifted save key")}, {"!2", 268 UNTIC_COMMENT("shifted suspend key")}, @@ -150,14 +150,27 @@ {"LO", 148 UNTIC_COMMENT("turn on soft labels")}, {"Lf", 275 UNTIC_COMMENT("label format")}, {"MC", 272 UNTIC_COMMENT("clear right and left soft margins")}, - {"ML", 273 UNTIC_COMMENT("set left soft margin at current column. See smgl. (ML is not in BSD termcap).")}, + {"ML", 273 UNTIC_COMMENT("set left soft margin at current column. (ML is not in BSD termcap).")}, {"ML", 370 UNTIC_COMMENT("Set both left and right margins to #1, #2. (ML is not in BSD termcap).")}, {"MR", 274 UNTIC_COMMENT("set right soft margin at current column")}, {"MT", 371 UNTIC_COMMENT("Sets both top and bottom margins to #1, #2")}, {"Mi", 358 UNTIC_COMMENT("Mouse status information")}, {"PA", 287 UNTIC_COMMENT("pause for 2-3 seconds")}, {"PU", 285 UNTIC_COMMENT("select pulse dialing")}, + {"Q1", 389 UNTIC_COMMENT("Enter horizontal highlight mode")}, + {"Q2", 390 UNTIC_COMMENT("Enter left highlight mode")}, + {"Q3", 391 UNTIC_COMMENT("Enter low highlight mode")}, + {"Q4", 392 UNTIC_COMMENT("Enter right highlight mode")}, + {"Q5", 393 UNTIC_COMMENT("Enter top highlight mode")}, + {"Q6", 394 UNTIC_COMMENT("Enter vertical highlight mode")}, + {"Q7", 395 UNTIC_COMMENT("Define second set of video attributes #1-#6")}, + {"Q8", 396 UNTIC_COMMENT("Exit horizontal highlight mode")}, + {"Q9", 397 UNTIC_COMMENT("Exit left highlight mode")}, {"QD", 283 UNTIC_COMMENT("dial number #1 without checking")}, + {"Qa", 398 UNTIC_COMMENT("Exit low highlight mode")}, + {"Qb", 399 UNTIC_COMMENT("Exit right highlight mode")}, + {"Qc", 400 UNTIC_COMMENT("Exit top highlight mode")}, + {"Qd", 401 UNTIC_COMMENT("Exit vertical highlight mode")}, {"RA", 209 UNTIC_COMMENT("turn off automatic margins")}, {"RC", 278 UNTIC_COMMENT("remove clock")}, {"RF", 270 UNTIC_COMMENT("send next input char (for ptys)")}, @@ -184,24 +197,13 @@ {"WA", 288 UNTIC_COMMENT("wait for dial-tone")}, {"WG", 280 UNTIC_COMMENT("go to window #1")}, {"XF", 211 UNTIC_COMMENT("XOFF character")}, - {"XH", 396 UNTIC_COMMENT("Exit horizontal highlight mode")}, - {"XL", 397 UNTIC_COMMENT("Exit left highlight mode")}, {"XN", 210 UNTIC_COMMENT("XON character")}, - {"XO", 398 UNTIC_COMMENT("Exit low highlight mode")}, - {"XR", 399 UNTIC_COMMENT("Exit right highlight mode")}, - {"XT", 400 UNTIC_COMMENT("Exit top highlight mode")}, - {"XV", 401 UNTIC_COMMENT("Exit vertical highlight mode")}, - {"Xh", 389 UNTIC_COMMENT("Enter horizontal highlight mode")}, - {"Xl", 390 UNTIC_COMMENT("Enter left highlight mode")}, - {"Xo", 391 UNTIC_COMMENT("Enter low highlight mode")}, - {"Xr", 392 UNTIC_COMMENT("Enter right highlight mode")}, - {"Xt", 393 UNTIC_COMMENT("Enter top highlight mode")}, - {"Xv", 394 UNTIC_COMMENT("Enter vertical highlight mode")}, {"Xy", 372 UNTIC_COMMENT("Repeat bit image cell #1 #2 times")}, + {"YI", 388 UNTIC_COMMENT("Set page length to #1 hundredth of an inch (some implementations use sL for termcap).")}, {"YZ", 379 UNTIC_COMMENT("Set page length to #1 lines")}, {"Yv", 374 UNTIC_COMMENT("Move to beginning of same row")}, {"Yw", 375 UNTIC_COMMENT("Give name for color #1")}, - {"Yx", 376 UNTIC_COMMENT("Define rectangualar bit image region")}, + {"Yx", 376 UNTIC_COMMENT("Define rectangular bit image region")}, {"Yy", 377 UNTIC_COMMENT("End a bit-image region")}, {"Yz", 378 UNTIC_COMMENT("Change to ribbon color #1")}, {"ZA", 306 UNTIC_COMMENT("Change number of characters per inch to #1")}, @@ -350,7 +352,7 @@ {"la", 92 UNTIC_COMMENT("label on function key f10 if not f10")}, {"le", 14 UNTIC_COMMENT("move left one space")}, {"ll", 18 UNTIC_COMMENT("last line, first column (if no cup)")}, - {"ma", 407 UNTIC_COMMENT("map arrow keys rogue(1) motion keys")}, + {"ma", 407 UNTIC_COMMENT("map motion-keys for vi version 2")}, {"mb", 26 UNTIC_COMMENT("turn on blinking")}, {"md", 27 UNTIC_COMMENT("turn on bold (extra bright) mode")}, {"me", 39 UNTIC_COMMENT("turn off all attributes")}, @@ -388,8 +390,6 @@ {"s1", 367 UNTIC_COMMENT("Shift to codeset 1")}, {"s2", 368 UNTIC_COMMENT("Shift to codeset 2")}, {"s3", 369 UNTIC_COMMENT("Shift to codeset 3")}, - {"sA", 395 UNTIC_COMMENT("Define second set of video attributes #1-#6")}, - {"sL", 388 UNTIC_COMMENT("YI Set page length to #1 hundredth of an inch")}, {"sa", 131 UNTIC_COMMENT("define video attributes #1-#9 (PG9)")}, {"sc", 128 UNTIC_COMMENT("save current cursor position (P)")}, {"se", 43 UNTIC_COMMENT("exit standout mode")}, @@ -425,11 +425,12 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetnum_Map = + +static Tgetstr_Map_Type Tgetnum_Map = { {"BT", 30 UNTIC_COMMENT("number of buttons on mouse")}, {"Co", 13 UNTIC_COMMENT("maximum number of colors on screen")}, - {"MW", 12 UNTIC_COMMENT("maximum number of defineable windows")}, + {"MW", 12 UNTIC_COMMENT("maximum number of definable windows")}, {"NC", 15 UNTIC_COMMENT("video attributes that cannot be used with colors")}, {"Nl", 8 UNTIC_COMMENT("number of labels on screen")}, {"Ya", 16 UNTIC_COMMENT("numbers of bytes buffered before printing")}, @@ -469,7 +470,8 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetflag_Map = + +static Tgetstr_Map_Type Tgetflag_Map = { {"5i", 22 UNTIC_COMMENT("printer will not echo on screen")}, {"HC", 23 UNTIC_COMMENT("cursor is hard to see")}, @@ -497,7 +499,7 @@ {"hc", 7 UNTIC_COMMENT("hardcopy terminal")}, {"hl", 29 UNTIC_COMMENT("terminal uses only HLS color notation (Tektronix)")}, {"hs", 9 UNTIC_COMMENT("has extra status line")}, - {"hz", 18 UNTIC_COMMENT("cannot print ~'s (hazeltine)")}, + {"hz", 18 UNTIC_COMMENT("cannot print ~'s (Hazeltine)")}, {"in", 10 UNTIC_COMMENT("insert mode distinguishes nulls")}, {"km", 8 UNTIC_COMMENT("Has a meta key (i.e., sets 8th-bit)")}, {"mi", 13 UNTIC_COMMENT("safe to move while in insert mode")}, @@ -518,3 +520,4 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/osf1r5.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/osf1r5.inc
Changed
@@ -1,6 +1,6 @@ -/* This file was autogenerated using parsecaps.sl /tmp/Caps.osf1r5 */ +/* This file was autogenerated by parsecaps.sl */ -static Tgetstr_Map_Type Tgetstr_Map = +static Tgetstr_Map_Type Tgetstr_Map = { {"!1", 379 UNTIC_COMMENT("shifted save key")}, {"!2", 380 UNTIC_COMMENT("shifted suspend key")}, @@ -169,7 +169,7 @@ {"LO", 386 UNTIC_COMMENT("turn on soft labels")}, {"Lf", 384 UNTIC_COMMENT("label format")}, {"MC", 255 UNTIC_COMMENT("clear right and left soft margins")}, - {"ML", 424 UNTIC_COMMENT("set left soft margin at current column. See smgl. (ML is not in BSD termcap).")}, + {"ML", 424 UNTIC_COMMENT("set left soft margin at current column. (ML is not in BSD termcap).")}, {"ML", 426 UNTIC_COMMENT("Set both left and right margins to #1, #2. (ML is not in BSD termcap).")}, {"MR", 428 UNTIC_COMMENT("set right soft margin at current column")}, {"MT", 430 UNTIC_COMMENT("Sets both top and bottom margins to #1, #2")}, @@ -221,10 +221,11 @@ {"Xt", 460 UNTIC_COMMENT("Enter top highlight mode")}, {"Xv", 461 UNTIC_COMMENT("Enter vertical highlight mode")}, {"Xy", 246 UNTIC_COMMENT("Repeat bit image cell #1 #2 times")}, + {"YI", 455 UNTIC_COMMENT("Set page length to #1 hundredth of an inch (some implementations use sL for termcap).")}, {"YZ", 427 UNTIC_COMMENT("Set page length to #1 lines")}, {"Yv", 248 UNTIC_COMMENT("Move to beginning of same row")}, {"Yw", 258 UNTIC_COMMENT("Give name for color #1")}, - {"Yx", 260 UNTIC_COMMENT("Define rectangualar bit image region")}, + {"Yx", 260 UNTIC_COMMENT("Define rectangular bit image region")}, {"Yy", 267 UNTIC_COMMENT("End a bit-image region")}, {"Yz", 421 UNTIC_COMMENT("Change to ribbon color #1")}, {"ZA", 249 UNTIC_COMMENT("Change number of characters per inch to #1")}, @@ -410,7 +411,7 @@ {"la", 92 UNTIC_COMMENT("label on function key f10 if not f10")}, {"le", 14 UNTIC_COMMENT("move left one space")}, {"ll", 18 UNTIC_COMMENT("last line, first column (if no cup)")}, - {"ma", 468 UNTIC_COMMENT("map arrow keys rogue(1) motion keys")}, + {"ma", 468 UNTIC_COMMENT("map motion-keys for vi version 2")}, {"mb", 26 UNTIC_COMMENT("turn on blinking")}, {"md", 27 UNTIC_COMMENT("turn on bold (extra bright) mode")}, {"me", 39 UNTIC_COMMENT("turn off all attributes")}, @@ -450,7 +451,6 @@ {"s2", 413 UNTIC_COMMENT("Shift to codeset 2")}, {"s3", 414 UNTIC_COMMENT("Shift to codeset 3")}, {"sA", 462 UNTIC_COMMENT("Define second set of video attributes #1-#6")}, - {"sL", 455 UNTIC_COMMENT("YI Set page length to #1 hundredth of an inch")}, {"sa", 131 UNTIC_COMMENT("define video attributes #1-#9 (PG9)")}, {"sc", 128 UNTIC_COMMENT("save current cursor position (P)")}, {"se", 43 UNTIC_COMMENT("exit standout mode")}, @@ -487,11 +487,12 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetnum_Map = + +static Tgetstr_Map_Type Tgetnum_Map = { {"BT", 11 UNTIC_COMMENT("number of buttons on mouse")}, {"Co", 17 UNTIC_COMMENT("maximum number of colors on screen")}, - {"MW", 21 UNTIC_COMMENT("maximum number of defineable windows")}, + {"MW", 21 UNTIC_COMMENT("maximum number of definable windows")}, {"NC", 24 UNTIC_COMMENT("video attributes that can not be used with colors")}, {"Nl", 26 UNTIC_COMMENT("number of labels on screen")}, {"Ya", 10 UNTIC_COMMENT("numbers of bytes buffered before printing")}, @@ -531,7 +532,8 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetflag_Map = + +static Tgetstr_Map_Type Tgetflag_Map = { {"5i", 34 UNTIC_COMMENT("printer will not echo on screen")}, {"HC", 26 UNTIC_COMMENT("cursor is hard to see")}, @@ -559,7 +561,7 @@ {"hc", 7 UNTIC_COMMENT("hardcopy terminal")}, {"hl", 28 UNTIC_COMMENT("terminal uses only HLS color notation (Tektronix)")}, {"hs", 9 UNTIC_COMMENT("has extra status line")}, - {"hz", 18 UNTIC_COMMENT("cannot print ~'s (hazeltine)")}, + {"hz", 18 UNTIC_COMMENT("cannot print ~'s (Hazeltine)")}, {"in", 10 UNTIC_COMMENT("insert mode distinguishes nulls")}, {"km", 8 UNTIC_COMMENT("Has a meta key (i.e., sets 8th-bit)")}, {"mi", 13 UNTIC_COMMENT("safe to move while in insert mode")}, @@ -580,3 +582,4 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/parsecaps.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/parsecaps.sl
Changed
@@ -71,8 +71,7 @@ variable s = read_caps_file (__argv1); variable fp = stdout; - () = fprintf (stdout, "/* This file was autogenerated using %s */\n\n", - strjoin (__argv, " ")); + () = fprintf (stdout, "/* This file was autogenerated by parsecaps.sl */\n\n"); write_table (fp, s, "str", "Tgetstr_Map"); write_table (fp, s, "num", "Tgetnum_Map");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/uwin.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/uwin.inc
Changed
@@ -1,6 +1,6 @@ -/* This file was autogenerated using parsecaps.sl /tmp/Caps.uwin */ +/* This file was autogenerated by parsecaps.sl */ -static Tgetstr_Map_Type Tgetstr_Map = +static Tgetstr_Map_Type Tgetstr_Map = { {"!1", 212 UNTIC_COMMENT("shifted save key")}, {"!2", 213 UNTIC_COMMENT("shifted suspend key")}, @@ -145,7 +145,7 @@ {"LF", 157 UNTIC_COMMENT("turn off soft labels")}, {"LO", 156 UNTIC_COMMENT("turn on soft labels")}, {"MC", 270 UNTIC_COMMENT("clear right and left soft margins")}, - {"ML", 271 UNTIC_COMMENT("set left soft margin at current column. See smgl. (ML is not in BSD termcap).")}, + {"ML", 271 UNTIC_COMMENT("set left soft margin at current column. (ML is not in BSD termcap).")}, {"MR", 272 UNTIC_COMMENT("set right soft margin at current column")}, {"Mi", 280 UNTIC_COMMENT("Mouse status information")}, {"RA", 152 UNTIC_COMMENT("turn off automatic margins")}, @@ -257,7 +257,7 @@ {"la", 92 UNTIC_COMMENT("label on function key f10 if not f10")}, {"le", 14 UNTIC_COMMENT("move left one space")}, {"ll", 18 UNTIC_COMMENT("last line, first column (if no cup)")}, - {"ma", 299 UNTIC_COMMENT("map arrow keys rogue(1) motion keys")}, + {"ma", 299 UNTIC_COMMENT("map motion-keys for vi version 2")}, {"mb", 26 UNTIC_COMMENT("turn on blinking")}, {"md", 27 UNTIC_COMMENT("turn on bold (extra bright) mode")}, {"me", 39 UNTIC_COMMENT("turn off all attributes")}, @@ -319,7 +319,8 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetnum_Map = + +static Tgetstr_Map_Type Tgetnum_Map = { {"BT", 11 UNTIC_COMMENT("number of buttons on mouse")}, {"Co", 12 UNTIC_COMMENT("maximum number of colors on screen")}, @@ -345,7 +346,8 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetflag_Map = + +static Tgetstr_Map_Type Tgetflag_Map = { {"5i", 22 UNTIC_COMMENT("printer will not echo on screen")}, {"HC", 23 UNTIC_COMMENT("cursor is hard to see")}, @@ -366,7 +368,7 @@ {"hc", 7 UNTIC_COMMENT("hardcopy terminal")}, {"hl", 29 UNTIC_COMMENT("terminal uses only HLS color notation (Tektronix)")}, {"hs", 9 UNTIC_COMMENT("has extra status line")}, - {"hz", 18 UNTIC_COMMENT("cannot print ~'s (hazeltine)")}, + {"hz", 18 UNTIC_COMMENT("cannot print ~'s (Hazeltine)")}, {"in", 10 UNTIC_COMMENT("insert mode distinguishes nulls")}, {"km", 8 UNTIC_COMMENT("Has a meta key (i.e., sets 8th-bit)")}, {"mi", 13 UNTIC_COMMENT("safe to move while in insert mode")}, @@ -387,3 +389,4 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/array.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/array.sl
Changed
@@ -371,86 +371,99 @@ failed ("Binary operation `%s' failed", op); } -check_result (1,2 + 3,4, 4,6,"+"); -check_result (1 + 3,4, 4,5,"+"); -check_result (3,4 + 1, 4,5,"+"); +private define check_bin_result (a, op, b, ans, opstr) +{ + variable types = Char_Type, UChar_Type, Short_Type, UShort_Type, + Int_Type, UInt_Type, Long_Type, ULong_Type; + + variable atype, btype; + foreach atype (types) + { + variable aa = typecast (a, atype); + foreach btype (types) + { + variable bb = typecast (b, btype); + check_result ((@op)(aa, bb), ans, "$atype $opstr $btype"$); + } + } +} -check_result (1,2 - 3,4, -2,-2,"-"); -check_result (1 - 3,4, -2,-3,"-"); -check_result (3,4 - 1, 2,3,"-"); +check_bin_result (1,2, &_op_plus, 3,4, 4,6,"+"); +check_bin_result (1, &_op_plus, 3,4, 4,5,"+"); +check_bin_result (3,4, &_op_plus, 1, 4,5,"+"); -check_result (1,2 * 3,4, 3,8, "*"); -check_result (1 * 3,4, 3,4, "*"); -check_result (3,4 * 1, 3,4, "*"); +check_bin_result (1,2, &_op_minus, 3,4, -2,-2,"-"); +check_bin_result (1, &_op_minus, 3,4, -2,-3,"-"); +check_bin_result (3,4, &_op_minus, 1, 2,3,"-"); -check_result (12,24 / 3,4, 4,6,"/"); -check_result (12 / 3,4, 4,3,"/"); -check_result (3,4 / 1, 3,4,"/"); +check_bin_result (1,2, &_op_times, 3,4, 3,8, "*"); +check_bin_result (1, &_op_times, 3,4, 3,4, "*"); +check_bin_result (3,4, &_op_times, 1, 3,4, "*"); -check_result (1,2 mod 3,4, 1,2,"mod"); -check_result (3 mod 3,2, 0,1,"mod"); -check_result (3,4 mod 4, 3,0,"mod"); +check_bin_result (12,24, &_op_divide, 3,4, 4,6,"/"); +check_bin_result (12, &_op_divide, 3,4, 4,3,"/"); +check_bin_result (3,4, &_op_divide, 1, 3,4,"/"); -check_result (1,2 == 3,2, 0,1,"=="); -check_result (3 == 3,4, 1,0,"=="); -check_result (3,4 == 1, 0,0,"=="); +check_bin_result (1,2, &_op_mod, 3,4, 1,2,"mod"); +check_bin_result (3, &_op_mod, 3,2, 0,1,"mod"); +check_bin_result (3,4, &_op_mod, 4, 3,0,"mod"); -check_result (1,2 != 3,2, 1,0,"!="); -check_result (3 != 3,4, 0,1,"!="); -check_result (3,4 != 1, 1,1,"!="); +check_bin_result (1,2, &_op_eqs, 3,2, 0,1,"=="); +check_bin_result (3, &_op_eqs, 3,4, 1,0,"=="); +check_bin_result (3,4, &_op_eqs, 1, 0,0,"=="); -check_result (1,2 > 3,2, 0,0,">"); -check_result (1 > 3,4, 0,0,">"); -check_result (3,4 > 1, 1,1,">"); +check_bin_result (1,2, &_op_neqs, 3,2, 1,0,"!="); +check_bin_result (3, &_op_neqs, 3,4, 0,1,"!="); +check_bin_result (3,4, &_op_neqs, 1, 1,1,"!="); -check_result (1,2 >= 3,2, 0,1,">="); -check_result (1 >= 3,4, 0,0,">="); -check_result (3,4 >= 1, 1,1,">="); +check_bin_result (1,2, &_op_gt, 3,2, 0,0,">"); +check_bin_result (1, &_op_gt, 3,4, 0,0,">"); +check_bin_result (3,4, &_op_gt, 1, 1,1,">"); -check_result (1,2 >= 3,2, 0,1,">="); -check_result (1 >= 3,4, 0,0,">="); -check_result (3,4 >= 1, 1,1,">="); +check_bin_result (1,2, &_op_ge, 3,2, 0,1,">="); +check_bin_result (1, &_op_ge, 3,4, 0,0,">="); +check_bin_result (3,4, &_op_ge, 1, 1,1,">="); -check_result (1,2 < 3,2, 1,0,"<"); -check_result (1 < 3,4, 1,1,"<"); -check_result (3,4 < 1, 0,0,"<"); +check_bin_result (1,2, &_op_lt, 3,2, 1,0,"<"); +check_bin_result (1, &_op_lt, 3,4, 1,1,"<"); +check_bin_result (3,4, &_op_lt, 1, 0,0,"<"); -check_result (1,2 <= 3,2, 1,1,"<="); -check_result (1 <= 3,4, 1,1,"<="); -check_result (3,4 <= 1, 0,0,"<="); +check_bin_result (1,2, &_op_le, 3,2, 1,1,"<="); +check_bin_result (1, &_op_le, 3,4, 1,1,"<="); +check_bin_result (3,4, &_op_le, 1, 0,0,"<="); #ifexists Double_Type -check_result (1,2 ^ 3,2, 1,4,"^"); -check_result (1 ^ 3,4, 1,1,"^"); -check_result (3,4 ^ 1, 3,4,"^"); -check_result (3,4 ^ 0, 1,1,"^"); +check_bin_result (1,2, &_op_pow, 3,2, 1,4,"^"); +check_bin_result (1, &_op_pow, 3,4, 1,1,"^"); +check_bin_result (3,4, &_op_pow, 1, 3,4,"^"); +check_bin_result (3,4, &_op_pow, 0, 1,1,"^"); #endif -check_result (1,2 or 3,2, 1,1,"or"); -check_result (1 or 3,4, 1,1,"or"); -check_result (0,1 or 1, 1,1,"or"); +check_bin_result (1,2, &_op_or, 3,2, 1,1,"or"); +check_bin_result (1, &_op_or, 3,4, 1,1,"or"); +check_bin_result (0,1, &_op_or, 1, 1,1,"or"); -check_result (1,2 and 3,2, 1,1,"and"); -check_result (1 and 0,4, 0,1,"and"); -check_result (3,4 and 0, 0,0,"and"); +check_bin_result (1,2, &_op_and, 3,2, 1,1,"and"); +check_bin_result (1, &_op_and, 0,4, 0,1,"and"); +check_bin_result (3,4, &_op_and, 0, 0,0,"and"); -check_result (1,2 & 3,2, 1,2,"&"); -check_result (1 & 3,4, 1,0,"&"); -check_result (3,4 & 1, 1,0,"&"); +check_bin_result (1,2, &_op_band, 3,2, 1,2,"&"); +check_bin_result (1, &_op_band, 3,4, 1,0,"&"); +check_bin_result (3,4, &_op_band, 1, 1,0,"&"); -check_result (1,2 | 3,2, 3,2,"|"); -check_result (1 | 3,4, 3,5,"|"); -check_result (3,4 | 1, 3,5,"|"); +check_bin_result (1,2, &_op_bor, 3,2, 3,2,"|"); +check_bin_result (1, &_op_bor, 3,4, 3,5,"|"); +check_bin_result (3,4, &_op_bor, 1, 3,5,"|"); -check_result (1,2 xor 3,2, 2,0,"xor"); -check_result (1 xor 3,4, 2,5,"xor"); -check_result (3,4 xor 1, 2,5,"xor"); +check_bin_result (1,2, &_op_xor, 3,2, 2,0,"xor"); +check_bin_result (1, &_op_xor, 3,4, 2,5,"xor"); +check_bin_result (3,4, &_op_xor, 1, 2,5,"xor"); -check_result (1,2 shl 3,2, 8,8,"shl"); -check_result (1 shl 3,4, 8,16,"shl"); -check_result (3,4 shl 1, 6,8,"shl"); +check_bin_result (1,2, &_op_shl, 3,2, 8,8,"shl"); +check_bin_result (1, &_op_shl, 3,4, 8,16,"shl"); +check_bin_result (3,4, &_op_shl, 1, 6,8,"shl"); -check_result (1,4 shr 3,1, 0,2,"shr"); -check_result (8 shr 3,4, 1,0,"shr"); -check_result (3,4 shr 1, 1,2,"shr"); +check_bin_result (1,4, &_op_shr, 3,1, 0,2,"shr"); +check_bin_result (8, &_op_shr, 3,4, 1,0,"shr"); +check_bin_result (3,4, &_op_shr, 1, 1,2,"shr"); % Test __tmp optimizations private define test_tmp () @@ -732,9 +745,12 @@ test_sum (A,1); test_sum (A,0); +#ifexists Complex_Type A = 1+2i, 2+3i, 3+4i; if (sum(A) != A0 + A1 + A2) failed ("sum(Complex)"); +#endif + #endif % Double_Type define find_min (a) @@ -1449,7 +1465,9 @@ test_array_types (1h, 1L); test_array_types (1h, 1f); test_array_types (1h, 1.0); +#ifexists Complex_Type test_array_types (1h, 1j); +#endif test_array_types ("a", "a\0"); % Test presence of NULLs in inline arrays @@ -1659,9 +1677,11 @@ variable s, t; s = sumsq (a); +#ifexists Complex_Type if (_typeof (a) == Complex_Type) t = sumsq (Real(a)) + sumsq(Imag(a)); else +#endif t = sum (a*a); if (s != t) @@ -1915,6 +1935,57 @@ test_init_char_array ("HelloWorld"); test_init_char_array ("\xAB\xCD\xEF");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/assoc.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/assoc.sl
Changed
@@ -207,7 +207,9 @@ { "foo", 1, "bar", PI, +#ifexists Complex_Type "complex", 2+3i, +#endif "string", "foobar", "array", 1,2,3,4, "struct", struct {foo, bar}, @@ -224,7 +226,9 @@ { "foo", "1", "bar", "3.141592653589793", +#ifexists Complex_Type "complex", "(2 + 3i)", +#endif "string", "foobar", "array", "Integer_Type4", "struct", "Struct_Type with 2 fields",
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/eqs.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/eqs.sl
Changed
@@ -5,8 +5,10 @@ if (0 == _eqs (1h, 1L)) failed ("_eqs(1h,1L)"); +#ifexists Complex_Type if (0 == _eqs (1h, 1+0i)) failed ("_eqs(1h,1+0i)"); +#endif if (0 == _eqs (1h:10h, 1L:10L)) failed ("_eqs (arrays of ints)");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/list.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/list.sl
Changed
@@ -279,7 +279,10 @@ private define test_api_list () { variable list = {"string", 10, - PI, 3i, + PI, +#ifexists Complex_Type + 3i, +#endif &failed, 1:10, Struct_Type12, Assoc_Type}; variable clist = api_create_list (__push_list (list)); @@ -306,7 +309,11 @@ private define test_api_pop_and_push_list () { - variable l1 = { 1, PI, 2+3i, "foobar", 1,2,3,4, struct {foo, bar}, Assoc_TypeInteger_Type, 42 }; + variable l1 = { 1, PI, +#ifexists Complex_Type + 2+3i, +#endif + "foobar", 1,2,3,4, struct {foo, bar}, Assoc_TypeInteger_Type, 42 }; l1; variable l2 = api_pop_and_push_list (); ifnot (__is_same (l1, l2))
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/math.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/math.sl
Changed
@@ -341,11 +341,11 @@ if (fneqs (log(ten), 2.302585092994046, 1e-6)) failed("log(%S)",ten); if (fneqs (exp(one), E, 1e-6)) failed("exp(%S)",one); if (log10(ten) != 1) failed("log10(%S)", ten); - +#ifexists Complex_Type if (Imag(one) != 0) failed ("Imag(%S)", one); if (Real(one) != 1) failed ("Real(%S)", one); if (Conj(one) != 1) failed ("Conj(%S)", one); - +#endif one = one, one, one; ten = ten,ten,ten; if (any(fneqs (tan(one), 1.5574077246549023, 1e-6))) failed("tan(%S)",one); @@ -363,9 +363,11 @@ if (any(fneqs (log(ten), 2.302585092994046, 1e-6))) failed("log(%S)",ten); if (any(fneqs (exp(one), E, 1e-6))) failed("exp(%S)",one); if (any(log10(ten) != 1)) failed("log10(%S)", ten); +#ifexists Complex_Type if (any(Imag(one) != 0)) failed ("Imag(%S)", one); if (any(Real(one) != 1)) failed ("Real(%S)", one); if (any(Conj(one) != 1)) failed ("Conj(%S)", one); +#endif } } test_misc_trig ();
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/multline.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/multline.sl
Changed
@@ -13,15 +13,20 @@ ml = eval(`"` + ml + `";`); if (str != ml) { - failed ("%s --> %s", str, ml); + failed ("\n1: %s --> %s", str, ml); } ml = break_string (str, "\n"); ml = eval(```` + ml + ```;`); if (str != ml) { - failed ("%s --> %s", str, ml); + failed ("\n2: %s --> %s", str, ml); } + + ml = break_string (str, "\\n\\\r\n"); + ml = eval ("\"" + ml + "\""); + if (str != ml) + failed ("\n3: %s --> %s", str, ml); } test_string ("1 This is\na multiline\nstring\n"); @@ -41,16 +46,25 @@ test_string2 (`3 This is\\\na multiline\nstring\nX`Q, "3 This is\\\na multiline\nstring\nX"); -eval("\ -define test_string3 (str, ans)\n\ +private variable Test_String_Body = "\n\ {\n\ if (str != ans)\n\ {\n\ - failed (\"str != ans, where str=%S, ans=%S\", str, ans);\n\ + failed (\"str != ans, where\\nstr=%S,\\nans=%S\\n\", str, ans);\n\ return;\n\ }\n\ }\n\ -"); +"; + +eval ("define test_string3a (str, ans)" + Test_String_Body); +eval ("define test_string3b (str, ans)" + strreplace(Test_String_Body, "\n", "\r\n")); + +private define test_string3 (a, b) +{ + test_string3a (a, b); + test_string3b (a, b); +} + test_string3 (`2 This is\na multiline\nstring\n`, "2 This is\\na multiline\\nstring\\n"); test_string3 (`3 This is\\\na multiline\nstring\nX`Q, @@ -67,6 +81,9 @@ string\0`BQ, "6 This is\n a \0 binary\n string\0"); +test_string3 (eval("`7 This is\r\n a \\0 binary\r\n string\\0`BQ"), + "7 This is\r\n a \0 binary\r\n string\0"); + print ("Ok\n"); exit (0);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/posdir.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/posdir.sl
Changed
@@ -45,12 +45,30 @@ } test_posdir (); +private define compare_stat (st, st1) +{ + if ((st1.st_dev != st.st_dev) + || (st1.st_ino != st.st_ino)) + failed ("stat compare"); +} + private define test_non_exist_file_ops () { variable badfile = "/122345 user"; if (NULL == stat_file (badfile)) () = remove (badfile); % should fail variable tmpfile = util_make_tmp_file ("tmpfileX", NULL); + variable st = stat_file (tmpfile); + if (st == NULL) + failed ("stat_file tmpfile"); + variable fp = fopen (tmpfile, "r"); + variable st1 = stat_file (fp); + if (st1 == NULL) failed ("stat_file fp"); + compare_stat (st, st1); + st1 = stat_file (fileno(fp)); + if (st1 == NULL) failed ("stat_file fileno(fp)"); + compare_stat (st, st1); + variable tmpfile1 = tmpfile + "-tmp"; variable tmpdir = util_make_tmp_dir ("tmpdir"); variable dir = getcwd (); @@ -76,7 +94,7 @@ #ifexists symlink if (-1 == symlink (tmpfile, tmpfile1)) failed ("symlink %s -> %s: %S", tmpfile1, tmpfile, errno_string()); - variable st = lstat_file (tmpfile1); + st = lstat_file (tmpfile1); if ((st == NULL) || (0 == stat_is ("lnk", st.st_mode))) failed ("stat_is lnk for %s", tmpfile1); if (-1 != symlink ("", ""))
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/posixio.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/posixio.sl
Changed
@@ -8,7 +8,9 @@ variable new_text, nbytes, len; variable pos; - file = util_make_tmp_file ("tmpfile", &fd); + % Avoid an NFS mount. The flock function can fail if lockd is not + % running on the server + file = util_make_tmp_file ("/tmp/sltest-tmpfile", &fd); if (-1 == write (fd, some_text)) failed ("write"); @@ -45,6 +47,23 @@ if (bstrlen (new_text)) failed ("read at EOF"); + if (0 == flock (fd, LOCK_EX)) + { + variable fp = fopen (file, "r"); + if ((-1 != flock (fp, LOCK_EX|LOCK_NB)) + || (errno != EWOULDBLOCK)) + { + () = failed ("flock LOCK_NB"); + } + () = fclose (fp); + } + else failed ("flock LOCK_EX: %S", errno_string()); + + if (-1 == flock (fd, LOCK_UN)) + { + failed ("flock LOCK_UN: %S", errno_string()); + } + if (-1 == _close (_fileno(fd))) failed ("_close after tests"); if (0 == close (fd)) failed ("Expected close to fail since _close was already used");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/qualif.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/qualif.sl
Changed
@@ -318,6 +318,29 @@ } test_intrinsic_qualifiers (); +private define check_qualifier (x) +{ + return x + qualifier ("bar", 0); +} + +private define test_array_map_qualifiers (dx) +{ + variable x = 1:10; + variable y = array_map (Int_Type, &check_qualifier, x; bar=dx); + ifnot (_eqs (y, x+dx)) + { + () = array_map (Int_Type, &fprintf, stdout, "%d, %d\n", y, x+dx); + failed ("array_map with explicit qualifiers failed"); + } + y = array_map (Int_Type, &check_qualifier, x;; __qualifiers); + ifnot (_eqs (y, x + qualifier("bar", 0))) + { + failed ("array_map with implicit qualifier failed"); + } +} +test_array_map_qualifiers (11; bar=130, foo=1); +test_array_map_qualifiers (11); + print ("Ok\n"); exit (0);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/regexp.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/regexp.sl
Changed
@@ -24,12 +24,28 @@ test_regexp (`.*d`, "ffdoodfoo fob", 1, "ffdood"); test_regexp (`.?d`, "ffdoodfoo fob", 2, "fd"); test_regexp (`.+d`, "ffdoodfoo fob", 1, "ffdood"); -test_regexp (`.\{1,3\}d`, "ffdoodfoo fob", 1, "ffd"); -test_regexp (`.\{1,\}d`, "ffdoodfoo fob", 1, "ffdood"); -test_regexp (`.\{4,\}d`, "ffdoodfoo fob", 1, "ffdood"); -test_regexp (`.\{3,4\}d`, "ffdoodfoo fob", 2, "fdood"); + +% Looping test the RE cache +loop (7) +{ + test_regexp (`.\{1,3\}d`, "ffdoodfoo fob", 1, "ffd"); + loop (5) + { + test_regexp (`.\{1,\}d`, "ffdoodfoo fob", 1, "ffdood"); + loop (3) + { + test_regexp (`.\{4,\}d`, "ffdoodfoo fob", 1, "ffdood"); + test_regexp (`.\{3,4\}d`, "ffdoodfoo fob", 2, "fdood"); + } + } +} + test_regexp (`.\{3\}d`, "ffdoodfoo fob", 3, "dood"); +test_regexp(`\s+fo\so`, "fo o fo od", 5, " fo o"); +test_regexp(`\s+\S+\s?d`, "fo o fo od", 11, " od"); +test_regexp(`\s+\S+\s?o`, "fo o fo od", 5, " fo o"); + test_regexp (`\cA-Z+`, "fooFOO4", 4, "FOO"); test_regexp (`\CA-Z+`, "fooFOO4", 1, "fooFOO"); test_regexp (`\<fo+`, "ffoodfoo fob", 10, "fo"); @@ -137,6 +153,7 @@ test_regexp_match (`=\(\d+\)`, "L=12X", 2, "12"); test_regexp_match (`=\(\d*\)`, "L=1X", 2, "1"); test_regexp_match (`=\(\d*\)`, "L=X", 2, ""); +test_regexp_match (`\D+\d+\D?\(\d+\)`, "L=12X13", 1, "13"); static define test_globbing (glob, re) {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/sltest.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/sltest.c
Changed
@@ -177,6 +177,8 @@ MAKE_CSTRUCT_FIELD(CStruct_Type, i, "i", SLANG_INT_TYPE, 0), #if SLANG_HAS_FLOAT MAKE_CSTRUCT_FIELD(CStruct_Type, d, "d", SLANG_DOUBLE_TYPE, 0), +#endif +#if SLANG_HAS_COMPLEX MAKE_CSTRUCT_FIELD(CStruct_Type, c, "z", SLANG_COMPLEX_TYPE, 0), #endif MAKE_CSTRUCT_FIELD(CStruct_Type, s, "s", SLANG_STRING_TYPE, 0),
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/stdio.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/stdio.sl
Changed
@@ -268,23 +268,58 @@ static define test_fgetsputslines () { - variable lines = array_map (String_Type, &string, 1:1000); + variable lines, lines1; + + lines = array_map (String_Type, &string, 1:1000); lines += "\n"; - variable file; - variable fp = fopen_tmp_file (&file, "w"); + + variable fp, file; + + fp = fopen_tmp_file (&file, "w"); if (length (lines) != fputslines (lines, fp)) failed ("fputslines"); if (-1 == fclose (fp)) failed ("fputslines;fclose"); + fp = fopen (file, "r"); if (fp == NULL) failed ("fputslines...fopen"); - variable lines1 = fgetslines (fp); + lines1 = fgetslines (fp); if (0 == _eqs (lines1, lines)) failed ("fgetslines"); ()=fclose (fp); if (-1 == remove (file)) failed ("remove:" + errno_string(errno)); + + lines = array_map (String_Type, &string, 1:1000); + lines10:20:3 = ""; + lines = " \t" + lines + " \n"; + + variable a = Array_Type4; + a0 = lines; + a1 = strtrim_end (lines); + a2 = strtrim_beg (lines); + a3 = strtrim (lines); + + fp = fopen_tmp_file (&file, "w"); + if (length (lines) != fputslines (lines, fp)) + failed ("fputslines"); + if (-1 == fclose (fp)) + failed ("fputslines;fclose"); + + _for (0, 3, 1) + { + variable t = (); + fp = fopen (file, "r"); + if (fp == NULL) + failed ("fputslines...fopen"); + ifnot (_eqs (at, fgetslines (fp; trim=t))) + failed ("fgetslines with trim=%d", t); + () = fclose (fp); + } + + if (-1 == remove (file)) + failed ("remove:" + errno_string(errno)); } test_fgetsputslines ();
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/strops.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/strops.sl
Changed
@@ -990,8 +990,34 @@ if (us != cs) failed ("sprintf %%c with signed and unsigned char"); + + variable ans = " 6"; + variable s = sprintf ("%*d", 4, 6); + if (s != ans) + failed ("sprintf (%%*d, 4, 6) ==> \"%S\", expected \"%S\"", s, ans); + + ans = "0006"; + if (ans != sprintf ("%0*d", 4, 6)) + failed ("sprintf (%%0*d, 4, 6)"); } + test_sprintf (); +private define test_issubstr () +{ + variable a = String_Type4; + a2 = "foobar"; + a3 = "oo"; + + variable i = where(is_substr (a, "foo")); + ifnot (_eqs (i, 2)) + failed ("test_issubstr: foo"); + + i = where (is_substr ("oo", a)); + ifnot (_eqs (i, 3)) + failed ("test_issubstr: oo"); +} +test_issubstr (); + print ("Ok\n"); exit (0);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/struct.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/struct.sl
Changed
@@ -478,6 +478,7 @@ } __add_typecast (Vector_Type, List_Type, &vector_to_list); +#ifexists Complex_Type private define vector_to_complex (v) { return v.x + 1j*v.y; @@ -487,6 +488,7 @@ return (vector_to_complex (v) == z); } __add_typecast (Vector_Type, Complex_Type, &vector_to_complex); +#endif private define vector_to_stdout (v) { @@ -518,7 +520,10 @@ failed ("simple vector not equal to %S", to); v = vector(4,5,6), vector (7,8,9), - vector (1i,2i,3i); +#ifexists Complex_Type + vector (1i,2i,3i) +#endif + ; l = typecast (v, to); _for (0, length (v)-1, 1) { @@ -528,7 +533,9 @@ } } test_typecast (List_Type, &is_vector_eq_to_list); +#ifexists Complex_Type test_typecast (Complex_Type, &is_vector_eq_to_complex); +#endif test_typecast (File_Type, &is_vector_eq_to_stdout); test_typecast (String_Type, &is_vector_eq_to_string);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/untic.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/untic.c
Changed
@@ -8,6 +8,36 @@ exit (1); } +static void print_string_cap (const char *name, unsigned char *str, char *comment) +{ + fprintf (stdout, "\t%s=", name); + while (*str) + { + if ((int) (*str & 0x7F) < ' ') + { + putc ('^', stdout); + *str += '@'; + } + putc (*str, stdout); + str++; + } + if (comment != NULL) + fprintf (stdout, "\t\t%s", comment); + putc ('\n', stdout); +} + +static void print_bool_cap (const char *name, char *comment) +{ + fprintf (stdout, "\t%s\t\t%s\n", name, + ((comment == NULL) ? "" : comment)); +} + +static void print_numeric_cap (const char *name, int val, char *comment) +{ + fprintf (stdout, "\t%s#%d\t\t%s\n", name, val, + ((comment == NULL) ? "" : comment)); +} + int main (int argc, char **argv) { SLterminfo_Type *t; @@ -44,20 +74,7 @@ /* str = (unsigned char *) "NULL"; */ } - fprintf (stdout, "\t%s=", map->name); - while (*str) - { - if ((int) (*str & 0x7F) < ' ') - { - putc ('^', stdout); - *str += '@'; - } - putc (*str, stdout); - str++; - } - if (map->comment != NULL) - fprintf (stdout, "\t\t%s", map->comment); - putc ('\n', stdout); + print_string_cap (map->name, str, map->comment); map++; } @@ -65,11 +82,7 @@ while (*map->name != 0) { if (_pSLtt_tigetflag (t, map->name) > 0) - { - fprintf (stdout, "\t%s\t\t%s\n", - map->name, - ((map->comment == NULL) ? "" : map->comment)); - } + print_bool_cap (map->name, map->comment); map++; } map = Tgetnum_Map; @@ -77,12 +90,35 @@ { int val; if ((val = SLtt_tigetnum ((SLFUTURE_CONST char *)map->name, (char **) &t)) >= 0) + print_numeric_cap (map->name, val, map->comment); + + map++; + } + + if (t->ext != NULL) + { + Extended_Cap_Type *e = t->ext; + int i; + + fprintf (stdout, "Local Extensions:\n"); + for (i = 0; i < e->num_string; i++) { - fprintf (stdout, "\t%s#%d\t\t%s\n", - map->name, val, - ((map->comment == NULL) ? "" : map->comment)); + str = (unsigned char *) SLtt_tigetstr ((SLFUTURE_CONST char *)e->string_capsi, (char **) &t); + if (str != NULL) print_string_cap (e->string_capsi, str, NULL); + } + + for (i = 0; i < e->num_bool; i++) + { + if (_pSLtt_tigetflag (t, e->bool_capsi) > 0) + print_bool_cap (e->bool_capsi, NULL); + } + + for (i = 0; i < e->num_numeric; i++) + { + int val; + if ((val = SLtt_tigetnum ((SLFUTURE_CONST char *)e->numeric_capsi, (char **) &t)) >= 0) + print_numeric_cap (e->numeric_capsi, val, NULL); } - map++; } _pSLtt_tifreeent (t);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/util/mkslarith2.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/util/mkslarith2.sl
Changed
@@ -1,235 +1,417 @@ -#!/usr/bin/env slsh - -private variable CTypes = - "signed char", "unsigned char", "short", "unsigned short", "int", "unsigned int", - "long", "unsigned long", "long long", "unsigned long long", - "float", "double", "long double"; -private variable Is_Int_Type = - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0; - -private variable Precedence = - 0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 5, 6; - -private variable SLTypes = - "CHAR", "UCHAR", "SHORT", "USHORT", "INT", "UINT", - "LONG", "ULONG", "LLONG", "ULLONG", - "FLOAT", "DOUBLE", "LDOUBLE"; -private variable FNames = - "char", "uchar", "short", "ushort", "int", "uint", - "long", "ulong", "llong", "ullong", - "float", "double", "ldouble"; -% private variable Compile_If = -% "", "", "SHORT_IS_NOT_INT", "SHORT_IS_NOT_INT", "", "", -% "LONG_IS_NOT_INT", "LONG_IS_NOT_INT", -% "defined(HAVE_LONG_LONG)", "defined(HAVE_LONG_LONG)", -% "SLANG_HAS_FLOAT", "SLANG_HAS_FLOAT", "defined(HAVE_LONG_DOUBLE)"; -private variable Compile_If = - "", "", "", "", "", "", "", "", - "defined(HAVE_LONG_LONG)", "defined(HAVE_LONG_LONG)", - "SLANG_HAS_FLOAT", "SLANG_HAS_FLOAT", "defined(HAVE_LONG_DOUBLE)"; - -private variable Else_Alias = - "", "", "int", "uint", "", "", "int", "uint", "", "", "", "", ""; - -define mkarith_copy_funs (fp) +private variable Type_Info_List = {}; +private define add_type_info (ctype, sltype, fname, + isdefined, ifnot_alias, elsealias, + isfloat, rank) { - variable ntypes = length (CTypes); - variable i, j; - _for i (0, ntypes-1, 1) + variable is_small_int = is_substr (ctype, "short") || is_substr(ctype, "char"); + variable is_unsigned = is_substr (ctype, "unsigned"); + variable pow_function = "pow((double)(a),(double)(b))"; + variable pow_result_type = "double"; + if (ctype == "float") pow_result_type = "float"; + if (ctype == "long double") { - variable ctype = CTypesi; - variable is_int = Is_Int_Typei; - variable sltype = SLTypesi; - variable fname = FNamesi; - variable compile_if = Compile_Ifi; - variable prec = Precedencei; - variable else_alias = Else_Aliasi; - variable s_fname = fname; - if (s_fname0 == 'u') s_fname = substr (s_fname, 2, -1); + pow_function = "lpow(($ctype)(a),($ctype)(b))"$; + pow_result_type = ctype; + } - () = fprintf (fp, "/* ------------ %s ---------- */\n", ctype); + variable fname_signed = fname, ctype_unsigned = ctype; + if (is_unsigned) + { + fname_signed = fname_signed1:; % uint --> int + ctype_unsigned = strtrim (strreplace(ctype, "unsigned", "")); + } - if (compile_if != "") - () = fprintf (fp, "#if %s\n", compile_if); + % fname_signed is the signed counterpart of an unsigned name - variable is_long = (s_fname == "long"); + variable s = struct + { + ctype = ctype, sltype = sltype, fname = fname, + fname_signed = fname_signed, isdefined = isdefined, + ifnot_alias = ifnot_alias, else_alias = elsealias, + isfloat = isfloat, is_unsigned = is_unsigned, + rank = rank, is_small_int = is_small_int, + pow_function = "pow((double)(a),(double)(b))", + pow_result_type = "double", + mod_function = "((a) % (b))", + abs_function = (is_unsigned) ? "(a)" : "abs(a)", + push_scalar_fun = "SLclass_push_${fname_signed}_obj(SLANG_${sltype}_TYPE, ($ctype_unsigned)(a))"$, + push_pow_fun = "SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (a))", + }; + + if (is_small_int) + { + s.push_scalar_fun = "SLclass_push_int_obj(SLANG_INT_TYPE, (int)(a))"; + } - _for j (0, ntypes-1, 1) - { - variable ctype1 = CTypesj; - variable is_int1 = Is_Int_Typej; - variable sltype1 = SLTypesj; - variable fname1 = FNamesj; - variable compile_if1 = Compile_Ifj; - variable else_alias1 = Else_Aliasj; - variable prec1 = Precedencej; - variable s_fname1; - - if (compile_if1 != "") - () = fprintf (fp, "#if %s\n", compile_if1); - - s_fname1 = fname1; - if (s_fname10 == 'u') s_fname1 = substr (s_fname1, 2, -1); - variable is_long1 = (s_fname1 == "long"); - variable is_conditional = is_long || is_long1; - - variable def1 = sprintf ("copy_%s_to_%s", fname, fname1); - variable def2 = sprintf ("%s_to_%s", fname, fname1); - - if ((s_fname1 == s_fname) - and ((s_fname1 != fname1) or (s_fname != fname))) - () = fprintf (fp, "#define copy_%s_to_%s\tcopy_%s_to_%s\n", - fname, fname1, s_fname, s_fname1); - else - { - if (is_conditional) - { - () = fputs ("#if LONG_IS_INT\n", fp); - if (is_long1) - () = fputs ("# define $def1 copy_${fname}_to_${else_alias1}\n"$, fp); - else - () = fputs ("# define $def1 copy_${else_alias}_to_${fname1}\n"$, fp); - () = fputs ("#else\n", fp); - } - () = fputs ("DEFUN_1($def1,$ctype,$ctype1)\n"$, fp); - if (is_conditional) - () = fputs ("#endif\n", fp); - } + if (ctype == "long") s.abs_function = "labs(a)"; + if (ctype == "long long") s.abs_function = ("(((a) >= 0) ? (a) : -(a))"); + if (ctype == "float") + { + s.pow_result_type = ctype; + s.mod_function = "(float)fmod((a),(b))"; + s.abs_function = "(float)fabs((double)(a))"; + s.push_pow_fun = "SLclass_push_float_obj(SLANG_FLOAT_TYPE,(a))"; + } + if (ctype == "double") + { + s.mod_function = "fmod((a),(b))"; + s.abs_function = "fabs(a)"; + } + if (ctype == "long double") + { + s.pow_function = "lpow(($ctype)(a),($ctype)(b))"$; + s.pow_result_type = ctype; + s.abs_function = "fabsl(a)"; + s.mod_function = "fmodl((a),(b))"; + s.push_pow_fun = "SLclass_push_ldouble_obj(SLANG_LDOUBLE_TYPE,(a))"; + } + %print (s); + list_append (Type_Info_List, s); +} - if (prec < prec1) - { - if (is_conditional) - { - () = fputs ("#if LONG_IS_INT\n", fp); - if (is_long1) - () = fputs ("# define $def2 ${fname}_to_${else_alias1}\n"$, fp); - else - () = fputs ("# define $def2 ${else_alias}_to_${fname1}\n"$, fp); - () = fputs ("#else\n", fp); - } - () = fputs ("DEFUN_2($def2,$ctype,$ctype1,$def1)\n"$, fp); - if (is_conditional) - () = fputs ("#endif\n", fp); - } - else - { - () = fprintf (fp, "#define %s_to_%s\tNULL\n", fname, fname1); - } -#iffalse - if (else_alias != "") - { - () = fprintf (fp, "#else\n"); - () = fprintf (fp, "# define copy_%s_to_%s\tcopy_%s_to_%s\n", - fname, fname1, fname, else_alias); - if (prec < prec1) - { - if (fname != else_alias) - () = fprintf (fp, "# define %s_to_%s\t%s_to_%s\n", - fname, fname1, fname, else_alias); - } - } -#endif - if (compile_if1 != "") - () = fprintf (fp, "#endif /* %s */\n", compile_if1); - } +add_type_info ("signed char", "CHAR", "char", NULL, NULL, NULL, 0, 1);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/util/perfhash.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/util/perfhash.c
Changed
@@ -1,4 +1,4 @@ -/* Copyright (c) 1998-2017,2018 John E. Davis +/* Copyright (c) 1998-2021,2022 John E. Davis This file is part of the S-Lang Library. The S-Lang Library is free software; you can redistribute it and/or
Locations
Projects
Search
Status Monitor
Help
Open Build Service
OBS Manuals
API Documentation
OBS Portal
Reporting a Bug
Contact
Mailing List
Forums
Chat (IRC)
Twitter
Open Build Service (OBS)
is an
openSUSE project
.
浙ICP备2022010568号-2