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

2001-05-10 14:30 GMT+0200 (MET DST) Martin Vogel <vogel@inttec.de>

Browse Source
This commit is contained in:
Martin Vogel
2001-05-10 12:24:43 +00:00
parent 3a3a9b26dd
commit ed53aa16bf
12 changed files with 985 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
harbour/ChangeLog
View File

@@ -1,3 +1,27 @@
2001-05-10 14:30 GMT+0200 (MET DST) Martin Vogel <vogel@inttec.de>
+ contrib/libct/charmirr.c
+ CHARMIRR() function
+ contrib/libct/charrepl.c
+ CHARREPL() function
+ contrib/libct/wordrepl.c
+ WORDREPL() function
* contrib/libct/Makefile
* contrib/libct/makefile.bc
* contrib/libct/makefile.vc
+ added charmirr.c, charrepl.c, wordrepl.c
+ contrib/libct/tests/charmirr.prg
+ contrib/libct/tests/charrepl.prg
+ contrib/libct/tests/wordrepl.prg
! small test programs for new functions
* contrib/libct/tests/Makefile
+ added charmirr.prg, charrepl.prg, wordrepl.prg
2001-05-10 11:30 GMT+0200 (MET DST) Martin Vogel <vogel@inttec.de>
* contrib/libct/token1.c

3
harbour/contrib/libct/Makefile
View File

@@ -13,7 +13,9 @@ C_SOURCES=\
atrepl.c \
charevod.c \
charlist.c \
charmirr.c \
charop.c \
charrepl.c \
ctset.c \
ctstr.c \
ctchksum.c \
@@ -22,6 +24,7 @@ C_SOURCES=\
ctcrypt.c \
ctposupp.c \
token1.c \
wordrepl.c \
PRG_SOURCES=\
ctmisc.prg \

181
harbour/contrib/libct/charmirr.c Normal file
View File

@@ -0,0 +1,181 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 string function CHARMIRR()
*
* 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.h"
/* $DOC$
* $FUNCNAME$
* CHARMIRR()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Mirror a string
* $SYNTAX$
* CHARMIRR (<[@]cString>, [<lDontMirrorSpaces>]) -> cMirroredString
* $ARGUMENTS$
* <[@]cString> is the string that should be mirrored
* [<lDontMirrorSpaces>] if set to .T., spaces at the end of
* <cString> will not be mirrored but kept at the end
* Default: .F., mirror the whole string
* $RETURNS$
* <cMirroredString> the mirrored string
* $DESCRIPTION$
* The CHARMIRR() function mirrors a string, i.e. the first character
* will be put at the end, the second at the last but one position etc..
* One can use this function for index searches, but then, the spaces
* at the end of the string should not be mirrored.
* One can omit the return value of the function by setting the CSETREF()
* switch to .T., but <cString> must then be passed by reference to get
* a result.
* $EXAMPLES$
* ? charmirr ("racecar") // "racecar"
* ? charmirr ("racecar ", .T.) // "racecar "
* ? charmirr ("racecar ", .F.) // " racecar"
* $TESTS$
* charmirr ("racecar") == "racecar"
* charmirr ("racecar ", .T.) == "racecar "
* charmirr ("racecar ", .F.) == " racecar"
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARMIRR() is compatible with CT3's CHARMIRR().
* $PLATFORMS$
* All
* $FILES$
* Source is charmirr.c, library is ct3.
* $SEEALSO$
* CSETREF()
* $END$
*/
HB_FUNC (CHARMIRR)
{
int iNoRet;
/* suppressing return value ? */
iNoRet = ct_getref();
/* param check */
if (ISCHAR (1))
{
char *pcString = hb_parc (1);
size_t sStrLen = (size_t)hb_parclen (1);
char *pcRet, *pc1, *pc2;
int iDontMirrorSpaces;
if (ISLOG (2))
iDontMirrorSpaces = hb_parl (2);
else
iDontMirrorSpaces = 0;
if (sStrLen == 0)
{
if (iNoRet)
hb_retl (0);
else
hb_retc ("");
return;
}
pcRet = hb_xgrab (sStrLen);
pc1 = pcString+sStrLen-1;
if (iDontMirrorSpaces)
{
pc2 = pcRet+sStrLen-1;
while ((pc1 >= pcString) && (*pc1 == 0x20))
{
*pc2 = 0x20;
pc1--;
pc2--;
}
}
pc2 = pcRet;
for (; pc1 >= pcString; pc1--)
{
*pc2 = *pc1;
pc2++;
}
/* return string */
if (ISBYREF (1))
hb_storclen (pcRet, sStrLen, 1);
if (iNoRet)
hb_retl (0);
else
hb_retclen (pcRet, sStrLen);
hb_xfree (pcRet);
}
else /* if (ISCHAR (1)) */
{
if (iNoRet)
hb_retl (0);
else
hb_retc ("");
}
return;
}

