This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.
the qa-dot test runs but fails at semaphoreQuote from: "jonok"
Code Select $ (login as root)
$ cygserver-config
$ cygrunsrv --install cygserver -p /usr/sbin/cygserver
$ cygrunsrv --start cygserver
$ make -f makefile_cygwin
$ ./newlisp.exe -n qa-dot
Testing built-in functions ...
Testing contexts as objects and scoping rules ...
total time: 5411
>>>>> ALL FUNCTIONS FINISHED SUCCESSFUL: ./newlisp
Did you do this with a specific purpose or just for replication?Quote from: "conan"
Code Select diff --git a/nl-sock.c b/nl-sock.c
index 00efa7b..9acdaa7 100644
--- a/nl-sock.c
+++ b/nl-sock.c
@@ -1485,7 +1485,12 @@ handle = open(logFile, O_RDWR | O_APPEND | O_BINARY | O_CREAT,
if(write(handle, text, strlen(text)) < 0) return;
if(newLine)
if(write(handle, &LINE_FEED, LINE_FEED_LEN) < 0) return;
+
+#ifdef WINDOWS
+_close(handle);
+#else
close(handle);
+#endif
}
diff --git a/nl-web.c b/nl-web.c
index 518fca0..99b516a 100644
--- a/nl-web.c
+++ b/nl-web.c
@@ -1183,7 +1183,11 @@ switch(type)
}
transferred = readPayLoad(size, buff, outFile, request);
+#ifdef WINDOWS
+ _close(outFile);
+#else
close(outFile);
+#endif
if(transferred != -1)
{
Code Select #ifdef WINDOWS
-#define close(s) closesocket(s)
#else
#include <sys/socket.h>
#define SOCKET_ERROR -1
#define INVALID_SOCKET -1
+#define closesocket(s) close(s)
#endifCode Select > newlisp -v
newLISP v.10.5.2 32-bit on Win32 IPv4/6 UTF-8 libffi.
> newlisp json-test.lsp
fail1.json -> pass : "A JSON payload should be an object or array, not a string."
fail7.json -> pass : ["Comma after the close"],
fail8.json -> pass : ["Extra close"]]
fail10.json -> pass : {"Extra value after close": true} "misplaced quoted value"
fail13.json -> pass : {"Numbers cannot have leading zeroes": 013}
fail15.json -> pass : ["Illegal backslash escape: x15"]
fail17.json -> pass : ["Illegal backslash escape: 17"]
fail18.json -> pass : [[[[[[[[[[[[[[[[[[[["Too deep"]]]]]]]]]]]]]]]]]]]]
fail25.json -> pass : [" tab character in string "]
fail26.json -> pass : ["tab character in string "]
fail27.json -> pass : ["line
break"]
fail28.json -> pass : ["line
break"]
Code Select newLISP v.10.5.2 32-bit on Win32 IPv4/6 UTF-8 libffi, options: newlisp -h
> (json-parse [text]{"a backslash":"\"}[/text])
(("a backslash" "\\"))
Code Select > (setf data [text]{"foo": ["bar", ""baz""]}[/text])
"{"foo": ["bar", "\"baz\""]}"
> (json-parse data)
nil
> (json-error)
("invalid JSON array format" 19)
Code Select > (module "json.lsp")
MAIN
> (json2expr data)
(("foo" ("bar" ""baz"")))
Code Select > (/ 123000000000L 1)
123L
> (/ 12300000000000000000000000000L 1)
12300000000000000001L
> (/ 123000000000000000000000000000L 1)
123000000001^[,),(-*,(LCode Select newLISP v.10.5.0 32-bit on Win32 IPv4/6 UTF-8 libffi, options: newlisp -h
> (bigint "HELLO")
264111L
> (bigint "")
(null)L
> (bigint "-L")
; segmentation faultCode Select > (int "3.14")
3
> (bigint "3.14")
2814L ; expect 3LAfter those 2 fixes, newlisp would compile, but behaved erroneously like this:Quote
$ newlisp
newLISP v.10.4.6 on Win32 IPv4/6 UTF-8, execute 'newlisp -h' for options.
> (+ 10 20 30)
ERR: missing parenthesis : "...(+ 10 20 30 "
> (exit)
ERR: missing parenthesis : "...(exit "
Code Select /*
Set binary as default file mode for Windows.
See also http://www.mingw.org/MinGWiki/index.php/binary
*/
unsigned int _CRT_fmode = _O_BINARY;
Code Select #include <stdio.h>
#include <fcntl.h>
#include <io.h>
...
int main(...) {
#if _WIN32
_setmode(_fileno(stdin), _O_BINARY);
_setmode(_fileno(stdout), _O_BINARY);
_setmode(_fileno(stderr), _O_BINARY);
#endif
}
Code Select int kill(pid_t pid, int sig);Code Select diff -wru newlisp-10.4.4-orig/nl-filesys.c newlisp-10.4.4/nl-filesys.c
--- newlisp-10.4.4-orig/nl-filesys.c 2012-09-14 00:00:27 +0900
+++ newlisp-10.4.4/nl-filesys.c 2012-10-05 14:34:46 +0900
@@ -72,6 +72,8 @@
#define pclose _pclose
#define pipe _pipe
+int kill(pid_t pid, int sig);
+
/*
Set binary as default file mode for Windows.
See also http://www.mingw.org/MinGWiki/index.php/binary
@@ -1142,22 +1144,25 @@
{
char * cPtr;
char * argv[16];
-int idx;
+HANDLE hProc;
+DWORD pid;
cPtr = callocMemory(len + 1);
memcpy(cPtr, command, len + 1);
init_argv(cPtr, argv);
-idx = spawnvp(P_NOWAIT, argv[0], (const char * const *)argv);
+hProc = (HANDLE)_spawnvp(P_NOWAIT, argv[0], (const char * const *)argv);
free(cPtr);
-if(idx == -1) return(nilCell);
+if (hProc == INVALID_HANDLE_VALUE) return nilCell;
-return(stuffInteger(idx));
+pid = GetProcessId(hProc);
+CloseHandle(hProc);
+return stuffInteger(pid);
}
-
+#if 0
CELL * p_destroyProcess(CELL * params)
{
UINT pid;
@@ -1171,7 +1176,7 @@
return(trueCell);
}
-
+#endif
#else /* not WIN_32 */
@@ -1843,23 +1848,6 @@
/* --------------------------- end Cilk ------------------------------------- */
-CELL * p_destroyProcess(CELL * params)
-{
-UINT pid;
-UINT sig;
-
-params = getInteger(params, &pid);
-if(params != nilCell)
- getInteger(params, &sig);
-else
- sig = 9;
-
-if(kill(pid, sig) != 0)
- return(nilCell);
-
-return(trueCell);
-}
-
extern SYMBOL * symHandler[];
CELL * p_waitpid(CELL * params)
@@ -1889,6 +1877,23 @@
#endif
+CELL * p_destroyProcess(CELL * params)
+{
+UINT pid;
+UINT sig;
+
+params = getInteger(params, &pid);
+if(params != nilCell)
+ getInteger(params, &sig);
+else
+ sig = 9;
+
+if(kill(pid, sig) != 0)
+ return(nilCell);
+
+return(trueCell);
+}
+
/* ------------------------------ semaphores --------------------------------- */
#ifdef WIN_32
diff -wru newlisp-10.4.4-orig/win32-util.c newlisp-10.4.4/win32-util.c
--- newlisp-10.4.4-orig/win32-util.c 2012-09-14 00:00:27 +0900
+++ newlisp-10.4.4/win32-util.c 2012-10-05 14:29:12 +0900
@@ -25,6 +25,19 @@
#include <windows.h>
#include <io.h>
+/* kill for MinGW */
+int kill(pid_t pid, int sig)
+{
+ int ret;
+ HANDLE h;
+ /* if (pid > 0 && sig == SIGTERM) { */
+ h = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
+ if (h == NULL) return -1;
+ ret = TerminateProcess(h, 0) ? 0 : -1;
+ CloseHandle(h);
+ /* } */
+ return ret;
+}
/*
typedef struct _PROCESS_INFORMATION { // pi
Code Select $ newlisp
> (setq pid (process "notepad.exe"))
5156
> (destroy pid) ; kll process
true
> (destroy pid) ; already killed
nil
> (destroy (sys-info -3)) ; kill your own process
$ Code Select ;; foo.lsp
(setq str [text]
AAA
BBB
CCC
EOFCode Select $ newlisp foo.lsp
ERR: not enough memoryCode Select $ newlisp foo.lsp
ERR: missing end of text [/text]Code Select --- newlisp-10.4.0/examples/xmlrpc.cgi.orig 2012-03-07 02:42:20.000000000 +0900
+++ newlisp-10.4.0/examples/xmlrpc.cgi 2012-03-26 14:40:35.000000000 +0900
@@ -128,7 +128,7 @@
(define (system.methodHelp params, methodName)
- (set 'methodName (nth (params 0 1 1 1 1)))
+ (set 'methodName (params 0 1 1 1 1))
(case methodName
("system.listMethods" (format normal-response "Lists all methods implemented."))
("system.methodHelp" (format normal-response "Documents a method."))
@@ -138,7 +138,7 @@
)
(define (system.methodSignature params)
- (set 'methodName (nth (params 0 1 1 1 1)))
+ (set 'methodName (params 0 1 1 1 1))
(case methodName
("system.listMethods" (format normal-response
"<array>
Code Select --- newlisp-10.4.0/modules/xmlrpc-client.lsp.orig 2012-02-14 23:51:11.000000000 +0900
+++ newlisp-10.4.0/modules/xmlrpc-client.lsp 2012-03-26 14:09:38.466104400 +0900
@@ -114,6 +114,8 @@
;
(define (get-value expr)
(if (empty? expr) nil
+
+ (list? (expr 1))
(case (expr 1 0)
("i4" (int (expr 1 1)))
("int" (int (expr 1 1)))
@@ -126,7 +128,10 @@
(get-array (rest (expr 1 1)))) )
("struct" (get-struct (rest (expr 1))))
("string" (expr 1 1))
- (true (expr 1)))) )
+ (true (expr 1)))
+
+ true (string (expr 1)) ; If no type is indicated, the type is string.
+ ))
; get contents from expr = ((value ...) (value ...) ...)
;
Code Select > (module "xmlrpc-client.lsp")
MAIN
> (XMLRPC:system.methodSignature "http://example.com/xmlrpc.cgi" "newLISP.evalString")
(("base64" "base64"))
; A past return value is (("m 30" "m 30"))