fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2001-09-09 21:00 MEST Martin Vogel <vogel@inttec.de>

Browse Source
This commit is contained in:
Martin Vogel
2001-09-09 19:05:13 +00:00
parent 0256691709
commit 319305a9d7
13 changed files with 1710 additions and 126 deletions
Download Patch File Download Diff File Expand all files Collapse all files

32
harbour/ChangeLog
View File

@@ -1,3 +1,35 @@
2001-09-09 21:00 MEST Martin Vogel <vogel@inttec.de>
+ contrib/libct/token2.c
+ Incremental tokenizer: TOKENINIT(), TOKENEXIT(), TOKENNEXT()
TOKENNUM(), TOKENAT(), SAVETOKEN()
RESTTOKEN(), TOKENEND()
with some enhanced functionality
+ contrib/libct/tests/token2.prg
+ test program for incremental tokenizer
- contrib/libct/ct.c
+ contrib/libct/ctc.c
! file renamed from ct.c to ctc.c, contains now C part of lib init/exit
code
+ contrib/libct/ct.prg
! contains PRG part of lib init/exit code
- contrib/libct/temper.c
! file removed since CELSIUS() and FAHRENHEIT() functions have already
been implemted in num1.c
* contrib/libct/Makefile
* contrib/libct/makefile.bc
* contrib/libct/makefile.vc
* contrib/libct/cterror.ch
* contrib/libct/ctflist.txt
* contrib/libct/readme.txt
* changes according to the above
2001-09-09 15:48 GMT+2 Maurilio Longo <maurilio.longo@libero.it>
+ contrib/hgf/os2pm/winctrl.prg
+ added

7
harbour/contrib/libct/Makefile
View File

@@ -22,7 +22,7 @@ C_SOURCES = \
charsort.c \
charswap.c \
count.c \
ct.c \
ctc.c \
ctmath.c \
ctset.c \
ctstr.c \
@@ -31,7 +31,7 @@ C_SOURCES = \
ctcrypt.c \
finan.c \
justify.c \
files.c \
files.c \
math.c \
num1.c \
numat.c \
@@ -45,12 +45,13 @@ C_SOURCES = \
replace.c \
strswap.c \
token1.c \
token2.c \
trig.c \
temper.c \
wordrepl.c \
wordtoch.c \
PRG_SOURCES= \
ct.prg \
ctmisc.prg \
LIBNAME=libct

162
harbour/contrib/libct/ct.prg Normal file
View File

@@ -0,0 +1,162 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 general functions (PRG part)
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
static sbInitialized := .F.
/* $DOC$
* $FUNCNAME$
* CTINIT()
* $CATEGORY$
* CT3 general functions
* $ONELINER$
* Initializes the CT3 library
* $SYNTAX$
* CTINIT () -> lInitialized
* $ARGUMENTS$
* None
* $RETURNS$
* lInitialized .T. if the function has been correctly initialized
* $DESCRIPTION$
* The CTINIT() function initializes the CT3 library.
* Identical code is declared as INIT FUNCTION, thus should be executed
* automatically at the beginning of the application, but it is a good
* idea to call it once again explicitly somewhere at the beginning of
* your program to check the initialization.
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Ready
* $COMPLIANCE$
* CTINIT() is a new function in Harbour's CT3 library.
* $PLATFORMS$
* All
* $FILES$
* Source is ct.prg, library is libct.
* $SEEALSO$
* $END$
*/
function CTINIT()
if !sbInitialized
sbInitialized := ctcinit()
endif
return (sbInitialized)
init function _CTINIT()
if !sbInitialized
sbInitialized := ctcinit()
endif
return (sbInitialized)
/* $DOC$
* $FUNCNAME$
* CTEXIT()
* $CATEGORY$
* CT3 general functions
* $ONELINER$
* Uninitializes the CT3 library
* $SYNTAX$
* CTEXIT () -> nil
* $ARGUMENTS$
* none
* $RETURNS$
* nil
* $DESCRIPTION$
* The CTEXIT() function uninitializes the CT3 library.
* Identical code is declared as EXIT FUNCTION, thus should be executed
* automatically at the end of the application, but it is a good idea
* to call it explicitly somewhere at the end of your program to make
* sure that the deinitialization takes place.
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Ready
* $COMPLIANCE$
* CTEXIT() is a new function in Harbour's CT3 library.
* $PLATFORMS$
* All
* $FILES$
* Source is ct.prg, library is libct.
* $SEEALSO$
* $END$
*/
function CTEXIT()
if (sbInitialized)
/* call tokenexit to release static token environment */
tokenexit()
ctcexit()
sbInitialized := .F.
endif
return (nil)
exit function _CTEXIT()
if (sbInitialized)
/* call tokenexit to release static token environment */
tokenexit()
ctcexit()
sbInitialized := .F.
endif
return (nil)