246
harbour/contrib/libct/charrepl.c Normal file
View File

@@ -0,0 +1,246 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 string function CHARREPL()
*
* 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.h"
/* $DOC$
* $FUNCNAME$
* CHARREPL()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Replacement of characters
* $SYNTAX$
* CHARREPL (<cSearchString>, <[@]cString>,
* <cReplaceString>, [<lMode>]) -> cString
* $ARGUMENTS$
* <cSearchString> is a string of characters that should be replaced
* <[@]cString> is the processed string
* <cReplaceString> is a string of characters that replace the one
* of <cSearchString>
* [<lMode>] sets the replacement method (see description)
* Default: .F.
* $RETURNS$
* <cString> the processed string
* $DESCRIPTION$
* The CHARREPL() function replaces certain characters in <cString>
* with others depending on the setting of <lMode>.
* If <lMode> is set to .F., the function takes the characters of
* <cSearchString> one after the other, searches for them in <cString>
* and, if successful, replaces them with the corresponding character
* of <cReplaceString>. Be aware that if the same characters occur
* in both <cSearchString> and <cReplaceString>, the character on a
* certain position in <cString> can be replaced multiple times.
* if <lMode> is set to .T., the function takes the characters in <cString>
* one after the other, searches for them in <cSearchString> and, if
* successful, replaces them with the corresponding character of
* <cReplaceString>. Note that no multiple replacements are possible
* in this mode.
* If <cReplaceString> is shorter than <cSearchString>, the last
* character of <cReplaceString> is used as corresponding character
* for the the "rest" of <cSearchString>.
* One can omit the return value by setting the CSETREF() switch to .T.,
* but then one must pass <cString> by reference to get the result.
* $EXAMPLES$
* ? charrepl ("1234", "1x2y3z", "abcd") // "axbycz"
* ? charrepl ("abcdefghij", "jhfdb", "1234567890") // "08642"
* ? charrepl ("abcdefghij", "jhfdb", "12345") // "55542"
* ? charrepl ("1234", "1234", "234A") // "AAAA"
* ? charrepl ("1234", "1234", "234A", .T.) // "234A"
* $TESTS$
* charrepl ("1234", "1x2y3z", "abcd") == "axbycz"
* charrepl ("abcdefghij", "jhfdb", "1234567890") == "08642"
* charrepl ("abcdefghij", "jhfdb", "12345") == "55542"
* charrepl ("1234", "1234", "234A") == "AAAA"
* charrepl ("1234", "1234", "234A", .T.) == "234A"
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARREPL() is compatible with CT3's CHARREPL().
* $PLATFORMS$
* All
* $FILES$
* Source is charrepl.c, library is ct3.
* $SEEALSO$
* WORDREPL() POSREPL() RANGEREPL()
* CSETREF()
* $END$
*/
HB_FUNC (CHARREPL)
{
int iNoRet;
size_t sSearchLen, sReplaceLen;
/* suppressing return value ? */
iNoRet = ct_getref();
/* param check */
if (((sSearchLen = (size_t)hb_parclen (1)) > 0) &&
(ISCHAR (2)) &&
((sReplaceLen = (size_t)hb_parclen (3)) > 0))
{
/* get parameters */
char *pcSearch = hb_parc (1);
char *pcString = hb_parc (2);
size_t sStrLen = (size_t)hb_parclen (2);
char *pcReplace = hb_parc (3);
int iMode;
char *pcRet;
size_t sIndex;
if (ISLOG (4))
{
iMode = hb_parl (4);
}
else
{
iMode = 0;
}
pcRet = hb_xgrab (sStrLen);
hb_xmemcpy (pcRet, pcString, sStrLen);
for (sIndex = 0; sIndex < sSearchLen; sIndex++)
{
size_t sMatchStrLen;
char *pc;
size_t sReplIndex = sIndex;
if (sReplIndex > sReplaceLen-1)
{
sReplIndex = sReplaceLen-1;
}
if (iMode)
{
/* no multiple replacements: searching in pcString,
replacing in pcRet */
pc = pcString;
while ((pc = ct_at_exact_forward (pc, sStrLen-(pc-pcString),
pcSearch+sIndex, 1,
&sMatchStrLen)) != NULL)
{
*(pcRet+(pc-pcString)) = *(pcReplace+sReplIndex);
pc++;
}
}
else
{
/* multiple replacements: searching & replacing in pcRet */
pc = pcRet;
while ((pc = ct_at_exact_forward (pc, sStrLen-(pc-pcRet),
pcSearch+sIndex, 1,
&sMatchStrLen)) != NULL)
{
*pc = *(pcReplace+sReplIndex);
pc++;
}
}
}
/* return string */
if (ISBYREF (2))
{
hb_storclen (pcRet, sStrLen, 2);
}
if (iNoRet)
{
hb_retl (0);
}
else
{
hb_retclen (pcRet, sStrLen);
}
hb_xfree (pcRet);
}
else /* ((sSearchLen = (size_t)hb_parclen (1)) > 0) &&
(ISCHAR (2)) &&
((sReplaceLen = (size_t)hb_parclen (3)) > 0)) */
{
if (iNoRet)
{
hb_retl (0);
}
else
{
if (ISCHAR (2))
{
hb_retclen (hb_parc (2), hb_parclen (2));
}
else
{
hb_retc ("");
}
}
}
return;
}

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

