Merge pull request #5 from Oldes/master

Syncing

README.md

@@ -1,4 +1,5 @@
-[![Rebol CI](https://github.com/Siskin-framework/Rebol/actions/workflows/main.yml/badge.svg)](https://github.com/Siskin-framework/Rebol/actions/workflows/main.yml)
+[![Rebol CI](https://github.com/Oldes/Rebol3/actions/workflows/main.yml/badge.svg)](https://github.com/Oldes/Rebol3/actions/workflows/main.yml)
+[![Build Rebol](https://github.com/Oldes/Rebol3/actions/workflows/build-all.yml/badge.svg)](https://github.com/Oldes/Rebol3/actions/workflows/build-all.yml)
 [![Gitter](https://badges.gitter.im/rebol3/community.svg)](https://gitter.im/rebol3/community?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge)
 [![Chocolatey](https://raw.githubusercontent.com/Oldes/media/master/install-from-choco.svg)](https://chocolatey.org/packages/rebol3)
 

src/core/d-dump.c

@@ -39,16 +39,16 @@
 {
 	if (!series) return;
 	Debug_Fmt(
-		Str_Dump[0], //"%s Series %x %s: Wide: %2d Size: %6d - Bias: %d Tail: %d Rest: %d Flags: %x"
+		Str_Dump[0], //"%s Series %x: wide: %2d size: %6d bias: %d tail: %d rest: %d flags: %x \"%s\""
 		memo,
 		series,
-		(SERIES_LABEL(series) ? SERIES_LABEL(series) : "-"),
 		SERIES_WIDE(series),
 		SERIES_TOTAL(series),
 		SERIES_BIAS(series),
 		SERIES_TAIL(series),
 		SERIES_REST(series),
-		SERIES_FLAGS(series)
+		SERIES_FLAGS(series),
+		(SERIES_LABEL(series) ? SERIES_LABEL(series) : "-")
 	);
 }
 

src/mezz/codec-zip.reb

@@ -130,7 +130,7 @@ register-codec [
 						sys/log/error 'ZIP ["CRC check failed!" crc "<>" crc2]
 					]
 				]
-				repend result [name reduce [modified crc data]]
+				repend result [name reduce [modified data crc]]
 			]
 
 			if only [
@@ -146,7 +146,158 @@ register-codec [
 		result
 	]
 
-	;encode: function [data [binary!]][	]
+	encode: wrap [
+		bin: dir: data: date: file: add-data: root: none
+		compressed-data: method:
+		compressed-size: size: crc: entries: filename-length: offset: 0
+
+		add-file: func[file [file!] /local dir spec][
+			try/except [
+				spec: query/mode file [type: date:]
+				either spec [
+					file-name: find/tail file root
+					either spec/type = 'dir [
+						dir: file
+						add-data file-name spec
+						foreach file read dir  [
+							add-file dir/:file
+						]
+					][
+						add-data file-name reduce [spec/date read file]
+					]
+				][
+					; wildcard?
+					dir: first split-path file
+					foreach file read file [
+						add-file dir/:file
+					]
+				]
+			][
+				sys/log/error 'ZIP ["Failed to add file:" as-green file]
+			]
+		]
+
+		add-data: func[file spec][
+			sys/log/info 'ZIP ["Adding:" as-green file]
+
+			any [file? file cause-error 'user 'message reduce [reform ["found" type? file "where file! expected"]]]
+			data: date: none
+			compressed-size: size: crc: filename-length: 0
+			any [
+				all [
+					block? spec 
+					parse spec [any [
+						spec:
+						  date!   (date: spec/1)
+						| string! (data: to binary! spec/1)
+						| binary! (data: spec/1)
+						| 1 skip
+					]]
+				]
+				all [binary? spec data: spec]
+				all [string? spec data: to binary! spec]
+				none? spec ; just a directory
+				spec = 'none
+				;else..
+				all [
+					sys/log/error 'ZIP ["Invalid zip file's data specification:" as-red mold/part spec 30]
+					continue
+				]
+			]
+			method: either any [
+				none? data
+				lesser-or-equal? size: length? data length? compressed-data: compress data
+			][
+				compressed-data: data
+				0 ;store
+			][
+				compressed-data: copy/part skip compressed-data 2 skip tail compressed-data -8 ;@@ FIXME once compress/zlib will be fixed!
+				8 ;deflate
+			]
+
+			either compressed-data [
+				crc: checksum data 'CRC32
+				compressed-size: length? compressed-data
+			][	compressed-data: #{}
+				compressed-size: 0
+			]
+			if any [
+				none? date
+				"?date?" = form date ; temp fix for invalid date!
+			][	date: now ]
+
+			filename-length: length? file
+			offset: -1 + index? bin/buffer-write
+
+			binary/write bin [
+				#{504B0304 1400 0000} ;signature / version / flags
+				UI16LE         :method
+				MSDOS-DATETIME :date
+				UI32LE         :crc
+				UI32LE         :compressed-size
+				UI32LE         :size
+				UI16LE         :filename-length
+				UI16LE         0 ; extra
+				BYTES          :file
+				BYTES          :compressed-data
+			]
+			binary/write dir [
+				#{504B0102 1400 1400 0000} ; signature / version made / version needed / flags
+				UI16LE         :method
+				MSDOS-DATETIME :date
+				UI32LE         :crc
+				UI32LE         :compressed-size
+				UI32LE         :size
+				UI16LE         :filename-length
+				UI16LE         0 ; Extra field length
+				UI16LE         0 ; File comment length
+				UI16LE         0 ; Disk number where file starts
+				UI16LE         0 ; Internal file attributes
+				UI32LE         0 ; External file attributes
+				UI32LE         :offset ; Relative offset of local file header
+				BYTES          :file
+				;#{} ; Extra field
+				;#{} ; File comment
+			]
+			++ entries
+		]
+
+		;- ENCODE:
+		func [
+			"Compress given block of files."
+			files [block! file!] "[file! binary! ..] or [file! [date! crc binary!] or [dir! none!] ..]"
+		][
+			bin: binary 10000
+			dir: binary 1000
+			entries: 0
+
+			either file? files [
+				root: first split-path files
+				add-file files
+			][
+				foreach [file spec] files [
+					add-data file spec
+				]
+			]
+
+			dir-size: length? dir/buffer
+			bin-size: length? bin/buffer
+
+			binary/write bin [
+				BYTES :dir/buffer
+				#{504B0506}      ; End of central directory signature
+				UI16LE 0         ; Number of this disk
+				UI16LE 0         ; Disk where central directory starts
+				UI16LE :entries  ; Number of central directory records on this disk
+				UI16LE :entries  ; Total number of central directory records
+				UI32LE :dir-size ; Size of central directory
+				UI32LE :bin-size ; Offset of start of central directory
+				UI16LE 0         ; Comment length
+				;#{}             ; Comment
+			]
+			bin/buffer
+		]
+	]
 
 	identify: function [data [binary!]][
 		all [

src/modules/munge3.reb

@@ -176,92 +176,8 @@ ctx-munge: context [
 	archive: function [ ; https://en.wikipedia.org/wiki/Zip_(file_format) & http://www.rebol.org/view-script.r?script=rebzip.r
 		"Compress block of file and data pairs"
 		source [series!]
-	] compose/deep [
-		to-short: function [i] [copy/part reverse to binary! i 2]
-		to-long: function [i] [copy/part reverse to binary! i 4]
-
-		case [
-			empty? source [none]
-			not block? source [
-				compress/gzip source
-			]
-			true [
-				bin: copy #{}
-				dir: copy #{}
-
-				foreach [file series] source [
-					all [none? series series: make string! 0]
-
-					any [file? file cause-error 'user 'message reduce [reform ["found" type? file "where file! expected"]]]
-					any [series? series cause-error 'user 'message reduce [reform ["found" type? series "where series! expected"]]]
-
-					method: either greater? length? series length? compressed-data: compress data: to binary! series [
-						compressed-data: copy/part skip compressed-data 2 skip tail compressed-data -8
-						#{0800}				; deflate
-					] [
-						compressed-data: data
-						#{0000}				; store
-					]
-
-					offset: length? bin
-
-					append bin rejoin [
-						#{504B0304}			; Local file header signature
-						#{1400}				; Version needed to extract (minimum)
-						#{0000}				; General purpose bit flag
-						method				; Compression method
-						#{0000}				; File last modification time
-						#{0000}				; File last modification date
-						crc:				to-long crc32 data
-						compressed-size:	to-long length? compressed-data
-						uncompressed-size:	to-long length? data
-						filename-length:	to-short length? file
-						#{0000}				; Extra field length
-						filename: to binary! file
-						#{}					; Extra field
-						compressed-data		; Data
-					]
-
-					append dir rejoin [
-						#{504B0102}			; Central directory file header signature
-						#{1400}				; Version made by
-						#{1400}				; Version needed to extract (minimum)
-						#{0000}				; General purpose bit flag
-						method				; Compression method
-						#{0000}				; File last modification time
-						#{0000}				; File last modification date
-						crc					; CRC-32
-						compressed-size		; Compressed size
-						uncompressed-size	; Uncompressed size
-						filename-length		; File name length
-						#{0000}				; Extra field length
-						#{0000}				; File comment length
-						#{0000}				; Disk number where file starts
-						#{0000}				; Internal file attributes
-						#{00000000}			; External file attributes
-						to-long offset		; Relative offset of local file header
-						filename			; File name
-						#{}					; Extra field
-						#{}					; File comment
-					]
-				]
-
-				append bin rejoin [
-					dir
-					#{504B0506}			; End of central directory signature
-					#{0000}				; Number of this disk
-					#{0000}				; Disk where central directory starts
-					entries: to-short divide length? source 2	; Number of central directory records on this disk
-					entries				; Total number of central directory records
-					to-long length? dir	; Size of central directory
-					to-long length? bin	; Offset of start of central directory
-					#{0000}				; Comment length
-					#{}					; Comment
-				]
-
-				bin
-			]
-		]
+	] [
+		encode 'ZIP source
 	]
 
 	call-out: function [
@@ -1392,7 +1308,7 @@ ctx-munge: context [
 			true [
 				either only [
 					tmp: codecs/zip/decode/only source to block! file
-					tmp/2/3 ; retuns only decompressed data
+					tmp/2/2 ; retuns only decompressed data
 				][	codecs/zip/decode source ]
 			]
 		]

src/os/posix/host-lib.c

@@ -653,7 +653,13 @@ int pipe2(int pipefd[2], int flags); //to avoid "implicit-function-declaration"
 **
 ***********************************************************************/
 {
-	return (chdir(path) == 0) ? 0 : errno;
+	if (chdir(path) == 0) {
+		// directory changed... update PWD
+		// https://github.com/Oldes/Rebol-issues/issues/2448
+		setenv("PWD", path, 1);
+		return 0;
+	} else
+		return errno;
 }
 
 

src/os/win32/host-lib.c

@@ -649,7 +649,13 @@ static void *Task_Ready;
 **
 ***********************************************************************/
 {
-	return (SetCurrentDirectory(path[0] == 0 ? L"\\" : path)) ? 0 : GetLastError();
+	if (SetCurrentDirectory(path[0] == 0 ? L"\\" : path)) {
+		// directory changed... update PWD
+		// https://github.com/Oldes/Rebol-issues/issues/2448
+		SetEnvironmentVariable(L"PWD", path);
+		return 0;
+	} else
+		return GetLastError();
 }
 
 

src/tests/units/codecs-test.r3

@@ -228,8 +228,8 @@ if find codecs 'zip [
 
 		--test-- "Decode ZIP using the codec directly"
 			--assert block? data: codecs/zip/decode/only %units/files/test.aar [%classes.jar]
-			--assert data/2/2 = 646121705
-			--assert block? codecs/zip/decode data/2/3
+			--assert data/2/3 = 646121705
+			--assert block? codecs/zip/decode data/2/2
 
 		--test-- "Decode ZIP using info"
 			bin: read %units/files/test-lzma.zip
@@ -239,6 +239,41 @@ if find codecs 'zip [
 			data: codecs/zip/decompress-file at bin info/2/2 reduce [info/2/5 info/2/3 info/2/4]
 			--assert info/2/6 = checksum data 'crc32
 
+		--test-- "Encode ZIP using encode"
+			--assert binary? try [bin: encode 'ZIP [
+				%empty-folder/ none
+				%file-1 "Hello!"
+				%file-2 "Hello, Hello, Hello, Hello, Hello!"
+				%file-3 #{000102030400010203040001020304}
+				%folder/file-4 [1-Jan-2021 "This file is with date!"]
+			]]
+			data: decode 'ZIP bin
+			--assert all [
+				data/1 = %empty-folder/
+				data/3 = %file-1
+				data/4/2 = #{48656C6C6F21}
+				data/5 = %file-2
+				data/9 = %folder/file-4
+				data/10/1 = 1-Jan-2021/0:00
+			]
+
+		--test-- "Encode ZIP using directory"
+			--assert not error? try [save %ico.zip %units/files/ico/]
+			data: load %ico.zip
+			--assert 30 = length? data ; 14 files and 1 directory
+			--assert %ico/ = data/1
+			--assert %ico/icon_128.png = data/3
+			delete %ico.zip
+
+		--test-- "Encode ZIP using wildcard"
+			--assert not error? try [save %temp.zip %units/files/issue-2186*.txt]
+			data: load %temp.zip
+			--assert 8 = length? data ; 4 files
+			--assert %issue-2186-UTF16-BE.txt = data/1
+			--assert %issue-2186-UTF16-LE.txt = data/3
+			delete %temp.zip
+
+
 	===end-group===
 	system/options/log/zip: v
 ]

src/tests/units/parse-test.r3

@@ -44,6 +44,16 @@ Rebol [
 ===end-group===
 
 
+===start-group=== "NOT"
+--test-- "not not"
+;@@ https://github.com/Oldes/Rebol-issues/issues/1246
+	--assert parse "1" [not not "1" "1"]
+	--assert parse "1" [not [not "1"] "1"]
+	--assert not parse "" [not 0 "a"]
+	--assert not parse "" [not [0 "a"]]
+===end-group===
+
+
 ===start-group=== "THEN"
 --test-- "then"
 ;@@ https://github.com/Oldes/Rebol-issues/issues/1394