FEAT: replaced dir? mezzanine as a native! with optional /check refinement

resolves:
Oldes/Rebol-issues#158
Oldes/Rebol-issues#499
Oldes/Rebol-issues#604
Oldes/Rebol-issues#635
Oldes/Rebol-issues#649
Oldes/Rebol-issues#1675
Oldes/Rebol-issues#1777
Oldes/Rebol-issues#2379

related:
Oldes/Rebol-issues#117
Oldes/Rebol-issues#602

Author: Oldes

src/boot/natives.reb

@@ -106,12 +106,6 @@ continue: native [
 	{Throws control back to top of loop.}
 ]
 
-;dir?: native [
-;	{Returns true if file is a directory.}
-;	file [any-string! none!]
-;	/any {Allow * or ? wildcards for directory}
-;]
-
 ;disarm: native [
 ;	{(Deprecated - not needed) Converts error to an object. Other types not modified.}
 ;	error [any-type!]
@@ -706,6 +700,9 @@ change-dir: native [
 	path [file!]
 ]
 
+;dir?: in %n-io.c
+;wildcard?: in %n-io.c
+
 ;-- Series Natives
 
 first: native [

src/core/n-io.c

@@ -468,6 +468,59 @@ static REBSER *Read_All_File(char *fname)
 	return R_RET;
 }
 
+// Blog: http://www.rebol.net/cgi-bin/r3blog.r?view=0319
+/***********************************************************************
+**
+*/	REBNATIVE(dirq)
+/*
+//	dir?: native [
+//		"Returns TRUE if the value looks like a directory spec (ends with a slash (or backslash))."
+//		target [file! url! none!]
+//		/check "If the file is a directory on local storage (don't have to end with a slash)"
+//	]
+***********************************************************************/
+{
+	REBVAL *path = D_ARG(1);
+	REBINT len;
+	REBSER *ser;
+	REBREQ file;
+	REBUNI ch;
+
+	if (!ANY_STR(path) || VAL_LEN(path) == 0) return R_FALSE;
+
+	if (D_REF(2)) {
+	// use OS check if path really exists and is a directory
+		if (IS_FILE(path)) {
+			CLEARS(&file); 
+			ser = Value_To_OS_Path(path, TRUE);
+			file.file.path = (REBCHR*)(ser->data);
+			file.device = RDI_FILE;
+			len = OS_DO_DEVICE(&file, RDC_QUERY);
+			FREE_SERIES(ser);
+			if (len == DR_DONE && GET_FLAG(file.modes, RFM_DIR)) return R_TRUE;
+		}
+	}
+	// without OS check
+	ch = GET_ANY_CHAR(VAL_SERIES(path), VAL_TAIL(path)-1);
+	if (ch == '/' || ch == '\\') return R_TRUE;
+
+	return R_FALSE;
+}
+
+/***********************************************************************
+**
+*/	REBNATIVE(wildcardq)
+/*
+//	wildcard?: native [
+//		"Return true if file contains wildcard chars (* or ?)"
+//		path [file!]
+//	]
+***********************************************************************/
+{
+	REBVAL *path = D_ARG(1);
+	REBCNT index = Find_Str_Wild(VAL_SERIES(path), VAL_INDEX(path), VAL_TAIL(path));
+	return index == NOT_FOUND ? R_FALSE : R_TRUE;
+}
 
 /***********************************************************************
 **

src/core/p-dir.c

@@ -32,6 +32,8 @@
 // Special policy: Win32 does not wanting tail slash for dir info
 #define REMOVE_TAIL_SLASH (1<<10)
 
+#define WILD_PATH(p) (Find_Str_Wild(VAL_SERIES(p), VAL_INDEX(p), VAL_TAIL(p)) != NOT_FOUND)
+
 
 /***********************************************************************
 **
@@ -78,79 +80,10 @@
 		Set_Series(REB_FILE, Append_Value(files), name);
 	}
 
-	if (result < 0 && dir->error != -RFE_OPEN_FAIL
-		&& (FIND_CHR(dir->file.path, '*') || FIND_CHR(dir->file.path, '?')))
-		result = 0;  // no matches found, but not an error
-
 	return result;
 }
 
 
-#ifdef REMOVED
-// It's problematic. See blog. Moved to mezz.
-
-/***********************************************************************
-**
-*/	REBNATIVE(dirq)
-/*
-**	Refinements:
-**		/any -- allow * and ? wildcards
-**
-**	Patterns:
-**		abc/ is true
-**		abc/*.reb is true
-**		abc/?.reb is true
-**		abc - ask the file system
-**
-***********************************************************************/
-{
-	REBVAL *path = D_ARG(1);
-	REBINT len;
-	REBINT i;
-	REBCNT dot;
-	REBUNI c;
-	REBSER *ser = VAL_SERIES(path);
-
-	if (!ANY_STR(path)) return R_FALSE;
-
-	len = (REBINT)VAL_LEN(path);
-	if (len == 0) return R_FALSE;
-
-	// We cannot tell from above, so we must check it (if file):
-	if (IS_FILE(path)) {
-		REBSER *ser;
-		REBREQ file;
-
-		CLEARS(&file); 
-		ser = Value_To_OS_Path(path, TRUE);
-		file.file.path = (REBCHR*)(ser->data);
-		file.device = RDI_FILE;
-		len = OS_DO_DEVICE(&file, RDC_QUERY);
-		FREE_SERIES(ser);
-		if (len == DR_DONE && GET_FLAG(file.modes, RFM_DIR)) return R_TRUE;
-	}
-
-	// Search backward for abc/, abc/def, abc/*, etc:
-	len = (REBINT)VAL_LEN(path);
-	dot = 0;
-	for (i = 0; i < len; i++) {
-		c = GET_ANY_CHAR(ser, VAL_TAIL(path)-1-i);
-		if (c == '/' || c == '\\') {
-			if (i == 0 || dot) return R_TRUE;
-			break;
-		}
-		if (c == '.') {
-			if (i == 0 || dot) dot = 1;
-		}
-		else dot = 0;
-		if ((c == '*' || c == '?') && D_REF(2)) return R_TRUE;
-	}
-
-	return R_FALSE;
-}
-#endif
-
-
 /***********************************************************************
 **
 */	static void Init_Dir_Path(REBREQ *dir, REBVAL *path, REBINT wild, REBCNT policy)
@@ -268,7 +201,12 @@
 			Set_Block(state, Make_Block(7)); // initial guess
 			result = Read_Dir(&dir, VAL_SERIES(state));
 			///OS_FREE(dir.file.path);
-			if (result < 0) Trap_Port(RE_CANNOT_OPEN, port, dir.error);
+			
+			// don't throw an error if the original path contains wildcard chars * or ?
+			if (result < 0 && !(dir.error == (REBCNT)-RFE_OPEN_FAIL && WILD_PATH(path)) ) {
+				Trap_Port(RE_CANNOT_OPEN, port, dir.error);
+			}
+
 			*D_RET = *state;
 			SET_NONE(state);
 		} else {

src/core/s-find.c

@@ -569,6 +569,24 @@
 }
 
 