@@ -174,7 +174,7 @@ CHARAND ;R;
CHAREVEN ;R;
CHARHIST ;R; !NEW!
CHARLIST ;R;
CHARMIRR ;N;
CHARMIRR ;R;
CHARMIX ;R;
CHARNOLIST ;R;
CHARNOT ;R;
@@ -186,7 +186,7 @@ CHARPACK ;N;
CHARRELA ;N;
CHARRELREP ;N;
CHARREM ;N;
CHARREPL ;N;
CHARREPL ;R;
CHARRLL ;R; !NEW!
CHARRLR ;R; !NEW!
CHARSHL ;R; !NEW!
@@ -251,7 +251,7 @@ TOKENUPPER ;R;
VALPOS ;R;
WORDONE ;N;
WORDONLY ;N;
WORDREPL ;N;
WORDREPL ;R;
WORDSWAP ;N;
WORDTOCHAR ;N;
;

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

@@ -98,7 +98,9 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\atrepl.obj \
$(OBJ_DIR)\charevod.obj \
$(OBJ_DIR)\charlist.obj \
$(OBJ_DIR)\charmirr.obj \
$(OBJ_DIR)\charop.obj \
$(OBJ_DIR)\charrepl.obj \
$(OBJ_DIR)\ctset.obj \
$(OBJ_DIR)\ctstr.obj \
$(OBJ_DIR)\ctchksum.obj \
@@ -107,6 +109,7 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\ctcrypt.obj \
$(OBJ_DIR)\ctposupp.obj \
$(OBJ_DIR)\token1.obj \
$(OBJ_DIR)\wordrepl.obj \
\
$(OBJ_DIR)\ctmisc.obj \
@@ -159,10 +162,18 @@ $(OBJ_DIR)\charlist.obj : $(TOOLS_DIR)\charlist.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charmirr.obj : $(TOOLS_DIR)\charmirr.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charop.obj : $(TOOLS_DIR)\charop.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charrepl.obj : $(TOOLS_DIR)\charrepl.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\ctset.obj : $(TOOLS_DIR)\ctset.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
@@ -195,6 +206,10 @@ $(OBJ_DIR)\token1.obj : $(TOOLS_DIR)\token1.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\wordrepl.obj : $(TOOLS_DIR)\wordrepl.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\ctmisc.c : $(TOOLS_DIR)\ctmisc.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@

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