58
harbour/contrib/libct/ct.c → harbour/contrib/libct/ctc.c
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* CT3 general functions
* CT3 general functions (C part)
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -265,35 +265,36 @@ static int s_initialized = 0; /* TODO: make this thread safe */
/* $DOC$
* $FUNCNAME$
* CTINIT()
* CTCINIT()
* $CATEGORY$
* CT3 general functions
* $ONELINER$
* Initializes the CT3 library
* Initializes the CT3 library, C part
* $SYNTAX$
* CTINIT () -> lInitialized
* CTCINIT () -> lInitialized
* $ARGUMENTS$
* None
* $RETURNS$
* lInitialized .T. if the function has been correctly initialized
* $DESCRIPTION$
* The CTINIT() function initializes the CT3 library. Always call it
* once somewhere at the beginning of your program.
* The CTCINIT() function initializes the C source part of the CT3
* library. Do not call this function directly.
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Ready
* $COMPLIANCE$
* CTINIT() is a new function in Harbour's CT3 library.
* CTCINIT() is a new function in Harbour's CT3 library.
* $PLATFORMS$
* All
* $FILES$
* Source is ct.c, library is libct.
* Source is ctc.c, library is libct.
* $SEEALSO$
* CTINIT(),CTEXIT()
* $END$
*/
HB_FUNC (CTINIT)
HB_FUNC (CTCINIT)
{
if (s_initialized == 0)
@@ -304,16 +305,6 @@ HB_FUNC (CTINIT)
s_initialized = iSuccess;
}
if (hb_pcount() > 0) /* CTINIT accepts no params */
{
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CTINIT,
NULL, "CTINIT", 0, EF_CANDEFAULT, 1, hb_paramError (1));
}
}
hb_retl (s_initialized);
}
@@ -321,50 +312,43 @@ HB_FUNC (CTINIT)
/* $DOC$
* $FUNCNAME$
* CTEXIT()
* CTCEXIT()
* $CATEGORY$
* CT3 general functions
* $ONELINER$
* Uninitializes the CT3 library
* Uninitializes the CT3 library, C part
* $SYNTAX$
* CTEXIT () -> nil
* CTCEXIT () -> nil
* $ARGUMENTS$
* none
* $RETURNS$
* nil
* $DESCRIPTION$
* The CTEXIT() function uninitializes the CT3 library. Always call it
* somewhere at the end of your program.
* The CTCEXIT() function uninitializes the C part of the CT3 library.
* Do not call this function directly.
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Ready
* $COMPLIANCE$
* CTEXIT() is a new function in Harbour's CT3 library.
* CTCEXIT() is a new function in Harbour's CT3 library.
* $PLATFORMS$
* All
* $FILES$
* Source is ct.c, library is libct.
* Source is ctc.c, library is libct.
* $SEEALSO$
* CTINIT(),CTEXIT()
* $END$
*/
HB_FUNC (CTEXIT)
HB_FUNC (CTCEXIT)
{
ct_str_exit();
ct_math_exit();
s_initialized = 0;
if (hb_pcount() > 0) /* CTEXIT accepts no params */
{
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CTEXIT,
NULL, "CTEXIT", 0, EF_CANDEFAULT, 1, hb_paramError (1));
}
}
hb_ret();
}

19
harbour/contrib/libct/cterror.ch
View File

@@ -352,15 +352,16 @@
#define CT_ERROR_TOKENINIT 3954
#define CT_ERROR_TOKENLOWER 3961
#define CT_ERROR_TOKENNEXT 3971
#define CT_ERROR_TOKENSEP 3981
#define CT_ERROR_TOKENUPPER 3991
#define CT_ERROR_VALPOS 4002
#define CT_ERROR_WORDONE 4011
#define CT_ERROR_WORDONLY 4021
#define CT_ERROR_WORDREM 4031
#define CT_ERROR_WORDREPL 4041
#define CT_ERROR_WORDSWAP 4051
#define CT_ERROR_WORDTOCHAR 4061
#define CT_ERROR_TOKENNUM 3982
#define CT_ERROR_TOKENSEP 3991
#define CT_ERROR_TOKENUPPER 4001
#define CT_ERROR_VALPOS 4012
#define CT_ERROR_WORDONE 4021
#define CT_ERROR_WORDONLY 4031
#define CT_ERROR_WORDREM 4041
#define CT_ERROR_WORDREPL 4051
#define CT_ERROR_WORDSWAP 4061
#define CT_ERROR_WORDTOCHAR 4071
/* number and bit manipulation */
#define CT_ERROR_BITTOC 4111

