PERFORCE change 11776 for review

Change 11776 by pudge@pudge-mobile on 2001/08/29 02:11:42

	Allow for platforms to override formatting of errors
	on output from Matthias Neeracher (Mac files)

Affected files ...

... //depot/maint-5.6/macperl/macos/macish.c#4 edit
... //depot/maint-5.6/macperl/macos/macish.h#4 edit

Differences ...

==== //depot/maint-5.6/macperl/macos/macish.c#4 (text) ====
Index: perl/macos/macish.c
--- perl/macos/macish.c.~1~	Tue Aug 28 20:15:05 2001
+++ perl/macos/macish.c	Tue Aug 28 20:15:05 2001
@@ -787,3 +787,88 @@
 	if (strEQ(env, "PERL5DB"))
 		gMacPerl_Perl5DB = val;
 }
+
+static const char * strnstr(const char * msg, const char * str, size_t len)
+{
+	char s1 = *str++;
+	
+	while (len--)
+		if (*msg++ == s1) {
+			const char * s = str;
+			const char * m = msg;
+			
+			while (*s && *s == *m)
+				++s, ++m;
+			
+			if (!*s)
+				return msg-1;
+		}
+	return NULL;
+}
+
+static void WriteMsgLn(PerlIO * io, const char * msg, size_t len, Boolean start)
+{
+	if (start)
+		PerlIO_write(io, "# ", 2);
+	PerlIO_write(io, msg, len);
+}
+
+static void WriteMsg(PerlIO * io, const char * msg, size_t len, Boolean start)
+{
+	const char * nl;
+	
+	while (nl = (const char *)memchr(msg, '\n', len)) {
+		WriteMsgLn(io, msg, nl-msg+1, start);
+		start 	= true;
+		len		= msg+len-nl-1;
+		msg 	= nl+1;
+	}
+	if (len)
+		WriteMsgLn(io, msg, len, start);
+}
+
+void MacPerl_WriteMsg(void * io, const char * msg, size_t len)
+{
+	const char * line= msg;
+	const char * at;
+	
+	/* Look for " line \d" */
+	while (line = strnstr(line+1, " line ", msg+len-line-1)) {
+		if (line[6] >= '0' && line[6] <= '9') {
+			/* Got line, now look for end of line number */
+			const char * endline = line+7;
+			
+			while (*endline >= '0' && *endline <= '9')
+				++endline;
+			if (*endline == ' ')
+				++endline;
+			/* Got it, now look for preceding " at ." length reduced by 1 because file name
+			 * must be at least 1 character long.
+			 */
+			at	= strnstr(msg, " at ", line-msg-1);
+	
+			if (at) {
+				const char * anotherat;
+				
+				/* Look for intervening "at". This part gives misleading results if the filename
+				 * itself contains an at.
+				 */
+				while (anotherat = strnstr(at+4, " at ", line-at-5))
+					at = anotherat;
+					
+				/* OK, we got them both, write the original message prefixed with # */
+				WriteMsg(io, msg, at-msg, true);
+				WriteMsg(io, endline, msg+len-endline, false);
+				PerlIO_write(io, "File \'", 6);
+				PerlIO_write(io, at+4, line-at-4);
+				PerlIO_write(io, "\'; Line ", 8);
+				PerlIO_write(io, line+6, endline-line-6);
+				PerlIO_write(io, "\n", 1);
+				
+				return;
+			}
+		}
+	}
+	/* No file/line found */
+	WriteMsg(io, msg, len, true);
+}

==== //depot/maint-5.6/macperl/macos/macish.h#4 (text) ====
Index: perl/macos/macish.h
--- perl/macos/macish.h.~1~	Tue Aug 28 20:15:05 2001
+++ perl/macos/macish.h	Tue Aug 28 20:15:05 2001
@@ -74,6 +74,7 @@
 char * GetSysErrText(short, char *);
 unsigned char * MacPerl_CopyC2P(const char * c, unsigned char * p);
 const char * MacPerl_CanonDir(const char * dir, char * buf);
+void MacPerl_WriteMsg(void * io, const char * msg, size_t len);
 
 /* These defined following should be defined in 5.8 in config.h */
 #define HAS_USLEEP
@@ -204,6 +205,8 @@
 #define PERL_SYS_TERM()		MALLOC_TERM
 #endif
 
+#define PERL_WRITE_MSG_TO_CONSOLE(io, msg, len) MacPerl_WriteMsg(io, msg, len)
+
 #define BIT_BUCKET "Dev:Null"
 
 #define dXSUB_SYS
End of Patch.