@@ -118,7 +118,9 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\atrepl.obj \
$(OBJ_DIR)\charevod.obj \
$(OBJ_DIR)\charlist.obj \
$(OBJ_DIR)\charmirr.obj \
$(OBJ_DIR)\charop.obj \
$(OBJ_DIR)\charrepl.obj \
$(OBJ_DIR)\ctset.obj \
$(OBJ_DIR)\ctstr.obj \
$(OBJ_DIR)\ctchksum.obj \
@@ -127,6 +129,7 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\ctcrypt.obj \
$(OBJ_DIR)\ctposupp.obj \
$(OBJ_DIR)\token1.obj \
$(OBJ_DIR)\wordrepl.obj \
\
$(OBJ_DIR)\ctmisc.obj \
@@ -147,7 +150,9 @@ CLEAN:
-@if exist $(OBJ_DIR)\atrepl.* del $(OBJ_DIR)\atrepl.*
-@if exist $(OBJ_DIR)\charevod.* del $(OBJ_DIR)\charevod.*
-@if exist $(OBJ_DIR)\charlist.* del $(OBJ_DIR)\charlist.*
-@if exist $(OBJ_DIR)\charmirr.* del $(OBJ_DIR)\charmirr.*
-@if exist $(OBJ_DIR)\charop.* del $(OBJ_DIR)\charop.*
-@if exist $(OBJ_DIR)\charrepl.* del $(OBJ_DIR)\charrepl.*
-@if exist $(OBJ_DIR)\ctset.* del $(OBJ_DIR)\ctset.*
-@if exist $(OBJ_DIR)\ctstr.* del $(OBJ_DIR)\ctstr.*
-@if exist $(OBJ_DIR)\ctchksum.* del $(OBJ_DIR)\ctchksum.*
@@ -156,6 +161,7 @@ CLEAN:
-@if exist $(OBJ_DIR)\ctcrypt.* del $(OBJ_DIR)\ctcrypt.*
-@if exist $(OBJ_DIR)\ctposupp.* del $(OBJ_DIR)\ctposupp.*
-@if exist $(OBJ_DIR)\token1.* del $(OBJ_DIR)\token1.*
-@if exist $(OBJ_DIR)\wordrepl.* del $(OBJ_DIR)\wordrepl.*
-@if exist $(OBJ_DIR)\ctmisc.* del $(OBJ_DIR)\ctmisc.*
-@if exist $(TOOLS_LIB) del $(TOOLS_LIB)

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

@@ -44,10 +44,12 @@ PRG_SOURCES=\
chareven.prg \
charhist.prg \
charlist.prg \
charmirr.prg \
charnlst.prg \
charnot.prg \
charodd.prg \
charor.prg \
charrepl.prg \
charrll.prg \
charrlr.prg \
charshl.prg \
@@ -64,6 +66,7 @@ PRG_SOURCES=\
tokensep.prg \
tokenupp.prg \
valpos.prg \
wordrepl.prg \
PRG_HEADERS=\

77
harbour/contrib/libct/tests/charmirr.prg Normal file
View File