14
harbour/contrib/libct/ctflist.txt
View File

@@ -241,19 +241,21 @@ REMRIGHT ;S;
REPLALL ;S;
REPLLEFT ;S;
REPLRIGHT ;S;
RESTTOKEN ;N;
SAVETOKEN ;N;
RESTTOKEN ;R;
SAVETOKEN ;R;
SETATLIKE ;R;
STRDIFF ;N;
STRSWAP ;S;
TABEXPAND ;N;
TABPACK ;N;
TOKEN ;R;
TOKENAT ;N;
TOKENEND ;N;
TOKENINIT ;N;
TOKENAT ;R;
TOKENEND ;R;
TOKENEXIT ;R; !NEW!
TOKENINIT ;R;
TOKENLOWER ;R;
TOKENNEXT ;N;
TOKENNEXT ;R;
TOKENNUM ;R; !NEW!
TOKENSEP ;R;
TOKENUPPER ;R;
VALPOS ;R;

17
harbour/contrib/libct/makefile.bc
View File

@@ -107,7 +107,7 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\charsort.obj \
$(OBJ_DIR)\charswap.obj \
$(OBJ_DIR)\count.obj \
$(OBJ_DIR)\ct.obj \
$(OBJ_DIR)\ctc.obj \
$(OBJ_DIR)\ctmath.obj \
$(OBJ_DIR)\ctset.obj \
$(OBJ_DIR)\ctstr.obj \
@@ -129,10 +129,12 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\replace.obj \
$(OBJ_DIR)\strswap.obj \
$(OBJ_DIR)\token1.obj \
$(OBJ_DIR)\token2.obj \
$(OBJ_DIR)\trig.obj \
$(OBJ_DIR)\wordrepl.obj \
$(OBJ_DIR)\wordtoch.obj \
\
$(OBJ_DIR)\ct.obj \
$(OBJ_DIR)\ctmisc.obj \
#
@@ -220,7 +222,7 @@ $(OBJ_DIR)\count.obj : $(TOOLS_DIR)\count.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\ct.obj : $(TOOLS_DIR)\ct.c
$(OBJ_DIR)\ctc.obj : $(TOOLS_DIR)\ctc.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
@@ -308,6 +310,10 @@ $(OBJ_DIR)\token1.obj : $(TOOLS_DIR)\token1.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\token2.obj : $(TOOLS_DIR)\token2.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\trig.obj : $(TOOLS_DIR)\trig.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
@@ -320,6 +326,13 @@ $(OBJ_DIR)\wordtoch.obj : $(TOOLS_DIR)\wordtoch.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\ct.c : $(TOOLS_DIR)\ct.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\ct.obj : $(OBJ_DIR)\ct.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\ctmisc.c : $(TOOLS_DIR)\ctmisc.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@

8
harbour/contrib/libct/makefile.vc
View File

