fix read line, and add read line regression tests
Slava Pestov
parent
549e17a539
commit
3712ae68e5
|
|
@ -1,4 +1,4 @@
|
|||
!:folding=indent:collapseFolds=1:
|
||||
! :folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
|
|
@ -38,7 +38,6 @@ USE: math
|
|||
USE: namespaces
|
||||
USE: parser
|
||||
USE: prettyprint
|
||||
USE: regexp
|
||||
USE: stack
|
||||
USE: stdio
|
||||
USE: streams
|
||||
|
|
@ -71,7 +70,7 @@ USE: unparser
|
|||
: irc-stream-write ( string -- )
|
||||
dup "buf" get sbuf-append
|
||||
ends-with-newline? [
|
||||
"buf" get >str
|
||||
"buf" get sbuf>str
|
||||
0 "buf" get set-sbuf-length
|
||||
"\n" split [ dup f-or-"" [ drop ] [ "recepient" get irc-message ] ifte ] each
|
||||
] when ;
|
||||
|
|
@ -112,25 +111,15 @@ USE: unparser
|
|||
: irc-action-handler ( recepient message -- )
|
||||
" " split1 swap irc-action-quot call ;
|
||||
|
||||
: irc-handle-privmsg ( [ recepient message ] -- )
|
||||
uncons car irc-action-handler ;
|
||||
|
||||
: irc-handle-join ( [ joined channel ] -- )
|
||||
uncons car
|
||||
[
|
||||
dup "nick" get = [
|
||||
"Hi " swap cat2 print
|
||||
] unless
|
||||
] with-irc-stream ;
|
||||
|
||||
: irc-input ( line -- )
|
||||
#! Handle a line of IRC input.
|
||||
dup
|
||||
":.+?!.+? PRIVMSG (.+)?:(.+)" groups [
|
||||
irc-handle-privmsg
|
||||
] when*
|
||||
dup ":(.+)!.+ JOIN :(.+)" groups [
|
||||
irc-handle-join
|
||||
" PRIVMSG " split1 nip [
|
||||
":" split1 dup [
|
||||
irc-action-handler
|
||||
] [
|
||||
drop
|
||||
] ifte
|
||||
] when*
|
||||
|
||||
global [ print ] bind ;
|
||||
|
|
@ -148,7 +137,7 @@ USE: unparser
|
|||
|
||||
: irc ( channels -- )
|
||||
irc-register
|
||||
! "identify foobar" "NickServ" irc-message
|
||||
"identify foobar" "NickServ" irc-message
|
||||
[ irc-join ] each
|
||||
irc-loop ;
|
||||
|
||||
|
|
@ -161,5 +150,3 @@ USE: unparser
|
|||
"irc.freenode.net" 6667 <client> [
|
||||
[ "#factor" ] irc
|
||||
] with-stream ;
|
||||
|
||||
!! "factor/irc.factor" run-file
|
||||
|
|
|
|||
|
|
@ -186,7 +186,6 @@ USE: words
|
|||
nip
|
||||
] [
|
||||
drop
|
||||
"Forward reference: " write dup .
|
||||
! Remember where we are, and add the reference later
|
||||
dup fixup-word-later
|
||||
] ifte ;
|
||||
|
|
|
|||
|
|
@ -99,6 +99,9 @@ USE: strings
|
|||
: resource-path ( -- path )
|
||||
"resource-path" get [ "." ] unless* ;
|
||||
|
||||
: <resource-stream> ( path -- stream )
|
||||
resource-path swap cat2 <filecr> ;
|
||||
|
||||
: parse-resource ( path -- quot )
|
||||
#! Resources are loaded from the resource-path variable, or
|
||||
#! the current directory if it is not set. Words defined in
|
||||
|
|
@ -106,9 +109,7 @@ USE: strings
|
|||
#! resource:. This allows words that operate on source
|
||||
#! files, like "jedit", to use a different resource path
|
||||
#! at run time than was used at parse time.
|
||||
"resource:" over cat2
|
||||
swap resource-path swap cat2 <filecr>
|
||||
parse-stream ;
|
||||
"resource:" over cat2 swap <resource-stream> parse-stream ;
|
||||
|
||||
: run-resource ( file -- )
|
||||
parse-resource call ;
|
||||
|
|
|
|||
|
|
@ -10,11 +10,6 @@ USE: test
|
|||
"<html>&'sgml'"
|
||||
] [ "<html>&'sgml'" chars>entities ] unit-test
|
||||
|
||||
[ "Hello world" ]
|
||||
[
|
||||
"Hello world" f html-attr-string
|
||||
] unit-test
|
||||
|
||||
[ "<span style=\"color: #ff00ff; font-family: Monospaced; \">car</span>" ]
|
||||
[
|
||||
"car"
|
||||
|
|
|
|||
|
|
@ -0,0 +1,25 @@
|
|||
IN: scratchpad
|
||||
USE: namespaces
|
||||
USE: parser
|
||||
USE: stack
|
||||
USE: streams
|
||||
USE: test
|
||||
|
||||
[ 4 ] [ "/library/test/io/no-trailing-eol.factor" run-resource ] unit-test
|
||||
|
||||
: lines-test ( stream -- line1 line2 )
|
||||
dup freadln swap dup freadln swap fclose ;
|
||||
|
||||
[
|
||||
"This is a line."
|
||||
"This is another line."
|
||||
] [
|
||||
"/library/test/io/windows-eol.txt" <resource-stream> lines-test
|
||||
] unit-test
|
||||
|
||||
[
|
||||
"This is a line."
|
||||
"This is another line."
|
||||
] [
|
||||
"/library/test/io/mac-os-eol.txt" <resource-stream> lines-test
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1 @@
|
|||
This is a line.
This is another line.
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
USE: arithmetic
|
||||
2 2 +
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
This is a line.
|
||||
This is another line.
|
||||
|
|
@ -77,6 +77,7 @@ USE: unparser
|
|||
"parse-number"
|
||||
"prettyprint"
|
||||
"inspector"
|
||||
"io/io"
|
||||
"vectors"
|
||||
"words"
|
||||
"unparser"
|
||||
|
|
|
|||
|
|
@ -42,8 +42,6 @@ void init_line_buffer(PORT* port, FIXNUM count)
|
|||
{
|
||||
if(port->line == F)
|
||||
port->line = tag_object(sbuf(LINE_SIZE));
|
||||
else
|
||||
untag_sbuf(port->line)->top = 0;
|
||||
}
|
||||
|
||||
void primitive_portp(void)
|
||||
|
|
|
|||
|
|
@ -59,6 +59,10 @@ bool read_line_step(PORT* port)
|
|||
if(ch == '\n')
|
||||
i++;
|
||||
}
|
||||
|
||||
port->buf_pos = i + 1;
|
||||
port->line_ready = true;
|
||||
return true;
|
||||
}
|
||||
|
||||
if(ch == '\n')
|
||||
|
|
@ -110,8 +114,6 @@ void primitive_add_read_line_io_task(void)
|
|||
|
||||
bool perform_read_line_io_task(PORT* port)
|
||||
{
|
||||
SBUF* line;
|
||||
|
||||
if(port->buf_pos >= port->buf_fill)
|
||||
{
|
||||
if(!read_step(port))
|
||||
|
|
@ -123,17 +125,14 @@ bool perform_read_line_io_task(PORT* port)
|
|||
/* EOF */
|
||||
if(port->line != F)
|
||||
{
|
||||
line = untag_sbuf(port->line);
|
||||
if(line->top == 0)
|
||||
if(untag_sbuf(port->line)->top == 0)
|
||||
port->line = F;
|
||||
}
|
||||
port->line_ready = true;
|
||||
return true;
|
||||
}
|
||||
else
|
||||
{
|
||||
return read_line_step(port);
|
||||
}
|
||||
}
|
||||
|
||||
void primitive_read_line_8(void)
|
||||
|
|
|
|||
Loading…
Reference in New Issue