From d0ebf10b1600eb7e12f07b39b05eb8486b7a3e66 Mon Sep 17 00:00:00 2001 From: Martin Vogel Date: Fri, 20 Apr 2001 14:35:41 +0000 Subject: [PATCH] *** empty log message *** --- harbour/ChangeLog | 45 ++ harbour/contrib/libct/Makefile | 1 + harbour/contrib/libct/charop.c | 866 ++++++++++++++++++++++++ harbour/contrib/libct/ctflist.txt | 13 +- harbour/contrib/libct/makefile.bc | 5 + harbour/contrib/libct/makefile.vc | 2 + harbour/contrib/libct/readme.txt | 9 + harbour/contrib/libct/tests/Makefile | 10 + harbour/contrib/libct/tests/charadd.prg | 78 +++ harbour/contrib/libct/tests/charand.prg | 76 +++ harbour/contrib/libct/tests/charnot.prg | 92 +++ harbour/contrib/libct/tests/charor.prg | 75 ++ harbour/contrib/libct/tests/charrll.prg | 91 +++ harbour/contrib/libct/tests/charrlr.prg | 88 +++ harbour/contrib/libct/tests/charshl.prg | 91 +++ harbour/contrib/libct/tests/charshr.prg | 92 +++ harbour/contrib/libct/tests/charsub.prg | 76 +++ harbour/contrib/libct/tests/charxor.prg | 76 +++ 18 files changed, 1782 insertions(+), 4 deletions(-) create mode 100644 harbour/contrib/libct/charop.c create mode 100644 harbour/contrib/libct/tests/charadd.prg create mode 100644 harbour/contrib/libct/tests/charand.prg create mode 100644 harbour/contrib/libct/tests/charnot.prg create mode 100644 harbour/contrib/libct/tests/charor.prg create mode 100644 harbour/contrib/libct/tests/charrll.prg create mode 100644 harbour/contrib/libct/tests/charrlr.prg create mode 100644 harbour/contrib/libct/tests/charshl.prg create mode 100644 harbour/contrib/libct/tests/charshr.prg create mode 100644 harbour/contrib/libct/tests/charsub.prg create mode 100644 harbour/contrib/libct/tests/charxor.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 65688a77df..7aeeb2bc8e 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,48 @@ +2001-04-20 16:30 CET Martin Vogel + + + contrib/libct/charop.c + + charadd(), charand(), charor(), charxor(), charnot() and + (NEW!) charsub(), charshl(), charshr(), charrll() and charrlr() functions + + * contrib/libct/Makefile + + added contrib/libct/charop.c + + * contrib/libct/makefile.bc + + added contrib/libct/charop.c + + * contrib/libct/makefile.vc + + added contrib/libct/charop.c + + * contrib/libct/ctflist.txt + * changed status of functions mentioned above + + * contrib/libct/readme.txt + + added comments for new functions + + + contrib/libct/tests/charadd.prg + + contrib/libct/tests/charand.prg + + contrib/libct/tests/charor.prg + + contrib/libct/tests/charnot.prg + + contrib/libct/tests/charxor.prg + + contrib/libct/tests/charsub.prg + + contrib/libct/tests/charshl.prg + + contrib/libct/tests/charshr.prg + + contrib/libct/tests/charrll.prg + + contrib/libct/tests/charrlr.prg + ! small test programs for new functions + + * contrib/libct/tests/Makefile + + added contrib/libct/tests/charadd.prg + + added contrib/libct/tests/charand.prg + + added contrib/libct/tests/charor.prg + + added contrib/libct/tests/charnot.prg + + added contrib/libct/tests/charxor.prg + + added contrib/libct/tests/charsub.prg + + added contrib/libct/tests/charshl.prg + + added contrib/libct/tests/charshr.prg + + added contrib/libct/tests/charrll.prg + + added contrib/libct/tests/charrlr.prg + 2001-04-20 15:04 GMT+2 Maurilio Longo * source/rtl/memoedit.prg * simplified handling of keys and prevented infinite recursion when a key not diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index 4acab09a9d..c33f4302f8 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -9,6 +9,7 @@ C_SOURCES=\ atadjust.c \ atnum.c \ charevod.c \ + charop.c \ ctset.c \ ctstr.c \ ctchksum.c \ diff --git a/harbour/contrib/libct/charop.c b/harbour/contrib/libct/charop.c new file mode 100644 index 0000000000..f2b9b12c26 --- /dev/null +++ b/harbour/contrib/libct/charop.c @@ -0,0 +1,866 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 string functions + * - CHARADD() + * - CHARSUB() (NEW) + * - CHARAND() + * - CHARNOT() + * - CHAROR() + * - CHARXOR() + * - CHARSHL() (NEW) + * - CHARSHR() (NEW) + * - CHARRLL() (NEW) + * - CHARRLR() (NEW) + * + * 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" + + +#define DO_CHAROP_CHARADD 0 +#define DO_CHAROP_CHARSUB 1 /* new: character subtraction */ +#define DO_CHAROP_CHARAND 2 +#define DO_CHAROP_CHARNOT 3 +#define DO_CHAROP_CHAROR 4 +#define DO_CHAROP_CHARXOR 5 +#define DO_CHAROP_CHARSHL 6 /* new: shift left */ +#define DO_CHAROP_CHARSHR 7 /* new: shift right */ +#define DO_CHAROP_CHARRLL 8 /* new: left rotation */ +#define DO_CHAROP_CHARRLR 9 /* new: right rotation */ + +/* helper function */ +static void do_charop (int iSwitch) +{ + + int iNoRet; + + /* suppressing return value ? */ + iNoRet = ct_getref(); + + if (ISCHAR (1)) + { + + size_t sStrLen = hb_parclen (1); + size_t sPos; + unsigned char *pucString = hb_parc (1); + unsigned char *pucResult = hb_xgrab (sStrLen); + + if (pucResult == NULL) + { + hb_ret(); + return; + } + + switch (iSwitch) + { + /* NOT */ + case DO_CHAROP_CHARNOT: + { + + for (sPos = 0; sPos < sStrLen; sPos++) + pucResult[sPos] = ~pucString[sPos]; + + }; break; + + /* SHL */ + case DO_CHAROP_CHARSHL: + { + + int iSHL = (hb_parni (2))%8; /* defaults to 0 */ + + if (iSHL == 0) + hb_xmemcpy (pucResult, pucString, sStrLen); + else + for (sPos = 0; sPos < sStrLen; sPos++) + pucResult[sPos] = pucString[sPos] << iSHL; + + }; break; + + /* SHR */ + case DO_CHAROP_CHARSHR: + { + + int iSHR = (hb_parni (2))%8; /* defaults to 0 */ + + if (iSHR == 0) + hb_xmemcpy (pucResult, pucString, sStrLen); + else + for (sPos = 0; sPos < sStrLen; sPos++) + pucResult[sPos] = pucString[sPos] >> iSHR; + + }; break; + + /* RLL */ + case DO_CHAROP_CHARRLL: + { + + int iRLL = (hb_parni (2))%8; /* defaults to 0 */ + + hb_xmemcpy (pucResult, pucString, sStrLen); + + if (iRLL != 0) + for (sPos = 0; sPos < sStrLen; sPos++) + { + int iRLLCnt; + + for (iRLLCnt = 0; iRLLCnt < iRLL; iRLLCnt++) + if (pucResult[sPos]&0x80) /* most left bit set -> roll over */ + { + pucResult[sPos] <<= 1; + pucResult[sPos] |= 0x01; + } + else + { + pucResult[sPos] <<= 1; + } + } + + }; break; + + /* RLR */ + case DO_CHAROP_CHARRLR: + { + + int iRLR = (hb_parni (2))%8; /* defaults to 0 */ + + hb_xmemcpy (pucResult, pucString, sStrLen); + + if (iRLR != 0) + for (sPos = 0; sPos < sStrLen; sPos++) + { + int iRLRCnt; + + for (iRLRCnt = 0; iRLRCnt < iRLR; iRLRCnt++) + if (pucResult[sPos]&0x01) /* most right bit set -> roll over */ + { + pucResult[sPos] >>= 1; + pucResult[sPos] |= 0x80; + } + else + { + pucResult[sPos] >>= 1; + } + } + + }; break; + + /* ADD */ + case DO_CHAROP_CHARADD: + { + if (ISCHAR (2)) + { + char *pucString2 = hb_parc (2); + size_t sStrLen2 = hb_parclen (2); + + for (sPos = 0; sPos < sStrLen; sPos++) + pucResult[sPos] = (char)(pucString[sPos]+pucString2[sPos%sStrLen2]); + + } + else + hb_xmemcpy (pucResult, pucString, sStrLen); + + }; break; + + /* SUB */ + case DO_CHAROP_CHARSUB: + { + if (ISCHAR (2)) + { + char *pucString2 = hb_parc (2); + size_t sStrLen2 = hb_parclen (2); + + for (sPos = 0; sPos < sStrLen; sPos++) + pucResult[sPos] = (char)(pucString[sPos]-pucString2[sPos%sStrLen2]); + + } + else + hb_xmemcpy (pucResult, pucString, sStrLen); + + }; break; + + /* AND */ + case DO_CHAROP_CHARAND: + { + if (ISCHAR (2)) + { + char *pucString2 = hb_parc (2); + size_t sStrLen2 = hb_parclen (2); + + for (sPos = 0; sPos < sStrLen; sPos++) + pucResult[sPos] = (char)(pucString[sPos] & pucString2[sPos%sStrLen2]); + + } + else + hb_xmemcpy (pucResult, pucString, sStrLen); + + }; break; + + /* OR */ + case DO_CHAROP_CHAROR: + { + if (ISCHAR (2)) + { + char *pucString2 = hb_parc (2); + size_t sStrLen2 = hb_parclen (2); + + for (sPos = 0; sPos < sStrLen; sPos++) + pucResult[sPos] = (char)(pucString[sPos] | pucString2[sPos%sStrLen2]); + + } + else + hb_xmemcpy (pucResult, pucString, sStrLen); + + }; break; + + /* XOR */ + case DO_CHAROP_CHARXOR: + { + if (ISCHAR (2)) + { + char *pucString2 = hb_parc (2); + size_t sStrLen2 = hb_parclen (2); + + for (sPos = 0; sPos < sStrLen; sPos++) + pucResult[sPos] = (char)(pucString[sPos] ^ pucString2[sPos%sStrLen2]); + + } + else + hb_xmemcpy (pucResult, pucString, sStrLen); + + }; break; + + }; /* endswitch (iSwitch) */ + + if (ISBYREF (1)) + hb_storclen (pucResult, sStrLen, 1); + + if (!iNoRet) + hb_retclen (pucResult, sStrLen); + + hb_xfree (pucResult); + + } + else /* if (ISCHAR (1)) */ + { + hb_ret(); + } + + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARADD() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Adds corresponding ASCII value of two strings + * $SYNTAX$ + * CHARADD (<[@]cString1>, ) --> cAddString + * $ARGUMENTS$ + * <[@]cString1> first string + * second string + * $RETURNS$ + * string with added ASCII values + * $DESCRIPTION$ + * The CHARADD() function constructs a new string from the two strings + * passed as parameters. To do this, it adds the ASCII values of the + * corresponding characters of both strings and places a character in + * the resulting string whose ASCII value equals to that sum (modulo 256). + * If the first string is passed by reference, the resulting string is + * stored in , too. By setting the CSETREF()-switch to .T., + * the return value can be omitted. + * If is shorter than and the last character of + * has been processed, the function restarts with the first + * character of . + * $EXAMPLES$ + * ? charadd ("012345678", chr(1)) --> "123456789" + * ? charadd ("123456789", chr(255)) --> "012345678" + * ? charadd ("0000", chr(0)+chr(1)+chr(2)+chr(3)) --> "0123" + * $TESTS$ + * charadd ("012345678", chr(1)) == "123456789" + * charadd ("012345678", chr(1)+chr(2)) == "133557799" + * charadd ("123456789", chr(255)) == "012345678" + * charadd ("123456789", chr(255)+chr(254)) == "002244668" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARADD() is compatible with CT3's CHARADD(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charop.c, library is ct3. + * $SEEALSO$ + * CHARSUB() CHARAND() CHARNOT() + * CHAROR() CHARXOR() CHARSHL() + * CHARSHR() CHARRLL() CHARRLR() + * CSETREF() + * $END$ + */ + +HB_FUNC (CHARADD) +{ + + do_charop (DO_CHAROP_CHARADD); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARSUB() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Subtracts corresponding ASCII value of two strings + * $SYNTAX$ + * CHARSUB (<[@]cString1>, ) --> cSubString + * $ARGUMENTS$ + * <[@]cString1> first string + * second string + * $RETURNS$ + * string with subtracted ASCII values + * $DESCRIPTION$ + * The CHARSUB() function constructs a new string from the two strings + * passed as parameters. To do this, it subtracts the ASCII values of the + * corresponding characters of both strings and places a character in + * the resulting string whose ASCII value equals to that difference (modulo 256). + * If the first string is passed by reference, the resulting string is + * stored in , too. By setting the CSETREF()-switch to .T., + * the return value can be omitted. + * If is shorter than and the last character of + * has been processed, the function restarts with the first + * character of . + * $EXAMPLES$ + * ? charsub ("012345678", chr(1)) --> "/01234567" + * ? charsub ("123456789", chr(255)) --> "23456789:" + * ? charsub ("9999", chr(0)+chr(1)+chr(2)+chr(3)) --> "9876" + * $TESTS$ + * charsub ("123456789", chr(1)) == "012345678" + * charsub ("123456789", chr(1)+chr(2)) == "002244668" + * charsub ("012345678", chr(255)) == "123456789" + * charsub ("012345678", chr(255)+chr(254)) == "133557799" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARSUB() is a new function that is only available in Harbour's CT3 lib. + * $PLATFORMS$ + * All + * $FILES$ + * Source is charop.c, library is ct3. + * $SEEALSO$ + * CHARADD() CHARAND() CHARNOT() + * CHAROR() CHARXOR() CHARSHL() + * CHARSHR() CHARRLL() CHARRLR() + * CSETREF() + * $END$ + */ + +HB_FUNC (CHARSUB) +{ + + do_charop (DO_CHAROP_CHARSUB); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARAND() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Combine corresponding ASCII value of two strings with bitwise AND + * $SYNTAX$ + * CHARAND (<[@]cString1>, ) --> cAndString + * $ARGUMENTS$ + * <[@]cString1> first string + * second string + * $RETURNS$ + * string with bitwise AND combined ASCII values + * $DESCRIPTION$ + * The CHARAND() function constructs a new string from the two strings + * passed as parameters. To do this, it combines the ASCII values of the + * corresponding characters of both strings with a bitwise AND-operation + * and places a character in the resulting string whose ASCII value + * equals to the result of that operation. + * If the first string is passed by reference, the resulting string is + * stored in , too. By setting the CSETREF()-switch to .T., + * the return value can be omitted. + * If is shorter than and the last character of + * has been processed, the function restarts with the first + * character of . + * $EXAMPLES$ + * // clear the LSB + * ? charand ("012345678", chr(254)) --> "002244668" + * ? charand ("012345678", chr(254)+chr(252)) --> "002044648" + * $TESTS$ + * charand ("012345678", chr(254)) == "002244668" + * charand ("012345678", chr(254)+chr(252)) == "002044648" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARAND() is compatible with CT3's CHARAND(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charop.c, library is ct3. + * $SEEALSO$ + * CHARADD() CHARSUB() CHARNOT() + * CHAROR() CHARXOR() CHARSHL() + * CHARSHR() CHARRLL() CHARRLR() + * CSETREF() + * $END$ + */ + +HB_FUNC (CHARAND) +{ + + do_charop (DO_CHAROP_CHARAND); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARNOT() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Process each character in a string with bitwise NOT operation + * $SYNTAX$ + * CHARNOT (<[@]cString>) --> cNotString + * $ARGUMENTS$ + * <[@]cString> string to be processed + * $RETURNS$ + * string with bitwise negated characters + * $DESCRIPTION$ + * The CHARNOT() function constructs a new string from the string + * passed as parameter. To do this, it performs a bitwise NOT operation + * to the characters of the string and places a character in + * the resulting string whose ASCII value equals to the result of that + * operation. It can be easily seen that the resulting ASCII-value equals + * 255 minus input ASCII value. + * If the string is passed by reference, the resulting string is + * stored in , too. By setting the CSETREF()-switch to .T., + * the return value can be omitted. + * $EXAMPLES$ + * ? charnot (chr(85)+chr(128)+chr(170)+chr(1)) --> chr(170)+chr(127)+chr(85)+chr(254) + * ? charnot (charnot ("This is a test!")) --> "This is a test!" + * $TESTS$ + * charnot (chr(85)+chr(128)+chr(170)+chr(1)) == chr(170)+chr(127)+chr(85)+chr(254) + * charnot (charnot ("This is a test!")) == "This is a test!" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARNOT() is compatible with CT3's CHARNOT(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charop.c, library is ct3. + * $SEEALSO$ + * CHARADD() CHARSUB() CHARAND() + * CHAROR() CHARXOR() CHARSHL() + * CHARSHR() CHARRLL() CHARRLR() + * CSETREF() + * $END$ + */ + +HB_FUNC (CHARNOT) +{ + + do_charop (DO_CHAROP_CHARNOT); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHAROR() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Combine corresponding ASCII value of two strings with bitwise OR + * $SYNTAX$ + * CHAROR (<[@]cString1>, ) --> cOrString + * $ARGUMENTS$ + * <[@]cString1> first string + * second string + * $RETURNS$ + * string with bitwise OR combined ASCII values + * $DESCRIPTION$ + * The CHAROR() function constructs a new string from the two strings + * passed as parameters. To do this, it combines the ASCII values of the + * corresponding characters of both strings with a bitwise OR-operation + * and places a character in the resulting string whose ASCII value + * equals to the result of that operation. + * If the first string is passed by reference, the resulting string is + * stored in , too. By setting the CSETREF()-switch to .T., + * the return value can be omitted. + * If is shorter than and the last character of + * has been processed, the function restarts with the first + * character of . + * $EXAMPLES$ + * // set the LSB + * ? charor ("012345678", chr(1)) --> "113355779" + * ? charor ("012345678", chr(1)+chr(3)) --> "133357779" + * $TESTS$ + * charor ("012345678", chr(1)) == "113355779" + * charor ("012345678", chr(1)+chr(3)) == "133357779" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHAROR() is compatible with CT3's CHAROR(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charop.c, library is ct3. + * $SEEALSO$ + * CHARADD() CHARSUB() CHARNOT() + * CHARAND() CHARXOR() CHARSHL() + * CHARSHR() CHARRLL() CHARRLR() + * CSETREF() + * $END$ + */ + +HB_FUNC (CHAROR) +{ + + do_charop (DO_CHAROP_CHAROR); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARXOR() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Combine corresponding ASCII value of two strings with bitwise XOR + * $SYNTAX$ + * CHARXOR (<[@]cString1>, ) --> cXOrString + * $ARGUMENTS$ + * <[@]cString1> first string + * second string + * $RETURNS$ + * string with bitwise XOR combined ASCII values + * $DESCRIPTION$ + * The CHARXOR() function constructs a new string from the two strings + * passed as parameters. To do this, it combines the ASCII values of the + * corresponding characters of both strings with a bitwise XOR-operation + * and places a character in the resulting string whose ASCII value + * equals to the result of that operation. + * If the first string is passed by reference, the resulting string is + * stored in , too. By setting the CSETREF()-switch to .T., + * the return value can be omitted. + * If is shorter than and the last character of + * has been processed, the function restarts with the first + * character of . + * $EXAMPLES$ + * // easy encryption + * ? charxor ("This is top secret !", "My Password") --> + * $TESTS$ + * charxor (charxor ("This is top secret !", "My Password"), "My Password") == "This is top secret !" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARXOR() is compatible with CT3's CHARXOR(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is charop.c, library is ct3. + * $SEEALSO$ + * CHARADD() CHARSUB() CHARNOT() + * CHARAND() CHAROR() CHARSHL() + * CHARSHR() CHARRLL() CHARRLR() + * CSETREF() + * $END$ + */ + +HB_FUNC (CHARXOR) +{ + + do_charop (DO_CHAROP_CHARXOR); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARSHL() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Process each character in a string with bitwise SHIFT LEFT operation + * $SYNTAX$ + * CHARSHL (<[@]cString>, ) --> cSHLString + * $ARGUMENTS$ + * <[@]cString> string to be processed + * number of bit positions to be shifted to the left + * $RETURNS$ + * string with bitwise shifted left characters + * $DESCRIPTION$ + * The CHARSHL() function constructs a new string from the string + * passed as parameter. To do this, it performs a bitwise SHIFT LEFT + * (SHL) operation to the characters of the string and places a character in + * the resulting string whose ASCII value equals to the result of that + * operation. + * Be aware that bits shifted out of the byte are lost. If you need + * a bit rotation, use the CHARRLL() function instead. + * If the string is passed by reference, the resulting string is + * stored in , too. By setting the CSETREF()-switch to .T., + * the return value can be omitted. + * $EXAMPLES$ + * ? charshl (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) + * --> chr(8)+chr(16)+chr(32)+chr(64)+chr(128)+chr(0)+chr(0)+chr(0) + * $TESTS$ + * charshl (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) == chr(8)+chr(16)+chr(32)+chr(64)+chr(128)+chr(0)+chr(0)+chr(0) + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARSHL() is a new function that is only available in Harbour's CT3 lib. + * $PLATFORMS$ + * All + * $FILES$ + * Source is charop.c, library is ct3. + * $SEEALSO$ + * CHARADD() CHARSUB() CHARAND() + * CHAROR() CHARXOR() CHARNOT() + * CHARSHR() CHARRLL() CHARRLR() + * CSETREF() + * $END$ + */ + +HB_FUNC (CHARSHL) +{ + + do_charop (DO_CHAROP_CHARSHL); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARSHR() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Process each character in a string with bitwise SHIFT RIGHT operation + * $SYNTAX$ + * CHARSHR (<[@]cString>, ) --> cSHRString + * $ARGUMENTS$ + * <[@]cString> string to be processed + * number of bit positions to be shifted to the right + * $RETURNS$ + * string with bitwise shifted right characters + * $DESCRIPTION$ + * The CHARSHR() function constructs a new string from the string + * passed as parameter. To do this, it performs a bitwise SHIFT RIGHT + * (SHR) operation to the characters of the string and places a character in + * the resulting string whose ASCII value equals to the result of that + * operation. + * Be aware that bits shifted out of the byte are lost. If you need + * a bit rotation, use the CHARRLR() function instead. + * If the string is passed by reference, the resulting string is + * stored in , too. By setting the CSETREF()-switch to .T., + * the return value can be omitted. + * $EXAMPLES$ + * ? charshr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) + * --> chr(0)+chr(0)+chr(0)+chr(1)+chr(2)+chr(4)+chr(8)+chr(16) + * $TESTS$ + * charshr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) == chr(0)+chr(0)+chr(0)+chr(1)+chr(2)+chr(4)+chr(8)+chr(16) + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARSHR() is a new function that is only available in Harbour's CT3 lib. + * $PLATFORMS$ + * All + * $FILES$ + * Source is charop.c, library is ct3. + * $SEEALSO$ + * CHARADD() CHARSUB() CHARAND() + * CHAROR() CHARXOR() CHARNOT() + * CHARSHL() CHARRLL() CHARRLR() + * CSETREF() + * $END$ + */ + +HB_FUNC (CHARSHR) +{ + + do_charop (DO_CHAROP_CHARSHR); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARRLL() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Process each character in a string with bitwise ROLL LEFT operation + * $SYNTAX$ + * CHARRLL (<[@]cString>, ) --> cRLLString + * $ARGUMENTS$ + * <[@]cString> string to be processed + * number of bit positions to be rolled to the left + * $RETURNS$ + * string with bitwise rolled left characters + * $DESCRIPTION$ + * The CHARRLL() function constructs a new string from the string + * passed as parameter. To do this, it performs a bitwise ROLL LEFT + * (RLL) operation to the characters of the string and places a character in + * the resulting string whose ASCII value equals to the result of that + * operation. + * Be aware that, in contrast to CHARSHL(), bits rolled out on + * the left are put in again on the right. + * If the string is passed by reference, the resulting string is + * stored in , too. By setting the CSETREF()-switch to .T., + * the return value can be omitted. + * $EXAMPLES$ + * ? charrll (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) + * --> chr(8)+chr(16)+chr(32)+chr(64)+chr(128)+chr(1)+chr(2)+chr(4) + * $TESTS$ + * charrll (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) == chr(8)+chr(16)+chr(32)+chr(64)+chr(128)+chr(1)+chr(2)+chr(4) + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARRLL() is a new function that is only available in Harbour's CT3 lib. + * $PLATFORMS$ + * All + * $FILES$ + * Source is charop.c, library is ct3. + * $SEEALSO$ + * CHARADD() CHARSUB() CHARAND() + * CHAROR() CHARXOR() CHARNOT() + * CHARSHL() CHARSHR() CHARRLR() + * CSETREF() + * $END$ + */ + +HB_FUNC (CHARRLL) +{ + + do_charop (DO_CHAROP_CHARRLL); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * CHARRLR() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Process each character in a string with bitwise ROLL RIGHT operation + * $SYNTAX$ + * CHARRLR (<[@]cString>, ) --> cRLRString + * $ARGUMENTS$ + * <[@]cString> string to be processed + * number of bit positions to be rolled to the right + * $RETURNS$ + * string with bitwise rolled right characters + * $DESCRIPTION$ + * The CHARRLR() function constructs a new string from the string + * passed as parameter. To do this, it performs a bitwise ROLL RIGHT + * (RLR) operation to the characters of the string and places a character in + * the resulting string whose ASCII value equals to the result of that + * operation. + * Be aware that, in contrast to CHARSHR(), bits rolled out on + * the right are put in again on the left. + * If the string is passed by reference, the resulting string is + * stored in , too. By setting the CSETREF()-switch to .T., + * the return value can be omitted. + * $EXAMPLES$ + * ? charrlr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) + * --> chr(32)+chr(64)+chr(128)+chr(1)+chr(2)+chr(4)+chr(8)+chr(16) + * $TESTS$ + * charrlr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) == chr(32)+chr(64)+chr(128)+chr(1)+chr(2)+chr(4)+chr(8)+chr(16) + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CHARRLR() is a new function that is only available in Harbour's CT3 lib. + * $PLATFORMS$ + * All + * $FILES$ + * Source is charop.c, library is ct3. + * $SEEALSO$ + * CHARADD() CHARSUB() CHARAND() + * CHAROR() CHARXOR() CHARNOT() + * CHARSHL() CHARSHR() CHARRLL() + * CSETREF() + * $END$ + */ + +HB_FUNC (CHARRLR) +{ + + do_charop (DO_CHAROP_CHARRLR); + return; + +} + + + diff --git a/harbour/contrib/libct/ctflist.txt b/harbour/contrib/libct/ctflist.txt index 27b775d7c7..30d870be34 100644 --- a/harbour/contrib/libct/ctflist.txt +++ b/harbour/contrib/libct/ctflist.txt @@ -169,8 +169,8 @@ ATREPL ;N; ATTOKEN ;N; BEFORATNUM ;R; CENTER ;R; -CHARADD ;N; -CHARAND ;N; +CHARADD ;R; +CHARAND ;R; CHAREVEN ;R; CHARLIST ;N; CHARMIRR ;N; @@ -180,17 +180,22 @@ CHARNOT ;N; CHARODD ;R; CHARONE ;N; CHARONLY ;N; -CHAROR ;N; +CHAROR ;R; CHARPACK ;N; CHARRELA ;N; CHARRELREP ;N; CHARREM ;N; CHARREPL ;N; +CHARRLL ;R; !NEW! +CHARRLR ;R; !NEW! +CHARSHL ;R; !NEW! +CHARSHR ;R; !NEW! CHARSORT ;N; CHARSPREAD ;N; +CHARSUB ;R; !NEW! CHARSWAP ;N; CHARUNPACK ;N; -CHARXOR ;N; +CHARXOR ;R; CHECKSUM ;R; COUNTLEFT ;N; COUNTRIGHT ;N; diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index 7f2268accc..239ebee4eb 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -94,6 +94,7 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\atadjust.obj \ $(OBJ_DIR)\atnum.obj \ $(OBJ_DIR)\charevod.obj \ + $(OBJ_DIR)\charop.obj \ $(OBJ_DIR)\ctset.obj \ $(OBJ_DIR)\ctstr.obj \ $(OBJ_DIR)\ctchksum.obj \ @@ -138,6 +139,10 @@ $(OBJ_DIR)\charevod.obj : $(TOOLS_DIR)\charevod.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)\ctset.obj : $(TOOLS_DIR)\ctset.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/contrib/libct/makefile.vc b/harbour/contrib/libct/makefile.vc index fd768e0c5c..9d5ba916bf 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -114,6 +114,7 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\atadjust.obj \ $(OBJ_DIR)\atnum.obj \ $(OBJ_DIR)\charevod.obj \ + $(OBJ_DIR)\charop.obj \ $(OBJ_DIR)\ctset.obj \ $(OBJ_DIR)\ctstr.obj \ $(OBJ_DIR)\ctchksum.obj \ @@ -138,6 +139,7 @@ CLEAN: -@if exist $(OBJ_DIR)\atadjust.* del $(OBJ_DIR)\atadjust.* -@if exist $(OBJ_DIR)\atnum.* del $(OBJ_DIR)\atnum.* -@if exist $(OBJ_DIR)\charevod.* del $(OBJ_DIR)\charevod.* + -@if exist $(OBJ_DIR)\charop.* del $(OBJ_DIR)\charop.* -@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.* diff --git a/harbour/contrib/libct/readme.txt b/harbour/contrib/libct/readme.txt index 766f6396ef..9f2cae7fd0 100644 --- a/harbour/contrib/libct/readme.txt +++ b/harbour/contrib/libct/readme.txt @@ -20,4 +20,13 @@ Changes and Enhancements over the original CA-T**ls 3 Library * SETATLIKE() 2nd parameter can be passed by reference so that SETATLIKE can store the acutal wildcard character in it ++ CHARSUB subtracts corresponding ASCII values + ++ CHARSHL bitwise shift left operation on characters + ++ CHARSHR bitwise shift right operation on characters + ++ CHARRLL bitwise roll to the left operation on characters + ++ CHARRLR bitwise roll to the right operation on characters diff --git a/harbour/contrib/libct/tests/Makefile b/harbour/contrib/libct/tests/Makefile index 59ecadbcde..e1e786613a 100644 --- a/harbour/contrib/libct/tests/Makefile +++ b/harbour/contrib/libct/tests/Makefile @@ -35,8 +35,18 @@ PRG_SOURCES=\ atadjust.prg \ atnum.prg \ beforatn.prg \ + charadd.prg \ + charand.prg \ chareven.prg \ + charnot.prg \ charodd.prg \ + charor.prg \ + charrll.prg \ + charrlr.prg \ + charshl.prg \ + charshr.prg \ + charsub.prg \ + charxor.prg \ csetref.prg \ csetatmu.prg \ setatlik.prg \ diff --git a/harbour/contrib/libct/tests/charadd.prg b/harbour/contrib/libct/tests/charadd.prg new file mode 100644 index 0000000000..878c7c8c17 --- /dev/null +++ b/harbour/contrib/libct/tests/charadd.prg @@ -0,0 +1,78 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARADD() + * + * 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 CHARADD()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charadd ("012345678", chr(1)) == "123456789" ? -> "] + charadd ("012345678", chr(1)) + ["]) + qout ([ charadd ("012345678", chr(1)+chr(2)) == "133557799" ? -> "] + charadd ("012345678", chr(1)+chr(2)) + ["]) + qout ([ charadd ("123456789", chr(255)) == "012345678" ? -> "] + charadd ("123456789", chr(255)) + ["]) + qout ([ charadd ("123456789", chr(255)+chr(254)) == "002244668" ? -> "] + charadd ("123456789", chr(255)+chr(254)) + ["]) + + qout ("End test of CHARADD()") + qout ("") + +return + + + + diff --git a/harbour/contrib/libct/tests/charand.prg b/harbour/contrib/libct/tests/charand.prg new file mode 100644 index 0000000000..6da766150a --- /dev/null +++ b/harbour/contrib/libct/tests/charand.prg @@ -0,0 +1,76 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARAND() + * + * 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 CHARAND()") + qout ("") + + // simple tests + qout ("Simple tests:") + + qout ([ charand ("012345678", chr(254)) == "002244668" ? --> "] + charand ("012345678", chr(254)) + ["]) + qout ([ charand ("012345678", chr(254)+chr(252)) == "002044648" ? --> "] + charand ("012345678", chr(254)+chr(252)) + ["]) + + qout ("End test of CHARAND()") + qout ("") + +return + + + diff --git a/harbour/contrib/libct/tests/charnot.prg b/harbour/contrib/libct/tests/charnot.prg new file mode 100644 index 0000000000..6a4f02a628 --- /dev/null +++ b/harbour/contrib/libct/tests/charnot.prg @@ -0,0 +1,92 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARNOT + * + * 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 + +local ni, cStr + + qout ("Begin test of CHARNOT()") + qout ("") + + // simple tests + qout ("Simple tests:") + + qout ([ charnot (chr(85)+chr(128)+chr(170)+chr(1)) == ]) + qout ([ chr(170)+chr(127)+chr(85)+chr(254) ? -->]) + + qout ([ ]) + cStr := charnot (chr(85)+chr(128)+chr(170)+chr(1)) + for ni := 1 to len (cStr) + qqout ("chr("+alltrim(str(asc(substr(cStr, ni, 1))))+")") + if ni < len(cStr) + qqout ("+") + endif + next ni + qout ("") + + qout ([ charnot (charnot ("This is a test!")) == "This is a test!" ?]) + qout ([ --> "]+ charnot (charnot ("This is a test!"))+["]) + qout ("") + + qout ("End test of CHARNOT()") + qout ("") + +return + + + diff --git a/harbour/contrib/libct/tests/charor.prg b/harbour/contrib/libct/tests/charor.prg new file mode 100644 index 0000000000..b9cbdc2994 --- /dev/null +++ b/harbour/contrib/libct/tests/charor.prg @@ -0,0 +1,75 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHAROR() + * + * 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 CHAROR()") + qout ("") + + // simple tests + qout ("Simple tests:") + + qout ([ charor ("012345678", chr(1)) == "113355779" ? --> "] + charor ("012345678", chr(1)) + ["]) + qout ([ charor ("012345678", chr(1)+chr(3)) == "133357779" ? --> "] + charor ("012345678", chr(1)+chr(3)) + ["]) + + qout ("End test of CHAROR()") + qout ("") + +return + + diff --git a/harbour/contrib/libct/tests/charrll.prg b/harbour/contrib/libct/tests/charrll.prg new file mode 100644 index 0000000000..043634b8eb --- /dev/null +++ b/harbour/contrib/libct/tests/charrll.prg @@ -0,0 +1,91 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARRLL() + * + * 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 + +local ni, cStr + + qout ("Begin test of CHARRLL()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charrll (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+]) + qout ([ chr(64)+chr(128), 3) == ]) + qout ([ chr(8)+chr(16)+chr(32)+chr(64)+chr(128)+chr(1)+chr(2)+chr(4) ? -->]) + + qout ([ ]) + cStr := charrll (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) + for ni := 1 to len (cStr) + qqout ("chr("+alltrim(str(asc(substr(cStr, ni, 1))))+")") + if ni < len(cStr) + qqout ("+") + endif + next ni + qout ("") + + qout ("End test of CHARRLL()") + qout ("") + +return + + + + + + diff --git a/harbour/contrib/libct/tests/charrlr.prg b/harbour/contrib/libct/tests/charrlr.prg new file mode 100644 index 0000000000..9d4c91a5bb --- /dev/null +++ b/harbour/contrib/libct/tests/charrlr.prg @@ -0,0 +1,88 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARRLR() + * + * 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 + +local ni, cStr + + qout ("Begin test of CHARRLR()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charrlr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+]) + qout ([ chr(64)+chr(128), 3) == ]) + qout ([ chr(32)+chr(64)+chr(128)+chr(1)+chr(2)+chr(4)+chr(8)+chr(16) ? -->]) + + qout ([ ]) + cStr := charrlr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) + for ni := 1 to len (cStr) + qqout ("chr("+alltrim(str(asc(substr(cStr, ni, 1))))+")") + if ni < len(cStr) + qqout ("+") + endif + next ni + qout ("") + + qout ("End test of CHARRLR()") + qout ("") + +return + + + diff --git a/harbour/contrib/libct/tests/charshl.prg b/harbour/contrib/libct/tests/charshl.prg new file mode 100644 index 0000000000..8ffc99a43e --- /dev/null +++ b/harbour/contrib/libct/tests/charshl.prg @@ -0,0 +1,91 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARSHL() + * + * 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 + +local ni, cStr + + qout ("Begin test of CHARSHL()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charshl (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+]) + qout ([ chr(64)+chr(128), 3) == ]) + qout ([ chr(8)+chr(16)+chr(32)+chr(64)+chr(128)+chr(0)+chr(0)+chr(0) ? -->]) + + qout ([ ]) + cStr := charshl (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) + for ni := 1 to len (cStr) + qqout ("chr("+alltrim(str(asc(substr(cStr, ni, 1))))+")") + if ni < len(cStr) + qqout ("+") + endif + next ni + qout ("") + + qout ("End test of CHARSHL()") + qout ("") + +return + + + + + + diff --git a/harbour/contrib/libct/tests/charshr.prg b/harbour/contrib/libct/tests/charshr.prg new file mode 100644 index 0000000000..2cf14771b0 --- /dev/null +++ b/harbour/contrib/libct/tests/charshr.prg @@ -0,0 +1,92 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARSHR() + * + * 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 + +local ni, cStr + + qout ("Begin test of CHARSHR()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charshr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+]) + qout ([ chr(64)+chr(128), 3) == ]) + qout ([ chr(0)+chr(0)+chr(0)+chr(1)+chr(2)+chr(4)+chr(8)+chr(16) ? -->]) + + qout ([ ]) + cStr := charshr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3) + for ni := 1 to len (cStr) + qqout ("chr("+alltrim(str(asc(substr(cStr, ni, 1))))+")") + if ni < len(cStr) + qqout ("+") + endif + next ni + qout ("") + + qout ("End test of CHARSHR()") + qout ("") + +return + + + + + + + diff --git a/harbour/contrib/libct/tests/charsub.prg b/harbour/contrib/libct/tests/charsub.prg new file mode 100644 index 0000000000..87cdcd3835 --- /dev/null +++ b/harbour/contrib/libct/tests/charsub.prg @@ -0,0 +1,76 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARSUB() + * + * 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 CHARSUB()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charadd ("123456789", chr(1)) == "012345678" ? -> "] + charsub ("123456789", chr(1)) + ["]) + qout ([ charadd ("123456789", chr(1)+chr(2)) == "002244668" ? -> "] + charsub ("123456789", chr(1)+chr(2)) + ["]) + qout ([ charadd ("012345678", chr(255)) == "123456789" ? -> "] + charsub ("012345678", chr(255)) + ["]) + qout ([ charadd ("012345678", chr(255)+chr(254)) == "133557799" ? -> "] + charsub ("012345678", chr(255)+chr(254)) + ["]) + + qout ("End test of CHARSUB()") + qout ("") + +return + + diff --git a/harbour/contrib/libct/tests/charxor.prg b/harbour/contrib/libct/tests/charxor.prg new file mode 100644 index 0000000000..d3561a7251 --- /dev/null +++ b/harbour/contrib/libct/tests/charxor.prg @@ -0,0 +1,76 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CHARXOR() + * + * 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 CHARXOR()") + qout ("") + + // simple tests + qout ("Simple tests:") + qout ([ charxor (charxor ("This is top secret !", "My Password"),]) + qout ([ "My Password") == "This is top secret !" ? ->]) + qout ([ ]+charxor (charxor ("This is top secret !", "My Password"),"My Password")) + + qout ("End test of CHARXOR()") + qout ("") + +return + + +