@@ -127,7 +127,7 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\charsort.obj \
$(OBJ_DIR)\charswap.obj \
$(OBJ_DIR)\count.obj \
$(OBJ_DIR)\ct.obj \
$(OBJ_DIR)\ctc.obj \
$(OBJ_DIR)\ctmath.obj \
$(OBJ_DIR)\ctset.obj \
$(OBJ_DIR)\ctstr.obj \
@@ -149,10 +149,12 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\replace.obj \
$(OBJ_DIR)\strswap.obj \
$(OBJ_DIR)\token1.obj \
$(OBJ_DIR)\token2.obj \
$(OBJ_DIR)\trig.obj \
$(OBJ_DIR)\wordrepl.obj \
$(OBJ_DIR)\wordtoch.obj \
\
$(OBJ_DIR)\ct.obj \
$(OBJ_DIR)\ctmisc.obj \
#
@@ -181,7 +183,7 @@ CLEAN:
-@if exist $(OBJ_DIR)\charsort.* del $(OBJ_DIR)\charsort.*
-@if exist $(OBJ_DIR)\charswap.* del $(OBJ_DIR)\charswap.*
-@if exist $(OBJ_DIR)\count.* del $(OBJ_DIR)\count.*
-@if exist $(OBJ_DIR)\ct.* del $(OBJ_DIR)\ct.*
-@if exist $(OBJ_DIR)\ctc.* del $(OBJ_DIR)\ctc.*
-@if exist $(OBJ_DIR)\ctmath.* del $(OBJ_DIR)\ctmath.*
-@if exist $(OBJ_DIR)\ctset.* del $(OBJ_DIR)\ctset.*
-@if exist $(OBJ_DIR)\ctstr.* del $(OBJ_DIR)\ctstr.*
@@ -203,9 +205,11 @@ CLEAN:
-@if exist $(OBJ_DIR)\replace.* del $(OBJ_DIR)\replace.*
-@if exist $(OBJ_DIR)\strswap.* del $(OBJ_DIR)\strswap.*
-@if exist $(OBJ_DIR)\token1.* del $(OBJ_DIR)\token1.*
-@if exist $(OBJ_DIR)\token2.* del $(OBJ_DIR)\token2.*
-@if exist $(OBJ_DIR)\trig.* del $(OBJ_DIR)\trig.*
-@if exist $(OBJ_DIR)\wordrepl.* del $(OBJ_DIR)\wordrepl.*
-@if exist $(OBJ_DIR)\wordtoch.* del $(OBJ_DIR)\wordtoch.*
-@if exist $(OBJ_DIR)\ct.* del $(OBJ_DIR)\ct.*
-@if exist $(OBJ_DIR)\ctmisc.* del $(OBJ_DIR)\ctmisc.*
-@if exist $(TOOLS_LIB) del $(TOOLS_LIB)

9
harbour/contrib/libct/readme.txt
View File

@@ -57,6 +57,15 @@ Martin Vogel <vogel@inttec.de>
* TOKEN() New 5th and 6th parameter where the function can store
the tokenizer before and after the extracted token.
* TOKENINIT() all incremental tokenizer functions
TOKENINIT(),TOKENEXIT(),TOKENNEXT(),TOKENNUM(),
TOKENAT(),SAVETOKEN(),RESTTOKEN(),TOKENEND()
now support locally stored token environments
+ TOKENEXIT() new function related to TOKENINIT
+ TOKENNUM() numtoken() functionality for incremental tokenizer
* TOKENLOWER() New 4th parameter <nSkipWidth>
* TOKENUPPER() New 4th parameter <nSkipWidth>

67
harbour/contrib/libct/temper.c
View File

@@ -1,67 +0,0 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Celsius() and FAHRENHEIT() CT3 function
*
* Copyright 2001 Luiz Rafael Culik<culik@sl.conex.net>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#define HB_OS_WIN_32_USED
#include "hbapi.h"
#include "hbmath.h"
HB_FUNC(CELSIUS)
{
double dFarhrenheit=hb_parnd(1);
hb_retnd(((5*dFarhrenheit)-(5*32))/9);
}
HB_FUNC(FAHRENHEIT)
{
double dCelsius=hb_parnd(1);
hb_retnd(((9*dCelsius)+(5*32))/5);
}

1
harbour/contrib/libct/tests/Makefile
View File

@@ -72,6 +72,7 @@ PRG_SOURCES=\
numtoken.prg \
setatlik.prg \
token.prg \
token2.prg \
tokenlow.prg \
tokensep.prg \
tokenupp.prg \

185
harbour/contrib/libct/tests/token2.prg Normal file
View File