+/***********************************************************************
+**
+*/	REBCNT Find_Str_Wild(REBSER *ser, REBCNT index, REBCNT tail)
+/*
+**		Returns index of first * or ? chars in series 
+**
+***********************************************************************/
+{
+	REBUNI ch;
+
+	for (; index < tail; index++) {
+		ch = GET_ANY_CHAR(ser, index);
+		if (ch == '*' || ch == '?') return index;
+	}
+	return NOT_FOUND;
+}
+
+
 #ifdef old
 /***********************************************************************
 **

src/mezz/base-files.reb

@@ -62,13 +62,6 @@ suffix?: func [
 	]
 ]
 
-dir?: func [
-	{Returns TRUE if the file or url ends with a slash (or backslash).}
-	target [file! url!]
-][
-	true? find "/\" last target
-]
-
 dirize: func [
 	{Returns a copy (always) of the path as a directory (ending slash).}
 	path [file! string! url!]
@@ -87,9 +80,9 @@ make-dir: func [
 	if empty? path [return path]
 	if slash <> last path [path: dirize path]
 
-	if exists? path [
-		if dir? path [return path]
-		cause-error 'access 'cannot-open path
+	switch exists? path [
+		dir  [return path]
+		file [cause-error 'access 'cannot-open path]
 	]
 
 	if any [not deep url? path] [

src/mezz/sys-ports.reb

@@ -25,7 +25,11 @@ make-port*: func [
 	; The first job is to identify the scheme specified:
 	case [
 		file? spec  [
-			name: pick [dir file] dir? spec
+			name: case [
+				wildcard?  spec ['dir]
+				dir?/check spec [spec: dirize spec 'dir]
+				true            ['file]
+			]
 			spec: join [ref:] spec
 		]
 		url? spec [

src/tests/units/port-test.r3

@@ -60,17 +60,73 @@ Rebol [
 			d/size = none
 		]
 		delete %dir-606/
+
+	--test-- "make-dir/delete/exists? with path without a slash"
+		;@@ https://github.com/Oldes/Rebol-issues/issues/499
+		--assert %dir-606/ = make-dir %dir-606
+		--assert not error? try [delete %dir-606]
+		--assert not exists? %dir-606
+
+	--test-- "make-dir if file exists"
+		;@@ https://github.com/Oldes/Rebol-issues/issues/1777
+		--assert not error? try [write %issue-1777.txt "test"]
+		--assert error? er: try [make-dir %issue-1777.txt/]
+		--assert er/id = 'no-create
+		--assert not error? try [delete %issue-1777.txt]
+
+	--test-- "open %."
+		;@@ https://github.com/Oldes/Rebol-issues/issues/117
+		--assert port? p: open %.
+		--assert 'dir  = p/scheme/name
+		--assert 'dir  = p/spec/scheme
+		--assert  %./  = p/spec/ref
+		--assert port? close p
+
+	--test-- "open wildcard"
+		;@@ https://github.com/Oldes/Rebol-issues/issues/158
+		--assert all [
+			port? p: try [open %*.r3]
+			'dir  = p/scheme/name
+			'dir  = p/spec/scheme
+			%*.r3 = p/spec/ref
+			port? close p
+		]
+
 	--test-- "DIR?"
 		;@@ https://github.com/Oldes/Rebol-issues/issues/602
 		; dir? only checks if the last char is / or \
 		--assert dir? %doesnotexists/
 		--assert not dir? %doesnotexists
 		--assert dir? %./
 		--assert not dir? %.
+		; dir?/check
+		--assert not dir?/check %doesnotexists
+		--assert dir?/check %.
+		--assert dir?/check %./
+
+	--test-- "READ on existing dir-name"
+		;@@ https://github.com/Oldes/Rebol-issues/issues/635
+		;@@ https://github.com/Oldes/Rebol-issues/issues/1675
+		;@@ https://github.com/Oldes/Rebol-issues/issues/2379
+		--assert block? b1: read %.
+		--assert block? b2: read %./
+		--assert b1 = b2
+		;@@ https://github.com/Oldes/Rebol-issues/issues/604
+		--assert 'dir = exists? %.
+		--assert 'dir = exists? %./
+
 	--test-- "READ on non-existing dir-name"
 		;@@ https://github.com/Oldes/Rebol-issues/issues/500
 		--assert error? e: try [read %carl-for-president/]
 		--assert e/id = 'cannot-open
+
+	--test-- "READ wildcard"
+		;@@ https://github.com/Oldes/Rebol-issues/issues/158
+		--assert all [block? b: try [read %*.r3]             not empty? b]
+		--assert all [block? b: try [read %run-tests.?3]     not empty? b]
+		--assert all [block? b: try [read %units/files/*.r3] not empty? b]
+		--assert all [block? b: try [read %*.xxx]                empty? b]
+
 	--test-- "DELETE-DIR"
 		;@@ https://github.com/Oldes/Rebol-issues/issues/1545
 		--assert all [
@@ -79,6 +135,8 @@ Rebol [
 			not error?      delete-dir %units/temp-dir/
 			not exists? %units/temp-dir/
 		]
+if system/platform = 'Windows [
+;@@ it looks that on Linux there is no lock on opened file
 		--assert all [
 			all [
 				not error? try [make-dir/deep %units/temp-dir/]
@@ -96,6 +154,7 @@ Rebol [
 				not error? delete-dir %units/temp-dir/
 			]
 		]
+]
 
 	--test-- "RENAME dir"
 		;@@ https://github.com/Oldes/Rebol-issues/issues/1533
@@ -262,7 +321,7 @@ if "true" <> get-env "CONTINUOUS_INTEGRATION" [
 	;- don't do these tests on Travis CI
 	===start-group=== "WHOIS scheme"
 		--test-- "read WHOIS"
-			--assert  string? try [read whois://google.com]
+			--assert  string? probe try [read whois://google.com]
 		--test-- "write WHOIS"
 			--assert string? try [write whois://whois.nic.cz "seznam.cz"]
 	===end-group===