@@ -0,0 +1,77 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARMIRR()
*
* 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
qout ("Begin test of CHARMIRR()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charmirr ("racecar") == "racecar" ? ----------> "] + charmirr("racecar") + ["])
qout ([ charmirr ("racecar ", .T.) == "racecar " ? -> "] + charmirr("racecar ", .T.) + ["])
qout ([ charmirr ("racecar ", .F.) == " racecar" ? -> "] + charmirr("racecar ", .F.) + ["])
qout ("End test of CHARMIRR()")
qout ("")
return

81
harbour/contrib/libct/tests/charrepl.prg Normal file
View File

@@ -0,0 +1,81 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARREPL()
*
* 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
qout ("Begin test of CHARREPL()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charrepl ("1234", "1x2y3z", "abcd") == "axbycz" ? --> "] + charrepl ("1234", "1x2y3z", "abcd") + ["])
qout ([ charrepl ("abcdefghij", "jhfdb", "1234567890") == "08642" ? --> "] + charrepl ("abcdefghij", "jhfdb", "1234567890")+ ["])
qout ([ charrepl ("abcdefghij", "jhfdb", "12345") == "55542" ? --> "] + charrepl ("abcdefghij", "jhfdb", "12345") + ["])
qout ([ charrepl ("1234", "1234", "234A") == "AAAA" ? --> "] + charrepl ("1234", "1234", "234A") + ["])
qout ([ charrepl ("1234", "1234", "234A", .T.) == "234A" ? --> "] + charrepl ("1234", "1234", "234A", .T.) + ["])
qout ("")
qout ("End test of CHARREPL()")
qout ("")
return

86
harbour/contrib/libct/tests/wordrepl.prg Normal file
View File

@@ -0,0 +1,86 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function WORDREPL()
*
* 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
qout ("Begin test of WORDREPL()")
qout ("")
// simple tests
qout (" Simple tests:")
qout ([ wordrepl("CC", "AABBCCDDEE", "XX") == "AABBXXDDEE"? --> "] + wordrepl("CC", "AABBCCDDEE", "XX")+ ["])
qout ([ wordrepl("aa", "1aaaa", "ba") == "1abaa" ? ------> "] + wordrepl("aa", "1aaaa", "ba") + ["])
qout ([ wordrepl("aa", "1aaaa", "ba", .T.) == "1baba" ? ------> "] + wordrepl("aa", "1aaaa", "ba", .T.)+ ["])
qout ("")
qout (" Testing CSETATMUPA(.T.) with lMode==.T.:")
csetatmupa(.T.)
qout ([ wordrepl("aa", "1aaaa", "ba") == "1abaa" ? --> "] + wordrepl("aa", "1aaaa", "ba") + ["])
qout ([ wordrepl("aa", "1aaaa", "ba", .T.) == "1bbba" ? --> "] + wordrepl("aa", "1aaaa", "ba", .T.)+ ["])
qout ("")
qout ("End test of WORDREPL()")
qout ("")
return

260
harbour/contrib/libct/wordrepl.c Normal file
View File

@@ -0,0 +1,260 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 string function WORDREPL()
*
* 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.h"
/* $DOC$
* $FUNCNAME$
* WORDREPL()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Replacement of double characters
* $SYNTAX$
* WORDREPL (<cDoubleCharacterSearchString>, <[@]cString>,
* <cDoubleCharacterReplaceString>, [<lMode>]) -> cString
* $ARGUMENTS$
* <cDoubleCharacterSearchString> is a string of double characters
* that should be replaced
* <[@]cString> is the processed string
* <cDoubleCharacterReplaceString> is a string of double characters that
* replace the one of <cSearchString>
* [<lMode>] sets the replacement method (see description)
* Default: .F.
* $RETURNS$
* cString the processed string
* $DESCRIPTION$
* The WORDREPL() takes the double characters of <cDoubleCharacterSearchString>
* one after the other and searches for them in <cString>.
* For <lMode> set to .F., this search is successful, if the double
* character sequence in <cString> starts at an odd position or at any
* position, if <lMode> is set to .T.
* If this happens, the double character sequence will be replaced with
* the corresponding double character sequence of <cDoubleCharacterReplaceString>.
* If <cDoubleCharacterReplaceString> is shorter than <cDoubleCharacterSearchString>
* the last double sequence of <cDoubleCharacterReplaceString> is used for
* the "rest" of <cDoubleCharacterSearchString>. Note that the last double
* character sequence in "AABBC" is "BB" in this context !!
* After the replacement the function restarts the search in <cString>
* BEHIND the replacement if the CSETATMUPA() switch is turned off, or
* BEHIND the first character of the replacement if the switch is turned on.
* (see examples for this !)
* One can omit the return value of this function by setting the CSETREF()
* to .T., but one must then pass <cString> by reference to get a result.
* $EXAMPLES$
* ? wordrepl("CC", "AABBCCDDEE", "XX") // "AABBXXDDEE"
* ? wordrepl("aa", "1aaaa", "ba") // "1abaa"
* ? wordrepl("aa", "1aaaa", "ba", .T.) // "1baba"
* csetatmupa(.T.)
* ? wordrepl("aa", "1aaaa", "ba") // "1abaa"
* ? wordrepl("aa", "1aaaa", "ba", .T.) // "1bbba"
* $TESTS$
* wordrepl("CC", "AABBCCDDEE", "XX") == "AABBXXDDEE"
* wordrepl("aa", "1aaaa", "ba") == "1abaa"
* wordrepl("aa", "1aaaa", "ba", .T.) == "1baba"
* eval ({||csetatmupa(.T.),wordrepl("aa", "1aaaa", "ba")}) == "1abaa"
* eval ({||csetatmupa(.T.),wordrepl("aa", "1aaaa", "ba", .T.)}) == "1bbba"
* $STATUS$
* Ready
* $COMPLIANCE$
* WORDREPL() is compatible with CT3's WORDREPL().
* $PLATFORMS$
* All
* $FILES$
* Source is wordrepl.c, library is ct3.
* $SEEALSO$
* CHARREPL() RANGEREPL() POSREPL()
* CSETREF() CSETATMUPA()
* $END$
*/
HB_FUNC (WORDREPL)
{
int iNoRet;
int iMultiPass;
size_t sSearchLen, sReplaceLen;
/* suppressing return value ? */
iNoRet = ct_getref();
iMultiPass = ct_getatmupa();
/* param check */
if (((sSearchLen = (size_t)hb_parclen (1))/2 > 0) &&
(ISCHAR (2)) &&
((sReplaceLen = (size_t)hb_parclen (3))/2 > 0))
{
/* get parameters */
char *pcSearch = hb_parc (1);
char *pcString = hb_parc (2);
size_t sStrLen = (size_t)hb_parclen (2);
char *pcReplace = hb_parc (3);
int iMode;
char *pcRet;
size_t sIndex;
if (ISLOG (4))
{
iMode = hb_parl (4);
}
else
{
iMode =0;
}
pcRet = hb_xgrab (sStrLen);
hb_xmemcpy (pcRet, pcString, sStrLen);
for (sIndex = 0; sIndex < (sSearchLen&0xFFFFFFFE); sIndex+=2)
{
size_t sMatchStrLen;
char *pc;
size_t sReplIndex = sIndex;
if (sReplIndex > (sReplaceLen&0xFFFFFFFE))
{
sReplIndex = (sReplaceLen&0xFFFFFFFE);
}
pc = pcString;
while ((pc = ct_at_exact_forward (pc, sStrLen-(pc-pcString),
pcSearch+sIndex, 2,
&sMatchStrLen)) != NULL)
{
if (iMode)
{
/* always replace */
*(pcRet+(pc-pcString)) = *(pcReplace+sReplIndex);
*(pcRet+(pc-pcString)+1) = *(pcReplace+sReplIndex+1);
if (iMultiPass)
{
pc++;
}
else
{
pc+=2;
}
}
else
{
/* replace only if pc is an even position */
if (((pc-pcString)%2) == 0)
{
*(pcRet+(pc-pcString)) = *(pcReplace+sReplIndex);
*(pcRet+(pc-pcString)+1) = *(pcReplace+sReplIndex+1);
/* parse pcString in steps of two characters */
pc+=2;
}
else
{
/* we are on an odd position, so add only 1 to pc */
pc++;
}
}
}
}
/* return string */
if (ISBYREF (2))
{
hb_storclen (pcRet, sStrLen, 2);
}
if (iNoRet)
{
hb_retl (0);
}
else
{
hb_retclen (pcRet, sStrLen);
}
hb_xfree (pcRet);
}
else /* ((sSearchLen = (size_t)hb_parclen (1))/2 > 0) &&
(ISCHAR (2)) &&
((sReplaceLen = (size_t)hb_parclen (3))/2 > 0)) */
{
if (iNoRet)
{
hb_retl (0);
}
else
{
if (ISCHAR (2))
{
hb_retclen (hb_parc (2), hb_parclen (2));
}
else
{
hb_retc ("");
}
}
}
return;
}