From b1cf1729107069fd8bb44eb11fe0a32dc30d6d10 Mon Sep 17 00:00:00 2001 From: Martin Vogel Date: Sat, 12 May 2001 16:29:33 +0000 Subject: [PATCH] 2001-05-12 18:30 GMT+0200 Martin Vogel --- harbour/ChangeLog | 73 +++++ harbour/contrib/libct/Makefile | 85 ++++-- harbour/contrib/libct/charmix.c | 146 ++++++++++ harbour/contrib/libct/charone.c | 344 +++++++++++++++++++++++ harbour/contrib/libct/charonly.c | 320 +++++++++++++++++++++ harbour/contrib/libct/charsort.c | 252 +++++++++++++++++ harbour/contrib/libct/charswap.c | 282 +++++++++++++++++++ harbour/contrib/libct/ctchrmix.c | 71 ----- harbour/contrib/libct/ctflist.txt | 17 +- harbour/contrib/libct/makefile.bc | 30 +- harbour/contrib/libct/makefile.vc | 12 +- harbour/contrib/libct/readme.txt | 20 +- harbour/contrib/libct/tests/Makefile | 10 + harbour/contrib/libct/tests/charmix.prg | 80 ++++++ harbour/contrib/libct/tests/charone.prg | 80 ++++++ harbour/contrib/libct/tests/charonly.prg | 78 +++++ harbour/contrib/libct/tests/charrem.prg | 78 +++++ harbour/contrib/libct/tests/charsort.prg | 85 ++++++ harbour/contrib/libct/tests/charswap.prg | 78 +++++ harbour/contrib/libct/tests/wordone.prg | 78 +++++ harbour/contrib/libct/tests/wordonly.prg | 78 +++++ harbour/contrib/libct/tests/wordrem.prg | 79 ++++++ harbour/contrib/libct/tests/wordswap.prg | 78 +++++ 23 files changed, 2338 insertions(+), 116 deletions(-) create mode 100644 harbour/contrib/libct/charmix.c create mode 100644 harbour/contrib/libct/charone.c create mode 100644 harbour/contrib/libct/charonly.c create mode 100644 harbour/contrib/libct/charsort.c create mode 100644 harbour/contrib/libct/charswap.c delete mode 100644 harbour/contrib/libct/ctchrmix.c create mode 100644 harbour/contrib/libct/tests/charmix.prg create mode 100644 harbour/contrib/libct/tests/charone.prg create mode 100644 harbour/contrib/libct/tests/charonly.prg create mode 100644 harbour/contrib/libct/tests/charrem.prg create mode 100644 harbour/contrib/libct/tests/charsort.prg create mode 100644 harbour/contrib/libct/tests/charswap.prg create mode 100644 harbour/contrib/libct/tests/wordone.prg create mode 100644 harbour/contrib/libct/tests/wordonly.prg create mode 100644 harbour/contrib/libct/tests/wordrem.prg create mode 100644 harbour/contrib/libct/tests/wordswap.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 071ceee58c..313e1aff42 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,76 @@ +2001-05-12 18:30 GMT+0200 Martin Vogel + + + contrib/libct/charmix.c + - contrib/libct/ctchrmix.c + ! ctchrmix.c replaced by charmix.c + + + contrib/libct/charone.c + ! CHARONE() function + ! WORDONE() function + + + contrib/libct/charonly.c + ! CHARONLY() function + ! WORDONLY() function + ! CHARREM() function + ! WORDREM() function !New function! + + + contrib/libct/charsort.c + ! CHARSORT() function + + + contrib/libct/charswap.c + ! CHARSWAP() function + ! WORDSWAP() function + + * contrib/libct/Makefile + * added charmix.c, removed ctchrmix.c + + added charone.c + + added charonly.c + + added charsort.c + + added charswap.c + + * contrib/libct/makefile.bc + * added charmix.c, removed ctchrmix.c + + added charone.c + + added charonly.c + + added charsort.c + + added charswap.c + + * contrib/libct/makefile.vc + * added charmix.c, removed ctchrmix.c + + added charone.c + + added charonly.c + + added charsort.c + + added charswap.c + + * contrib/libct/readme.txt + ! enhancement list updated ! + + * contrib/libct/ctflist.txt + ! function status list updated ! + + + contrib/libct/tests/charmix.prg + + contrib/libct/tests/charone.prg + + contrib/libct/tests/charonly.prg + + contrib/libct/tests/charrem.prg + + contrib/libct/tests/charsort.prg + + contrib/libct/tests/charswap.prg + + contrib/libct/tests/wordone.prg + + contrib/libct/tests/wordonly.prg + + contrib/libct/tests/wordrem.prg + + contrib/libct/tests/wordswap.prg + + * contrib/libct/tests/Makefile + + added charmix.prg + + added charone.prg + + added charonly.prg + + added charrem.prg + + added charsort.prg + + added charswap.prg + + added wordone.prg + + added wordonly.prg + + added wordrem.prg + + added wordswap.prg + 2001-05-11 14:15 UTC-0800 Ron Pinkas * include/hbclass.ch + Added syntax declaration support for METHOD ... OPERATOR ... diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index 6fc72d9ab3..a305f76cbd 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -4,31 +4,70 @@ ROOT = ../../ -C_SOURCES=\ - addascii.c \ - asciisum.c \ - ascpos.c \ - atadjust.c \ - atnum.c \ - atrepl.c \ - charevod.c \ - charlist.c \ - charmirr.c \ - charop.c \ - charrepl.c \ - ctset.c \ - ctstr.c \ - ctchksum.c \ - ctchrmix.c \ - ctcolton.c \ - ctcrypt.c \ - ctposupp.c \ - token1.c \ - wordrepl.c \ +C_SOURCES = \ + addascii.c \ + asciisum.c \ + ascpos.c \ + atadjust.c \ + atnum.c \ + atrepl.c \ + charevod.c \ + charlist.c \ + charmirr.c \ + charmix.c \ + charone.c \ + charonly.c \ + charop.c \ + charrepl.c \ + charsort.c \ + charswap.c \ + ctset.c \ + ctstr.c \ + ctchksum.c \ + ctcolton.c \ + ctcrypt.c \ + ctposupp.c \ + token1.c \ + wordrepl.c \ -PRG_SOURCES=\ - ctmisc.prg \ +PRG_SOURCES= \ + ctmisc.prg \ LIBNAME=ct3 include $(TOP)$(ROOT)config/lib.cf + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/harbour/contrib/libct/charmix.c b/harbour/contrib/libct/charmix.c new file mode 100644 index 0000000000..3a83aa2db3 --- /dev/null +++ b/harbour/contrib/libct/charmix.c @@ -0,0 +1,146 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CHARMIX() CT3 function + * + * Initial code: Copyright 1999 Victor Szakats + * + * CT3 conformity: Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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 program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "ct.h" + + +/* $DOC$ + * $FUNCNAME$ + * CHARMIX() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Mix two strings + * $SYNTAX$ + * CHARMIX ([, ]) --> cMixedString + * $ARGUMENTS$ + * String that will be mixed with the characters from + * [] String whose characters will be mixed with the one from + * . + * Default: " " (string with one space char) + * $RETURNS$ + * Mixed string + * $DESCRIPTION$ + * The CHARMIX() function mixes the strings and . To + * do this it takes one character after the other alternatively from + * and and puts them in the output string. + * This procedure is stopped when the end of is reached. If + * is shorter than , the function will start at + * the begin of again. If on the other hand is + * longer than , the surplus characters will be omitted. + * $EXAMPLES$ + * ? CHARMIX("ABC", "123") // "A1B2C3" + * ? CHARMIX("ABCDE", "12") // "A1B2C1D2E1" + * ? CHARMIX("AB", "12345") // "A1B2" + * ? CHARMIX("HELLO", " ") // "H E L L O " + * ? CHARMIX("HELLO", "") // "HELLO" + * $TESTS$ + * CHARMIX("ABC", "123") == "A1B2C3" + * CHARMIX("ABCDE", "12") == "A1B2C1D2E1" + * CHARMIX("AB", "12345") == "A1B2" + * CHARMIX("HELLO", " ") == "H E L L O " + * CHARMIX("HELLO", "") == "HELLO" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARMIX() is compatible with CT3's CHARMIX(). + * NOTE: CA-Tools version of CHARMIX() will hang + * if the second parameter is an empty string, this version will not. + * $PLATFORMS$ + * All + * $FILES$ + * Source is charmix.c, library is ct3. + * $SEEALSO$ + * CHAREVEN() CHARODD() + * $END$ + */ + +HB_FUNC (CHARMIX) +{ + + if (ISCHAR (1)) + { + char *pcString1 = hb_parc (1); + char *pcString2, *pcResult; + size_t sLen1 = hb_parclen (1); + size_t sLen2, sPos1, sPos2, sResultPos; + + if (sLen1 == 0) + { + hb_retc (""); + return; + } + + if (ISCHAR (2)) + { + pcString2 = hb_parc (2); + sLen2 = hb_parclen (2); + if (sLen2 == 0) + { + hb_retclen (pcString1, sLen1); + return; + } + } + else + { + pcString2 = " "; /* NOTE: The original CT3 uses " " as 2nd string + if the 2nd param is not a string ! */ + sLen2 = 1; + } + + pcResult = hb_xgrab (sLen1 * 2); + sPos2 = sResultPos = 0; + for (sPos1 = 0; sPos1 < sLen1;) + { + pcResult[sResultPos++] = pcString1[sPos1++]; + pcResult[sResultPos++] = pcString2[sPos2++]; + sPos2 %= sLen2; + } + + hb_retclen (pcResult, sLen1 * 2); + hb_xfree (pcResult); + + } + else + { + hb_retc (""); + } + +} + diff --git a/harbour/contrib/libct/charone.c b/harbour/contrib/libct/charone.c new file mode 100644 index 0000000000..4d02669164 --- /dev/null +++ b/harbour/contrib/libct/charone.c @@ -0,0 +1,344 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 string functions + * - CHARONE() + * - WORDONE() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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" + + +/* defines */ +#define DO_CHARONE_CHARONE 0 +#define DO_CHARONE_WORDONE 1 + +/* helper function for the *one functions */ +static void do_charone (int iSwitch) +{ + + char *pcString; + size_t sStrLen; + char *pcDeleteSet; + size_t sDeleteSetLen; + + /* param check */ + if (ISCHAR (1)) + { + + if (ISCHAR (2)) + { + pcString = hb_parc (2); + sStrLen = (size_t)hb_parclen (2); + pcDeleteSet = hb_parc (1); + sDeleteSetLen = (size_t)hb_parclen (1); + } + else + { + pcString = hb_parc (1); + sStrLen = (size_t)hb_parclen (1); + pcDeleteSet = NULL; + sDeleteSetLen = 0; + } + + switch (iSwitch) + { + case DO_CHARONE_CHARONE: + { + if (sStrLen > 1) + { + + char *pcSub; + char *pcRet; + size_t sRetStrLen = 0; + char cCurrent = *pcString; + int iDoDelete = 1; + + pcRet = hb_xgrab (sStrLen); + + /* copy first char */ + *(pcRet+sRetStrLen) = cCurrent; + sRetStrLen++; + + for (pcSub = pcString+1; pcSub 1) */ + { + /* algorithm does nothing to 1-char-strings */ + hb_retclen (pcString, sStrLen); + } + }; break; + + case DO_CHARONE_WORDONE: + { + if (sStrLen > 3) + { + char *pcSub; + char *pcRet; + size_t sRetStrLen = 0; + char cCurrent1 = *pcString; + char cCurrent2 = *(pcString+1); + int iDoDelete = 1; + + pcRet = hb_xgrab (sStrLen); + /* copy first double char */ + *(pcRet+sRetStrLen) = cCurrent1; + *(pcRet+sRetStrLen+1) = cCurrent2; + sRetStrLen += 2; + + for (pcSub = pcString+2; pcSub<(pcString+sStrLen-1); pcSub+=2) + { + if (!((*pcSub == cCurrent1) && (*(pcSub+1) == cCurrent2))) + { + char *pc; + /* "new" character */ + cCurrent1 = *pcSub; + cCurrent2 = *(pcSub+1); + *(pcRet+sRetStrLen) = cCurrent1; + *(pcRet+sRetStrLen+1) = cCurrent2; + sRetStrLen += 2; + + /* check if it should be deleted */ + if (pcDeleteSet == NULL) + { + iDoDelete = 1; + } + else + { + pc = ct_at_exact_forward (pcDeleteSet, sDeleteSetLen, + pcSub, 2, NULL); + if ((pc != NULL) && (((pc-pcDeleteSet)%2) == 0)) + iDoDelete = 1; + else + iDoDelete = 0; + } + } + else + { + if (!iDoDelete) + { + *(pcRet+sRetStrLen) = cCurrent1; + *(pcRet+sRetStrLen+1) = cCurrent2; + sRetStrLen += 2; + } + } + } + + /* copy last character if string len is odd */ + if (sStrLen%2==1) + { + *(pcRet+sRetStrLen) = *(pcString+sStrLen-1); + sRetStrLen++; + } + hb_retclen (pcRet, sRetStrLen); + hb_xfree (pcRet); + + } + else /* if (sStrLen > 3) */ + { + /* algorithm does nothing to 3-char-strings */ + hb_retclen (pcString, sStrLen); + } + + }; break; + + } /* switch (iSwitch) */ + + } + else /* if (ISCHAR (1)) */ + { + hb_retc (""); + } + + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARONE() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Reduce multiple occurences of a character to one + * $SYNTAX$ + * CHARONE ([,] ) -> cReducedString + * $ARGUMENTS$ + * [] specifies the characters the multiple + * occurences of which should be reduced to one + * Default: All characters. + * specifies the processed string + * $RETURNS$ + * the string with the reduced occurences + * $DESCRIPTION$ + * The CHARONE() function reduces multiple occurences of characters in + * to a single one. It is important to note that the multiple + * occurences must occur directly one behind the other. This behaviour is + * is in contrast to the CHARLIST() function. + * $EXAMPLES$ + * ? CHARONE("122333a123") // "123a123" + * ? CHARONE("A B CCCD") // "A B CD" + * ? CHARONE(" ", "A B A B") // "A B A B" + * ? CHARONE("o", "122oooB12o") // "122oB12o" + * $TESTS$ + * CHARONE("122333a123") == "123a123" + * CHARONE("A B CCCD") == "A B CD" + * CHARONE(" ", "A B A B") == "A B A B" + * CHARONE("o", "122oooB12o") == "122oB12o" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARONE() is compatible with CT3's CHARONE(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charone.c, library is ct3. + * $SEEALSO$ + * CHARREM() WORDONE() + * $END$ + */ + +HB_FUNC (CHARONE) +{ + + do_charone (DO_CHARONE_CHARONE); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * WORDONE() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Reduce multiple occurences of a double character to one + * $SYNTAX$ + * WORDONE ([,] ) -> cReducedString + * $ARGUMENTS$ + * [] specifies the double characters the multiple + * occurences of which should be reduced to one + * Default: All characters. + * specifies the processed string + * $RETURNS$ + * the string with the reduced occurences + * $DESCRIPTION$ + * The WORDONE() function reduces multiple occurences of double characters in + * to a single one. It is important to note that the multiple + * occurences must occur directly one behind the other. + * $EXAMPLES$ + * ? WORDONE("12ABAB12") // "12AB12" + * ? WORDONE("1AAAA2") // "1AAAA2" + * ? WORDONE("12", "1212ABAB") // "12ABAB" + * $TESTS$ + * WORDONE("12ABAB12") == "12AB12" + * WORDONE("1AAAA2") == "1AAAA2" + * WORDONE("12", "1212ABAB") == "12ABAB" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * WORDONE() is compatible with CT3's WORDONE(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charone.c, library is ct3. + * $SEEALSO$ + * CHARONE() CHARREM() + * $END$ + */ + +HB_FUNC (WORDONE) +{ + + do_charone (DO_CHARONE_WORDONE); + return; + +} diff --git a/harbour/contrib/libct/charonly.c b/harbour/contrib/libct/charonly.c new file mode 100644 index 0000000000..23dfac59ea --- /dev/null +++ b/harbour/contrib/libct/charonly.c @@ -0,0 +1,320 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 string functions + * - CHARONLY() + * - CHARREM() + * - WORDONLY() + * - WORDREM() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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" + + +/* defines */ +#define DO_CHARONLY_CHARONLY 0 +#define DO_CHARONLY_WORDONLY 1 +#define DO_CHARONLY_CHARREM 2 +#define DO_CHARONLY_WORDREM 3 + +/* helper function for the *one functions */ +static void do_charonly (int iSwitch) +{ + + /* param check */ + if (ISCHAR (1) && ISCHAR (2)) + { + + char *pcString = hb_parc (2); + size_t sStrLen = (size_t)hb_parclen (2); + char *pcOnlySet = hb_parc (1); + size_t sOnlySetLen = (size_t)hb_parclen (1); + char *pcRet; + size_t sRetStrLen = 0; + int iShift, iBool; + char *pcSub, *pc; + + if ((iSwitch == DO_CHARONLY_WORDONLY) || (iSwitch == DO_CHARONLY_WORDREM)) + { + iShift = 2; + } + else + { + iShift = 1; + } + + pcRet = hb_xgrab (sStrLen); + + for (pcSub = pcString; pcSub < pcString+sStrLen+1-iShift; pcSub += iShift) + { + pc = ct_at_exact_forward (pcOnlySet, sOnlySetLen, + pcSub, iShift, NULL); + iBool = ((pc != NULL) && (((pc-pcOnlySet)%iShift) == 0)); + if ((iBool && ((iSwitch == DO_CHARONLY_CHARONLY) || (iSwitch == DO_CHARONLY_WORDONLY))) || + (!iBool && ((iSwitch == DO_CHARONLY_CHARREM) || (iSwitch == DO_CHARONLY_WORDREM)))) + { + for (pc = pcSub; pc < pcSub+iShift; pc++) + { + pcRet[sRetStrLen++] = *pc; + } + } + } + + /* copy last character if string len is odd */ + if ((iShift == 2) && (sStrLen%2==1)) + { + pcRet[sRetStrLen++] = pcString[sStrLen-1]; + } + + hb_retclen (pcRet, sRetStrLen); + hb_xfree (pcRet); + + } + else /* if (ISCHAR (1) && ISCHAR (2)) */ + { + hb_retc (""); + } + + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARONLY() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Intersectional set of two strings based on characters + * $SYNTAX$ + * CHARONLY (, ) -> cReducedString + * $ARGUMENTS$ + * specifies the characters that must not be + * deleted in . + * is the string that should be processed + * $RETURNS$ + * A string with all characters deleted but those + * specified in . + * $DESCRIPTION$ + * The CHARONLY() function calculates the intersectional set of two + * strings. To do this, it deletes all characters from that + * do not appear in . + * $EXAMPLES$ + * ? CHARONLY("0123456789", "0211 - 38 99 77") // "0211389977" + * ? CHARONLY("0123456789", "0211/ 389 977") // "0211389977" + * $TESTS$ + * CHARONLY("0123456789", "0211 - 38 99 77") == "0211389977" + * CHARONLY("0123456789", "0211/ 389 977") == "0211389977" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARONLY() is compatible with CT3's CHARONLY(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charonly.c, library is ct3. + * $SEEALSO$ + * CHARREM() WORDONLY() WORDREM() + * $END$ + */ + +HB_FUNC (CHARONLY) +{ + + do_charonly (DO_CHARONLY_CHARONLY); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * WORDONLY() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Intersectional set of two strings based on double characters + * $SYNTAX$ + * WORDONLY (, ) -> cReducedString + * $ARGUMENTS$ + * specifies the double characters that must + * not be deleted in . + * is the string that should be processed + * $RETURNS$ + * A string with all double characters deleted + * but those specified in . + * $DESCRIPTION$ + * The WORDONLY() function calculates the intersectional set of two + * strings based on double characters. To do this, it deletes all double + * characters from that do not appear in . + * $EXAMPLES$ + * ? WORDONLY("AABBCCDD", "XXAAYYBBZZ") // "AABB" + * ? WORDONLY("AABBCCDD", "XAAYYYBBZZ") // "BB" + * $TESTS$ + * WORDONLY("AABBCCDD", "XXAAYYBBZZ") == "AABB" + * WORDONLY("AABBCCDD", "XAAYYYBBZZ") == "BB" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * WORDONLY() is compatible with CT3's WORDONLY(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charonly.c, library is ct3. + * $SEEALSO$ + * CHARONLY() CHARREM() WORDREM() + * $END$ + */ + +HB_FUNC (WORDONLY) +{ + + do_charonly (DO_CHARONLY_WORDONLY); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARREM() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Removes characters from a string + * $SYNTAX$ + * CHARREM (, ) -> cReducedString + * $ARGUMENTS$ + * specifies the characters that should + * be deleted in + * ) is the string that should be processed + * $RETURNS$ + * is a string where the characters specified + * in are deleted + * $DESCRIPTION$ + * The CHARREM() function deletes the characters specified in + * from . + * $EXAMPLES$ + * ? CHARREM(" ", " 1 2 ") // "12" + * ? CHARREM("3y", "xyz123") // "xz12" + * $TESTS$ + * CHARREM(" ", " 1 2 ") == "12" + * CHARREM("3y", "xyz123") == "xz12" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARREM() is compatible with CT3's CHARREM(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charonly.c, library is ct3. + * $SEEALSO$ + * CHARONLY() WORDONLY() WORDREM() + * $END$ + */ + +HB_FUNC (CHARREM) +{ + + do_charonly (DO_CHARONLY_CHARREM); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * WORDREM() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Removes characters from a string + * $SYNTAX$ + * WORDREM (, ) -> cReducedString + * $ARGUMENTS$ + * specifies the double characters that + * should be deleted in + * ) is the string that should be processed + * $RETURNS$ + * is a string where the double characters + * specified in + * are deleted + * $DESCRIPTION$ + * The WORDREM() function deletes the double characters specified in + * from . + * $EXAMPLES$ + * ? WORDREM("abcd", "0ab1cd") // "0ab1" + * ? WORDREM("abcd", "ab0cd1") // "0cd1" + * $TESTS$ + * WORDREM("abcd", "0ab1cd") == "0ab1" + * WORDREM("abcd", "ab0cd1") == "0cd1" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * WORDREM() is a new function available only in Harbour's CT3. + * $PLATFORMS$ + * All + * $FILES$ + * Source is charonly.c, library is ct3. + * $SEEALSO$ + * CHARONLY CHARREM() WORDREM() + * $END$ + */ + +HB_FUNC (WORDREM) +{ + + do_charonly (DO_CHARONLY_WORDREM); + return; + +} diff --git a/harbour/contrib/libct/charsort.c b/harbour/contrib/libct/charsort.c new file mode 100644 index 0000000000..26ea4ce513 --- /dev/null +++ b/harbour/contrib/libct/charsort.c @@ -0,0 +1,252 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CHARSORT() CT3 string functions + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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" + + +/* statics */ +static size_t ssCompareLen; /* TODO: make this thread safe */ +static size_t ssElementPos; /* TODO: make this thread safe */ +static int siDescend; /* TODO: make this thread safe */ + +/* qsort function */ +static int do_charsort (const void *p1, const void *p2) +{ + + char *pc1 = (char *)p1; + char *pc2 = (char *)p2; + int iCmp; + + pc1 += ssElementPos; + pc2 += ssElementPos; + + iCmp = strncmp (pc1, pc2, ssCompareLen); + iCmp *= (siDescend ? -1 : 1); + + return (iCmp); + +} + +/* $DOC$ + * $FUNCNAME$ + * CHARSORT() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Sort sequences within a string. + * $SYNTAX$ + * CHARSORT (<[@]cString>, [], [], + * [], [], [], + * []) -> cSortedString + * $ARGUMENTS$ + * <[@]cString> is the string that should be processed + * [] specifies the length of the elements that + * should be sorted + * Default: 1 + * [] specifies how many characters within one + * element should be used for comparison + * Default: + * [] specifies the number of characters at the + * beginning of that should be ignored + * in the sort process + * Default: 0 + * [] specifies the offset of the comparison string + * within a element + * Default: 0 + * [] specifies how many characters in , + * starting from the position, + * should be sorted + * Default: len(cString)-nIgnoreCharacters + * []) specifies whether the process should + * sort descending or not + * $RETURNS$ + * the string resulting from the sort process + * $DESCRIPTION$ + * The CHARSORT function sorts the characters within a string . + * With the parameters and , you can + * determine that only the substring from position +1 + * to position + within should + * be sorted. + * The sorting algorithm is determined with the other parameters. + * specifies the length of one element, i.e. there are + * / elements that are sorted. Note that + * surplus characters are not sorted but stay at their position. + * To do the sorting, the function uses the Quicksort algorithm implemented + * in the C-lib qsort() function. This algorithm needs to know how to compare + * and order two elements. This is done by comparing the ASCII values of + * a substring within each element. This substring is determined by the + * parameters and and the order + * by . + * By setting the CSETREF() switch to .T., one can omit the return value + * of the function, but one must then pass by reference. + * $EXAMPLES$ + * ? CHARSORT("qwert") // "eqrtw" + * ? CHARSORT("qwert", 2) // "erqwt" + * ? CHARSORT("b1a4a3a2a1", 2, 1) // "a2a1a3a4b1" + * ? CHARSORT("XXXqwert", 1, 1, 3) // "XXXeqrtw" + * ? CHARSORT("b1a4a3a2a1", 2, 1, 0, 1) // "a1b1a2a3a4" + * ? CHARSORT("384172852", 1, 1, 0, 0, 4) // "134872852" + * ? CHARSORT("qwert", .T.) // "wtrqe" + * $TESTS$ + * CHARSORT("qwert") == "eqrtw" + * CHARSORT("qwert", 2) == "erqwt" + * CHARSORT("b1a4a3a2a1", 2, 1) == "a2a1a3a4b1" + * CHARSORT("XXXqwert", 1, 1, 3) == "XXXeqrtw" + * CHARSORT("b1a4a3a2a1", 2, 1, 0, 1) == "a1b1a2a3a4" + * CHARSORT("384172852", 1, 1, 0, 0, 4) == "134872852" + * CHARSORT("qwert", .T.) == "wtrqe" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARSORT() is compatible with CT3's CHARSORT(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charsort.c, library is ct3. + * $SEEALSO$ + * CSETREF() + * $END$ + */ + +HB_FUNC (CHARSORT) +{ + + int iNoRet; + + /* suppressing return value ? */ + iNoRet = ct_getref(); + + /* param check I */ + if (ISCHAR (1)) + { + + /* get parameters */ + char *pcString = hb_parc (1); + char *pcRet; + size_t sStrLen = (size_t)hb_parclen (1); + size_t sElementLen, sIgnore, sSortLen; + + if (ISNUM (2)) + sElementLen = hb_parnl (2); + else + sElementLen = 1; + + if (ISNUM (3)) + ssCompareLen = hb_parnl (3); + else + ssCompareLen = sElementLen; + + if (ISNUM (4)) + sIgnore = hb_parnl (4); + else + sIgnore = 0; + + if (ISNUM (5)) + ssElementPos = hb_parnl (5); + else + ssElementPos = 0; + + if (ISNUM (6)) + sSortLen = hb_parnl (6); + else + sSortLen = sStrLen-sIgnore; + + if (ISLOG (7)) + siDescend = hb_parl (7); + else + siDescend = 0; + + /* param check II */ + if ((sElementLen == 0) || + (ssCompareLen > sElementLen) || + (sIgnore+sElementLen > sStrLen) || + ((ssElementPos+ssCompareLen) > sElementLen) || + (sSortLen+sIgnore > sStrLen)) + { + if (iNoRet) + hb_retl (0); + else + hb_retc (""); + return; + } + + pcRet = hb_xgrab (sStrLen); + hb_xmemcpy (pcRet, pcString, sStrLen); + + qsort (pcRet+sIgnore, (sSortLen/sElementLen), sElementLen, do_charsort); + + /* 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 (""); + } + +} + + diff --git a/harbour/contrib/libct/charswap.c b/harbour/contrib/libct/charswap.c new file mode 100644 index 0000000000..784eb755a9 --- /dev/null +++ b/harbour/contrib/libct/charswap.c @@ -0,0 +1,282 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 string functions + * - CHARSWAP() + * - WORDSWAP() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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" + + +/* defines */ +#define DO_CHARSWAP_CHARSWAP 0 +#define DO_CHARSWAP_WORDSWAP 1 +#define DO_CHARSWAP_WORDSWAP_CHARSWAP 2 + +/* helper function for the charswap and wordswap functions */ +static void do_charswap (int iSwitch) +{ + + int iNoRet; + + /* suppress 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; + size_t sRetIndex = 0; + int iShift, iMod; + char *pcSub, *pc; + + if (iSwitch == DO_CHARSWAP_WORDSWAP) + { + iShift = 4; + if (ISLOG (2) && hb_parl (2)) + { + iSwitch = DO_CHARSWAP_WORDSWAP_CHARSWAP; + } + } + else + { + iShift = 2; + } + + pcRet = hb_xgrab (sStrLen); + + for (pcSub = pcString; pcSub < pcString+sStrLen+1-iShift; pcSub += iShift) + { + switch (iSwitch) + { + case DO_CHARSWAP_WORDSWAP: + { + *(pcRet+sRetIndex) = *(pcSub+2); + sRetIndex++; + *(pcRet+sRetIndex) = *(pcSub+3); + sRetIndex++; + *(pcRet+sRetIndex) = *(pcSub); + sRetIndex++; + *(pcRet+sRetIndex) = *(pcSub+1); + sRetIndex++; + }; break; + + case DO_CHARSWAP_WORDSWAP_CHARSWAP: + { + *(pcRet+sRetIndex) = *(pcSub+3); + sRetIndex++; + *(pcRet+sRetIndex) = *(pcSub+2); + sRetIndex++; + }; /* no 'break' here !! */ + + case DO_CHARSWAP_CHARSWAP: + { + *(pcRet+sRetIndex) = *(pcSub+1); + sRetIndex++; + *(pcRet+sRetIndex) = *(pcSub); + sRetIndex++; + }; + } + } + + /* copy rest of string */ + if ((iSwitch == DO_CHARSWAP_WORDSWAP) || + (iSwitch == DO_CHARSWAP_WORDSWAP_CHARSWAP)) + { + iMod = sStrLen%4; + } + else + { + iMod = sStrLen%2; + } + + for (pcSub = pcString+sStrLen-iMod; pcSub < pcString+sStrLen; pcSub++) + { + *(pcRet+sRetIndex) = *pcSub; + sRetIndex++; + } + + /* return string */ + if (ISBYREF (1)) + { + hb_storclen (pcRet, sRetIndex, 1); + } + + if (iNoRet) + { + hb_retl (0); + } + else + { + hb_retclen (pcRet, sRetIndex); + } + + hb_xfree (pcRet); + + } + else /* if (ISCHAR (1)) */ + { + if (iNoRet) + { + hb_retl (0); + } + else + { + hb_retc (""); + } + } + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARSWAP() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Swap neighbouring characters in a string + * $SYNTAX$ + * CHARSWAP (<[@]cString>) -> cSwappedString + * $ARGUMENTS$ + * <[@]cString> is the string that should be processed + * $RETURNS$ + * a string where neighbour characters are swapped + * $DESCRIPTION$ + * The CHARSWAP() function loops through in steps of two + * characters and exchanges the characters from the odd and the even + * positions. + * By setting the CSETREF() switch to .T., one can omit the return value + * of this functin, but one must then pass by reference. + * $EXAMPLES$ + * ? CHARSWAP("0123456789") // "1032547698" + * ? CHARSWAP("ABCDEFGHIJK") // "BADCFEHGJIK" + * $TESTS$ + * CHARSWAP("0123456789") == "1032547698" + * CHARSWAP("ABCDEFGHIJK") == "BADCFEHGJIK" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARSWAP() is compatible with CT3's CHARSWAP(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charswap.c, library is ct3. + * $SEEALSO$ + * WORDSWAP() CSETREF() + * $END$ + */ + +HB_FUNC (CHARSWAP) +{ + + do_charswap (DO_CHARSWAP_CHARSWAP); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * WORDSWAP() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Swap neighbouring double characters in a string + * $SYNTAX$ + * WORDSWAP (<[@]cString> [, ]) -> cSwappedString + * $ARGUMENTS$ + * <[@]cString> is the string that should be processed + * [] specifies whether an additional swap should be + * done within the double characters + * Default: .F., no additional swap + * $RETURNS$ + * a string where neighbouring double characters are + * swapped + * $DESCRIPTION$ + * The WORDSWAP() function loops through in steps of four + * characters and exchanges the double characters from the first and + * second position with the one from the third and forth position. + * Additionally the function can perform a swap of the both char of + * each double character. + * By setting the CSETREF() switch to .T., one can omit the return value + * of this functin, but one must then pass by reference. + * $EXAMPLES$ + * ? WORDSWAP("1234567890") // "3412785690" + * ? WORDSWAP("1234567890", .t.) // "4321876590" + * $TESTS$ + * WORDSWAP("1234567890") == "3412785690" + * WORDSWAP("1234567890", .t.) == "4321876590" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * WORDSWAP() is compatible with CT3's WORDSWAP(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charswap.c, library is ct3. + * $SEEALSO$ + * CHARSWAP() CSETREF() + * $END$ + */ + +HB_FUNC (WORDSWAP) +{ + + do_charswap (DO_CHARSWAP_WORDSWAP); + return; + +} diff --git a/harbour/contrib/libct/ctchrmix.c b/harbour/contrib/libct/ctchrmix.c deleted file mode 100644 index 1f2a5f7e65..0000000000 --- a/harbour/contrib/libct/ctchrmix.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * CHARMIX() CA-Tools compatible function - * - * Copyright 1999 Victor Szakats - * 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 of the License, or - * (at your option) any later version, with one exception: - * - * The exception is that if you link the Harbour Runtime Library (HRL) - * and/or the Harbour Virtual Machine (HVM) 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 HRL - * and/or HVM code into it. - * - * 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 program; if not, write to the Free Software - * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit - * their web site at http://www.gnu.org/). - * - */ - -#include "hbapi.h" -#include "hbapiitm.h" - -/* NOTE: CA-Tools will hang if the second parameter is an empty string */ - -HB_FUNC( CHARMIX ) -{ - PHB_ITEM pStr1 = hb_param( 1, HB_IT_STRING ); - PHB_ITEM pStr2 = hb_param( 2, HB_IT_STRING ); - ULONG ulLen2; - - if( pStr1 && pStr2 && ( ulLen2 = hb_itemGetCLen( pStr2 ) ) > 0 ) - { - ULONG ulLen1 = hb_itemGetCLen( pStr1 ); - char * pszStr1 = hb_itemGetCPtr( pStr1 ); - char * pszStr2 = hb_itemGetCPtr( pStr2 ); - char * pszResult = ( char * ) hb_xgrab( 2 * ulLen1 ); - ULONG ulPos1 = 0; - ULONG ulPos2 = 0; - ULONG ulPosResult = 0; - - while( ulPos1 < ulLen1 ) - { - pszResult[ ulPosResult++ ] = pszStr1[ ulPos1++ ]; - pszResult[ ulPosResult++ ] = pszStr2[ ulPos2++ ]; - - if( ulPos2 == ulLen2 ) - ulPos2 = 0; - } - - hb_retclen( pszResult, 2 * ulLen1 ); - hb_xfree( pszResult ); - } - else - hb_retc( "" ); -} diff --git a/harbour/contrib/libct/ctflist.txt b/harbour/contrib/libct/ctflist.txt index 0f4e8c8d07..70dd6f4a6d 100644 --- a/harbour/contrib/libct/ctflist.txt +++ b/harbour/contrib/libct/ctflist.txt @@ -179,23 +179,23 @@ CHARMIX ;R; CHARNOLIST ;R; CHARNOT ;R; CHARODD ;R; -CHARONE ;N; -CHARONLY ;N; +CHARONE ;R; +CHARONLY ;R; CHAROR ;R; CHARPACK ;N; CHARRELA ;N; CHARRELREP ;N; -CHARREM ;N; +CHARREM ;R; CHARREPL ;R; CHARRLL ;R; !NEW! CHARRLR ;R; !NEW! CHARSHL ;R; !NEW! CHARSHR ;R; !NEW! CHARSLIST ;R; !NEW! -CHARSORT ;N; +CHARSORT ;R; CHARSPREAD ;N; CHARSUB ;R; !NEW! -CHARSWAP ;N; +CHARSWAP ;R; CHARUNPACK ;N; CHARXOR ;R; CHECKSUM ;R; @@ -249,10 +249,11 @@ TOKENNEXT ;N; TOKENSEP ;R; TOKENUPPER ;R; VALPOS ;R; -WORDONE ;N; -WORDONLY ;N; +WORDONE ;R; +WORDONLY ;R; +WORDREM ;R; !NEW! WORDREPL ;R; -WORDSWAP ;N; +WORDSWAP ;R; WORDTOCHAR ;N; ; ; diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index 7c9b50d162..64d1a0029d 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -99,12 +99,16 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\charevod.obj \ $(OBJ_DIR)\charlist.obj \ $(OBJ_DIR)\charmirr.obj \ + $(OBJ_DIR)\charmix.obj \ + $(OBJ_DIR)\charone.obj \ + $(OBJ_DIR)\charonly.obj \ $(OBJ_DIR)\charop.obj \ $(OBJ_DIR)\charrepl.obj \ + $(OBJ_DIR)\charsort.obj \ + $(OBJ_DIR)\charswap.obj \ $(OBJ_DIR)\ctset.obj \ $(OBJ_DIR)\ctstr.obj \ $(OBJ_DIR)\ctchksum.obj \ - $(OBJ_DIR)\ctchrmix.obj \ $(OBJ_DIR)\ctcolton.obj \ $(OBJ_DIR)\ctcrypt.obj \ $(OBJ_DIR)\ctposupp.obj \ @@ -166,6 +170,18 @@ $(OBJ_DIR)\charmirr.obj : $(TOOLS_DIR)\charmirr.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\charmix.obj : $(TOOLS_DIR)\charmix.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\charone.obj : $(TOOLS_DIR)\charone.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\charonly.obj : $(TOOLS_DIR)\charonly.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\charop.obj : $(TOOLS_DIR)\charop.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, @@ -174,6 +190,14 @@ $(OBJ_DIR)\charrepl.obj : $(TOOLS_DIR)\charrepl.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\charsort.obj : $(TOOLS_DIR)\charsort.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\charswap.obj : $(TOOLS_DIR)\charswap.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\ctset.obj : $(TOOLS_DIR)\ctset.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, @@ -186,10 +210,6 @@ $(OBJ_DIR)\ctchksum.obj : $(TOOLS_DIR)\ctchksum.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, -$(OBJ_DIR)\ctchrmix.obj : $(TOOLS_DIR)\ctchrmix.c - $(CC) $(CLIBFLAGS) -o$@ $** - tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, - $(OBJ_DIR)\ctcolton.obj : $(TOOLS_DIR)\ctcolton.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/contrib/libct/makefile.vc b/harbour/contrib/libct/makefile.vc index abe7d1a590..d1e249730d 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -119,12 +119,16 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\charevod.obj \ $(OBJ_DIR)\charlist.obj \ $(OBJ_DIR)\charmirr.obj \ + $(OBJ_DIR)\charmix.obj \ + $(OBJ_DIR)\charone.obj \ + $(OBJ_DIR)\charonly.obj \ $(OBJ_DIR)\charop.obj \ $(OBJ_DIR)\charrepl.obj \ + $(OBJ_DIR)\charsort.obj \ + $(OBJ_DIR)\charswap.obj \ $(OBJ_DIR)\ctset.obj \ $(OBJ_DIR)\ctstr.obj \ $(OBJ_DIR)\ctchksum.obj \ - $(OBJ_DIR)\ctchrmix.obj \ $(OBJ_DIR)\ctcolton.obj \ $(OBJ_DIR)\ctcrypt.obj \ $(OBJ_DIR)\ctposupp.obj \ @@ -151,12 +155,16 @@ CLEAN: -@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)\charmix.* del $(OBJ_DIR)\charmix.* + -@if exist $(OBJ_DIR)\charone.* del $(OBJ_DIR)\charone.* + -@if exist $(OBJ_DIR)\charonly.* del $(OBJ_DIR)\charonly.* -@if exist $(OBJ_DIR)\charop.* del $(OBJ_DIR)\charop.* -@if exist $(OBJ_DIR)\charrepl.* del $(OBJ_DIR)\charrepl.* + -@if exist $(OBJ_DIR)\charsort.* del $(OBJ_DIR)\charsort.* + -@if exist $(OBJ_DIR)\charswap.* del $(OBJ_DIR)\charswap.* -@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.* - -@if exist $(OBJ_DIR)\ctchrmix.* del $(OBJ_DIR)\ctchrmix.* -@if exist $(OBJ_DIR)\ctcolton.* del $(OBJ_DIR)\ctcolton.* -@if exist $(OBJ_DIR)\ctcrypt.* del $(OBJ_DIR)\ctcrypt.* -@if exist $(OBJ_DIR)\ctposupp.* del $(OBJ_DIR)\ctposupp.* diff --git a/harbour/contrib/libct/readme.txt b/harbour/contrib/libct/readme.txt index 4f1bd9fbfe..589d0fa8a0 100644 --- a/harbour/contrib/libct/readme.txt +++ b/harbour/contrib/libct/readme.txt @@ -12,6 +12,7 @@ Victor Szakats Changes and Enhancements over the original CA-T**ls 3 Library +Martin Vogel ============================================================= * ADDASCII() New 4th parameter to enable a carry over in the addition @@ -22,19 +23,19 @@ Changes and Enhancements over the original CA-T**ls 3 Library * ATTOKEN() New 4th parameter to specify a skip width equal to the TOKEN() function -+ CHARHIST generates a character histogram of a string ++ CHARHIST() generates a character histogram of a string -+ CHARRLL bitwise roll to the left operation on characters ++ CHARRLL() bitwise roll to the left operation on characters -+ CHARRLR bitwise roll to the right operation on characters ++ CHARRLR() bitwise roll to the right operation on characters -+ CHARSHL bitwise shift left operation on characters ++ CHARSHL() bitwise shift left operation on characters -+ CHARSHR bitwise shift right operation on characters ++ CHARSHR() bitwise shift right operation on characters -+ CHARSLIST generates a sorted character list of a string ++ CHARSLIST() generates a sorted character list of a string -+ CHARSUB subtracts corresponding ASCII values ++ CHARSUB() subtracts corresponding ASCII values * SETATLIKE() 2nd parameter can be passed by reference so that SETATLIKE can store the acutal wildcard character in it @@ -45,3 +46,8 @@ Changes and Enhancements over the original CA-T**ls 3 Library * TOKENLOWER() New 4th parameter * TOKENUPPER() New 4th parameter + ++ WORDREM() remove double characters from a string + + + diff --git a/harbour/contrib/libct/tests/Makefile b/harbour/contrib/libct/tests/Makefile index 664e188593..eed9dae23a 100644 --- a/harbour/contrib/libct/tests/Makefile +++ b/harbour/contrib/libct/tests/Makefile @@ -45,16 +45,22 @@ PRG_SOURCES=\ charhist.prg \ charlist.prg \ charmirr.prg \ + charmix.prg \ charnlst.prg \ charnot.prg \ charodd.prg \ + charone.prg \ + charonly.prg \ charor.prg \ + charrem.prg \ charrepl.prg \ charrll.prg \ charrlr.prg \ charshl.prg \ charshr.prg \ charslst.prg \ + charsort.prg \ + charswap.prg \ charsub.prg \ charxor.prg \ csetref.prg \ @@ -66,7 +72,11 @@ PRG_SOURCES=\ tokensep.prg \ tokenupp.prg \ valpos.prg \ + wordone.org \ + wordonly.prg \ wordrepl.prg \ + wordrem.prg \ + wordswap.prg \ PRG_HEADERS=\ diff --git a/harbour/contrib/libct/tests/charmix.prg b/harbour/contrib/libct/tests/charmix.prg new file mode 100644 index 0000000000..386e457220 --- /dev/null +++ b/harbour/contrib/libct/tests/charmix.prg @@ -0,0 +1,80 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARMIX() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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 CHARMIX()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charmix("ABC", "123") == "A1B2C3" ? --> "] + charmix("ABC", "123") + ["]) + qout ([ charmix("ABCDE", "12") == "A1B2C1D2E1" ? --> "] + charmix("ABCDE", "12") + ["]) + qout ([ charmix("AB", "12345") == "A1B2" ? --> "] + charmix("AB", "12345") + ["]) + qout ([ charmix("HELLO", " ") == "H E L L O " ? --> "] + charmix("HELLO", " ") + ["]) + qout ([ charmix("HELLO", "") == "HELLO" ? --> "] + charmix("HELLO", "") + ["]) + qout ("") + + qout ("End test of CHARMIX()") + qout ("") + +return + + + + diff --git a/harbour/contrib/libct/tests/charone.prg b/harbour/contrib/libct/tests/charone.prg new file mode 100644 index 0000000000..a948b6d5be --- /dev/null +++ b/harbour/contrib/libct/tests/charone.prg @@ -0,0 +1,80 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARONE() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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 CHARONE()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charone("112333a123") == "123a123"? --> "] + charone("112333a123") + ["]) + qout ([ charone("122333a123") == "123a123"? --> "] + charone("122333a123") + ["]) + qout ([ charone("A B CCCD") == "A B CD"? ---> "] + charone("A B CCCD") + ["]) + qout ([ charone(" ", "A B A B") == "A B A B"? --> "] + charone(" ", "A B A B") + ["]) + qout ([ charone("o", "122oooB12o") == "122oB12o"? -> "] + charone("o", "122oooB12o") + ["]) + qout ("") + + qout ("End test of CHARONE()") + qout ("") + +return + + + + diff --git a/harbour/contrib/libct/tests/charonly.prg b/harbour/contrib/libct/tests/charonly.prg new file mode 100644 index 0000000000..f5fca4d7d8 --- /dev/null +++ b/harbour/contrib/libct/tests/charonly.prg @@ -0,0 +1,78 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARONLY() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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 CHARONLY()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charonly("0123456789", "0211 - 38 99 77") == "0211389977" ? --> "] + charonly("0123456789", "0211 - 38 99 77")+ ["]) + qout ([ charonly("0123456789", "0211/ 389 977") == "0211389977" ? --> "] + charonly("0123456789", "0211/ 389 977") + ["]) + qout ("") + + qout ("End test of CHARONLY()") + qout ("") + +return + + + + + diff --git a/harbour/contrib/libct/tests/charrem.prg b/harbour/contrib/libct/tests/charrem.prg new file mode 100644 index 0000000000..32eac318ce --- /dev/null +++ b/harbour/contrib/libct/tests/charrem.prg @@ -0,0 +1,78 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARREM() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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 CHARREM()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charrem(" ", " 1 2 ") == "12" ? ---> "] + charrem(" ", " 1 2 ")+ ["]) + qout ([ charrem("3y", "xyz123") == "xz12" ? ---> "] + charrem("3y", "xyz123")+ ["]) + qout ("") + + qout ("End test of CHARREM()") + qout ("") + +return + + + + + diff --git a/harbour/contrib/libct/tests/charsort.prg b/harbour/contrib/libct/tests/charsort.prg new file mode 100644 index 0000000000..96f738da87 --- /dev/null +++ b/harbour/contrib/libct/tests/charsort.prg @@ -0,0 +1,85 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARSORT() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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 CHARSORT()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charsort("qwert") == "eqrtw" ? --> "] + charsort("qwert") + ["]) + qout ([ charsort("qwert", 2) == "erqwt" ? --> "] + charsort("qwert", 2) + ["]) + qout ([ charsort("b1a4a3a2a1", 2, 1) == "a2a1a3a4b1" ? --> "] + charsort("b1a4a3a2a1", 2, 1) + ["]) + qout ([ NOTE : The order of equal elements (here the one beginning with the same char) is NOT determined !]) + qout ([ charsort("XXXqwert", 1, 1, 3) == "XXXeqrtw" ? --> "] + charsort("XXXqwert", 1, 1, 3) + ["]) + qout ([ charsort("b1a4a3a2a1", 2, 1, 0, 1) == "a1b1a2a3a4" ? --> "] + charsort("b1a4a3a2a1", 2, 1, 0, 1) + ["]) + qout ([ NOTE : The order of equal elements (here the one ending with the same number) is NOT determined !]) + qout ([ charsort("384172852", 1, 1, 0, 0, 4) == "134872852" ? --> "] + charsort("384172852", 1, 1, 0, 0, 4)+ ["]) + qout ([ charsort("qwert",,,,,,.T.) == "wtrqe" ? --> "] + charsort("qwert",,,,,,.T.) + ["]) + qout ("") + + qout ("End test of CHARSORT()") + qout ("") + +return + + + + + diff --git a/harbour/contrib/libct/tests/charswap.prg b/harbour/contrib/libct/tests/charswap.prg new file mode 100644 index 0000000000..522158c04c --- /dev/null +++ b/harbour/contrib/libct/tests/charswap.prg @@ -0,0 +1,78 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARSWAP() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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 CHARSWAP()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charswap("0123456789") == "1032547698" ? --> "] + charswap("0123456789") + ["]) + qout ([ charswap("ABCDEFGHIJK") == "BADCFEHGJIK" ? --> "] + charswap("ABCDEFGHIJK")+ ["]) + qout ("") + + qout ("End test of CHARSWAP()") + qout ("") + +return + + + + + diff --git a/harbour/contrib/libct/tests/wordone.prg b/harbour/contrib/libct/tests/wordone.prg new file mode 100644 index 0000000000..301e3e43d4 --- /dev/null +++ b/harbour/contrib/libct/tests/wordone.prg @@ -0,0 +1,78 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function WORDONE() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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 WORDONE()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ wordone("12ABAB12") == "12AB12" ? --> "] + wordone("12ABAB12") + ["]) + qout ([ wordone("1AAAA2") == "1AAAA2" ? --> "] + wordone("1AAAA2") + ["]) + qout ([ wordone("12", "1212ABAB") == "12ABAB" ? --> "] + wordone("12", "1212ABAB") + ["]) + qout ("") + + qout ("End test of WORDONE()") + qout ("") + +return + + + + diff --git a/harbour/contrib/libct/tests/wordonly.prg b/harbour/contrib/libct/tests/wordonly.prg new file mode 100644 index 0000000000..8dc5a512c3 --- /dev/null +++ b/harbour/contrib/libct/tests/wordonly.prg @@ -0,0 +1,78 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function WORDONLY() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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 WORDONLY()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ wordonly("AABBCCDD", "XXAAYYBBZZ") == "AABB" ? --> "] + wordonly("AABBCCDD", "XXAAYYBBZZ")+ ["]) + qout ([ wordonly("AABBCCDD", "XAAYYYBBZZ") == "BB" ? ----> "] + wordonly("AABBCCDD", "XAAYYYBBZZ")+ ["]) + qout ("") + + qout ("End test of WORDONLY()") + qout ("") + +return + + + + + diff --git a/harbour/contrib/libct/tests/wordrem.prg b/harbour/contrib/libct/tests/wordrem.prg new file mode 100644 index 0000000000..1a976bcd21 --- /dev/null +++ b/harbour/contrib/libct/tests/wordrem.prg @@ -0,0 +1,79 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function WORDREM() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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 WORDREM()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ wordrem("abcd", "0ab1cd") == "0ab1" ? ----> "] + wordrem("abcd", "0ab1cd") + ["]) + qout ([ wordrem("abcd", "ab0cd1") == "0cd1" ? ----> "] + wordrem("abcd", "ab0cd1") + ["]) + qout ("") + + qout ("End test of WORDREM()") + qout ("") + +return + + + + + + diff --git a/harbour/contrib/libct/tests/wordswap.prg b/harbour/contrib/libct/tests/wordswap.prg new file mode 100644 index 0000000000..f49802a2f2 --- /dev/null +++ b/harbour/contrib/libct/tests/wordswap.prg @@ -0,0 +1,78 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function WORDSWAP() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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 WORDSWAP()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ wordswap("1234567890") == "3412785690" ? --> "] + wordswap("1234567890") + ["]) + qout ([ wordswap("1234567890", .t.) == "4321876590" ? --> "] + wordswap("1234567890", .t.)+ ["]) + qout ("") + + qout ("End test of WORDSWAP()") + qout ("") + +return + + + + +