@@ -0,0 +1,185 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 functions
* - TOKENINIT()
* - TOKENEXIT()
* - TOKENNEXT()
* - TOKENNUM()
* - TOKENAT()
* - SAVETOKEN()
* - RESTTOKEN()
* - TOKENEND()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
local cStr1 := "A,BB,CCC,DDDD,EEEEE,FFFFFF"
local cStr2 := "ZZZZZZ,YYYYY,XXXX,WWW,VV,U"
local cStr3 := "0123456789ABCDEFGHIJKLM"
local cStr4 := "08:09:10:11:12"
local cStr5 := "05:00+20:00+35:00+50:00"
local cStr6
local cTE1, cTE2
ctinit()
qout ("Begin test of incremental tokenizer function family")
qout ("")
// Some simple tests with global token environment
qout ([ Incremental tokenizing the string "]+cStr1+["])
qout ([ tokeninit (@cStr1, ",", 1) == .T. ? ----> ] + ltoc(tokeninit (@cStr1, ",", 1)))
qout ([ tokennum () == 6 ? ---------------------> ] + str(tokennum ()))
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
while (!tokenend())
qout ([ tokennext (@cStr1) ------------------> "] + tokennext(@cStr1)+["])
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
enddo
qout ()
qout ([ rewind with tokeninit () == .T. ? ------> ] + ltoc(tokeninit ()))
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
while (!tokenend())
qout ([ tokennext (@cStr1) ------------------> "] + tokennext(@cStr1)+["])
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
enddo
qout ()
qout ([ access tokens directly with tokennext])
qout ([ tokennext (@cStr1,2) == "BB" ? -------> "] + tokennext(@cStr1,2)+["])
qout ([ tokennext (@cStr1,4) == "DDDD" ? -----> "] + tokennext(@cStr1,4)+["])
qout ()
qout ("...Press any key...")
qout ()
inkey (0)
qout ([ Incremental tokenizing the string "]+cStr3+[" with the])
qout ([ token environment of cStr1 !])
qout ([ rewind with tokeninit () == .T. ? ------> ] + ltoc(tokeninit ()))
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
while (!tokenend())
qout ([ tokennext (@cStr3) ------------------> "] + tokennext(@cStr3)+["])
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
enddo
qout ()
qout ([ rewind with tokeninit () == .T. ? ------> ] + ltoc(tokeninit ()))
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
while (!tokenend())
qout ([ start & end with tokenat(.F./.T.)-----> ] + str(tokenat())+[ ]+str(tokenat(.T.)))
tokennext(@cStr1)
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
enddo
qout ()
qout ([ access tokens directly with tokenat])
qout ([ tokenat (.F.,2) == 3 ? ---------------> ] + str(tokenat(.F.,2)))
qout ([ tokenat (.T.,4) == 14 ? --------------> ] + str(tokenat(.T.,4)))
qout()
qout ("...Press any key...")
qout ()
inkey (0)
qout ([ Save global token environment with savetoken])
cTE1 := savetoken()
qout ([ tokeninit a different string, cStr4 := "]+cStr4+[", with tokeninit()])
qout ([ tokeninit (@cStr4, ":", 1) == .T. ? ----> ] + ltoc(tokeninit (@cStr4, ":", 1)))
qout ([ tokennum () == 5 ? ---------------------> ] + str(tokennum ()))
qout ([ tokennext() == "08" ? ------------------> "]+ tokennext (@cStr4)+["])
qout ([ Now restore global token environment with resttoken and rewind it])
resttoken (cTE1)
tokeninit()
qout ([ tokennum () == 6 ? ---------------------> ] + str(tokennum ()))
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
while (!tokenend())
qout ([ tokennext (@cStr1) ------------------> "] + tokennext(@cStr1)+["])
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
enddo
qout ([ Release global TE with tokenexit () ----> ] + ltoc(tokenexit()))
qout ()
qout ("...Press any key...")
qout ()
inkey (0)
qout ([ Now tokenize cStr4 := "]+cStr4+[" and])
qout ([ cStr5 := "]+cStr5+["])
qout ([ and store the token environment locally to cTE1 and cTE2:])
qout ([ tokeninit (@cStr4, ":", 1, @cTE1) == .T. ? -> ] + ltoc(tokeninit (@cStr4, ":", 1, @cTE1)))
qout ([ tokeninit (@cStr5, "+", 1, @cTE2) == .T. ? -> ] + ltoc(tokeninit (@cStr5, "+", 1, @cTE2)))
qout ([ tokennum (@cTE1) == 5 ? --------------------> ] + str(tokennum (@cTE1)))
qout ([ tokennum (@cTE2) == 4 ? --------------------> ] + str(tokennum (@cTE2)))
qout ([ tokenend (@cTE1) ? ---------------------> ] + ltoc (tokenend (@cTE1)))
qout ([ tokenend (@cTE2) ? ---------------------> ] + ltoc (tokenend (@cTE2)))
while (!tokenend (@cTE1) .AND. !tokenend (@cTE2))
qout ([ next train at ]+tokennext (cStr4,,@cTE1)+":"+tokennext (cStr5,,@cTE2))
qout ([ compiled with tokennext (cStr4,,@cTE1)+":"+tokennext (cStr5,,@cTE2)])
qout ([ tokenend (@cTE1) ? ---------------------> ] + ltoc (tokenend (@cTE1)))
qout ([ tokenend (@cTE2) ? ---------------------> ] + ltoc (tokenend (@cTE2)))
enddo
qout ("")
qout ("End test of incremental tokenizer function family")
qout ()
qout ("...Press any key...")
qout ()
inkey (0)
ctexit()
return

1257
harbour/contrib/libct/token2.c Normal file
View File

File diff suppressed because it is too large Load Diff