From e7d9b9aff43eb9cfa496fe1a3dd71fbb39ce04ef Mon Sep 17 00:00:00 2001 From: Martin Vogel Date: Tue, 17 Apr 2001 20:12:01 +0000 Subject: [PATCH] ---------------------------------------------------------------------- --- harbour/ChangeLog | 28 ++ harbour/contrib/libct/Makefile | 1 + harbour/contrib/libct/atnum.c | 488 +++++++++++++++++++++++ harbour/contrib/libct/ct.ch | 4 +- harbour/contrib/libct/makefile.bc | 4 + harbour/contrib/libct/makefile.vc | 2 + harbour/contrib/libct/tests/Makefile | 5 +- harbour/contrib/libct/tests/afteratn.prg | 110 +++++ harbour/contrib/libct/tests/atnum.prg | 110 +++++ harbour/contrib/libct/tests/beforatn.prg | 110 +++++ 10 files changed, 859 insertions(+), 3 deletions(-) create mode 100644 harbour/contrib/libct/atnum.c create mode 100644 harbour/contrib/libct/tests/afteratn.prg create mode 100644 harbour/contrib/libct/tests/atnum.prg create mode 100644 harbour/contrib/libct/tests/beforatn.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index fed0442165..9aff2043cd 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,31 @@ +2001-04-17 21:30 CET Martin Vogel + + contrib/libct/atnum.c + + AFTERATNUM() function + + BEFORATNUM() function + + ATNUM() function + + * contrib/libct/Makefile + * changed library name to libct + + added atnum.c + * contrib/libct/makefile.bc + * changed library name to libct + + added atnum.c + * contrib/libct/makefile.vc + * changed library name to libct + + added atnum.c + + + contrib/libct/tests/afteratn.prg + + contrib/libct/tests/atnum.prg + + contrib/libct/tests/beforatn.prg + + * contrib/libct/tests/Makefile + + added afteratn.prg + + added atnum.prg + + added beforatn.prg + + * contrib/libct/ct.ch + * error correction + 2001-04-17 10:35 UTC-0800 Ron Pinkas * source/vm/arrays.c ! Fixed GPF when aCloning an Array with circular refrences to itself. diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index 76578ad9db..87a0eff63a 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -6,6 +6,7 @@ ROOT = ../../ C_SOURCES=\ addascii.c \ + atnum.c \ ctset.c \ ctstr.c \ ctchksum.c \ diff --git a/harbour/contrib/libct/atnum.c b/harbour/contrib/libct/atnum.c new file mode 100644 index 0000000000..124da19fbc --- /dev/null +++ b/harbour/contrib/libct/atnum.c @@ -0,0 +1,488 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 string functions + * + * - AFTERATNUM() + * - BEFORATNUM() + * - ATNUM() + * + * 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_ATNUM_AFTERATNUM 0 +#define DO_ATNUM_BEFORATNUM 1 +#define DO_ATNUM_ATNUM 2 + + +/* helper function */ +static void do_atnum (int iSwitch) +{ + + if ((ISCHAR (1)) && (ISCHAR (2))) + { + + char *pcStringToMatch = hb_parc (1); + size_t sStrToMatchLen = (size_t)hb_parclen (1); + char *pcString = hb_parc (2); + size_t sStrLen = (size_t)hb_parclen (2); + int iMultiPass = ct_getatmupa(); + int iAtLike = ct_getatlike(); + char cAtLike = ct_getatlikechar(); + size_t sIgnore, sMatchStrLen; + ULONG ulCounter; + char *pc; + + /* eventually ignore some characters */ + if (ISNUM (4)) + sIgnore = (size_t)hb_parnl (4); + else + sIgnore = 0; + + if (sIgnore >= sStrLen) + { + switch (iSwitch) + { + case DO_ATNUM_AFTERATNUM: + case DO_ATNUM_BEFORATNUM: + { + /* AFTERATNUM */ + /* BEFORATNUM */ + hb_retc (""); + }; break; + + case DO_ATNUM_ATNUM: + { + /* ATNUM */ + hb_retnl (0); + }; break; + } + + return; + } + else + { + pcString += sIgnore; + sStrLen -= sIgnore; + } + + /* nth match or last match ? */ + if (ISNUM (3) && ((ulCounter = hb_parnl (3)) != 0)) + { + + /* find the th match */ + char *pcSubStr; + size_t sSubStrLen; + ULONG ulMatchCounter = 0; + + pcSubStr = pcString; + sSubStrLen = sStrLen; + + while (ulMatchCounter < ulCounter) + { + switch (iAtLike) + { + case CT_SETATLIKE_EXACT: + { + pc = ct_at_exact_forward (pcSubStr, sSubStrLen, + pcStringToMatch, sStrToMatchLen, + &sMatchStrLen); + }; break; + + case CT_SETATLIKE_WILDCARD: + { + pc = ct_at_wildcard_forward (pcSubStr, sSubStrLen, + pcStringToMatch, sStrToMatchLen, + cAtLike, &sMatchStrLen); + }; break; + + default: + { + pc = NULL; + }; + } + + if (pc == NULL) + { + /* no match found; if this happens at this point, + there are no matches, so return an empty string */ + switch (iSwitch) + { + case DO_ATNUM_AFTERATNUM: + case DO_ATNUM_BEFORATNUM: + { + /* AFTERATNUM */ + /* BEFORATNUM */ + hb_retc (""); + }; break; + + case DO_ATNUM_ATNUM: + { + /* ATNUM */ + hb_retnl (0); + }; break; + } + + return; + } + + ulMatchCounter++; + + if (iMultiPass) + pcSubStr = pc+1; + else + pcSubStr = pc+sMatchStrLen; + sSubStrLen = sStrLen-(pcSubStr-pcString); + } + + } + else /* (ISNUM (3) && ((ulCounter = hb_parnl (3)) != 0) */ + { + + /* we have to find the last match and return the + string after that last match */ + + switch (iAtLike) + { + case CT_SETATLIKE_EXACT: + { + pc = ct_at_exact_backward (pcString, sStrLen, + pcStringToMatch, sStrToMatchLen, + &sMatchStrLen); + }; break; + + case CT_SETATLIKE_WILDCARD: + { + pc = ct_at_wildcard_backward (pcString, sStrLen, + pcStringToMatch, sStrToMatchLen, + cAtLike, &sMatchStrLen); + }; break; + + default: + { + pc = NULL; + }; + } + + if (pc == NULL) + { + /* no matches found */ + switch (iSwitch) + { + case DO_ATNUM_AFTERATNUM: + case DO_ATNUM_BEFORATNUM: + { + /* AFTERATNUM */ + /* BEFORATNUM */ + hb_retc (""); + }; break; + + case DO_ATNUM_ATNUM: + { + /* ATNUM */ + hb_retnl (0); + }; break; + } + + return; + } + + } + + switch (iSwitch) + { + case DO_ATNUM_AFTERATNUM: + { + /* AFTERATNUM */ + if (pc+sMatchStrLen >= pcString+sStrLen) + hb_retc (""); + else + hb_retclen (pc+sMatchStrLen, sStrLen-(pc+sMatchStrLen-pcString)); + }; break; + + case DO_ATNUM_BEFORATNUM: + { + /* BEFORATNUM */ + hb_retclen (pcString-sIgnore, pc-(pcString-sIgnore)); + }; break; + + case DO_ATNUM_ATNUM: + { + /* ATNUM */ + hb_retnl (pc-(pcString-sIgnore)+1); + }; break; + } + + } + else /* ((ISCHAR (1)) && (ISCHAR (2))) */ + { + switch (iSwitch) + { + case DO_ATNUM_AFTERATNUM: + case DO_ATNUM_BEFORATNUM: + { + /* AFTERATNUM */ + /* BEFORATNUM */ + hb_retc (""); + }; break; + + case DO_ATNUM_ATNUM: + { + /* ATNUM */ + hb_retnl (0); + }; break; + } + + } + + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * AFTERATNUM() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Returns string portion after nth occurence of substring + * $SYNTAX$ + * AFTERATNUM (, , [], + * [] ) --> cRestString + * $ARGUMENTS$ + * is the substring scanned for + * is the scanned string + * [] determines how many occurences are of + * in are searched + * Default: search last occurence + * [] determines how many character from the start + * should be ignored in the search + * Default: 0 + * $RETURNS$ + * the portion of after the th + * occurence of in + * If such a rest does not exist, an empty string + * is returned. + * $DESCRIPTION$ + * This function scans for . After the + * th match (or the last one, depending on the value of + * ) has been found, the portion of + * after that match will be returned. If there aren't enough + * matches or the last match is identical to the end of , an + * empty string will be returned. + * After a match has been found, the function continues to scan after + * that match if the CSETATMUPA() switch is turned off, with the + * second character of the matched substring otherwise. + * The function will also consider the settings of SETATLIKE(). + * $EXAMPLES$ + * ? AFTERATNUM ("!", "What is the answer ? 4 ! 5 !") -> "" + * ? AFTERATNUM ("!", "What is the answer ? 4 ! 5 ?") -> " 5 ?" + * + * $TESTS$ + * AFTERATNUM ("..", "..This..is..a..test!") == "test!" + * AFTERATNUM ("..", "..This..is..a..test!", 2) == "is..a..test!" + * AFTERATNUM ("..", "..This..is..a..test!", 2, 2) == "a..test!" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * AFTERATNUM() is compatible with CT3's AFTERATNUM(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is atnum.c, library is libct. + * $SEEALSO$ + * ATNUM() BEFORATNUM() CSETATMUPA() SETATLIKE() + * $END$ + */ + +HB_FUNC (AFTERATNUM) +{ + + do_atnum (DO_ATNUM_AFTERATNUM); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * BEFORATNUM() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Returns string portion before nth occurence of substring + * $SYNTAX$ + * BEFORATNUM (, , [], + * [] ) --> cRestString + * $ARGUMENTS$ + * is the substring scanned for + * is the scanned string + * [] determines how many occurences are of + * in are searched + * Default: search last occurence + * [] determines how many character from the start + * should be ignored in the search + * Default: 0 + * $RETURNS$ + * the portion of before the th + * occurence of in + * If such a string does not exist, an empty string + * is returned. + * $DESCRIPTION$ + * This function scans for . After the + * th match (or the last one, depending on the value of + * ) has been found, the portion of + * before that match will be returned. If there aren't enough + * matches or the last match is identical to the start of + * (i.e. the last match is the first match), an empty string will be returned. + * After a match has been found, the function continues to scan after + * that match if the CSETATMUPA() switch is turned off, with the + * second character of the matched substring otherwise. + * The function will also consider the settings of SETATLIKE(). + * $EXAMPLES$ + * ? BEFORATNUM ("!", "What is the answer ? 4 ! 5 !") -> "What is the answer ? 4 ! 5 " + * ? BEFORATNUM ("!", "What is the answer ? 4 ! 5 ?") -> "What is the answer ? 4 " + * + * $TESTS$ + * BEFORATNUM ("..", "..This..is..a..test!") == "..This..is..a" + * BEFORATNUM ("..", "..This..is..a..test!", 2) == "..This" + * BEFORATNUM ("..", "..This..is..a..test!", 2, 2) == "..This..is" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * BEFORATNUM() is compatible with CT3's BEFORATNUM(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is atnum.c, library is libct. + * $SEEALSO$ + * ATNUM() AFTERATNUM() CSETATMUPA() SETATLIKE() + * $END$ + */ + +HB_FUNC (BEFORATNUM) +{ + + do_atnum (DO_ATNUM_BEFORATNUM); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * ATNUM() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Returns the start position of the nth occurence of a substring in a string + * $SYNTAX$ + * ATNUM (, , [], + * [] ) --> nPosition + * $ARGUMENTS$ + * is the substring scanned for + * is the scanned string + * [] determines how many occurences are of + * in are searched + * Default: search last occurence + * [] determines how many character from the start + * should be ignored in the search + * Default: 0 + * $RETURNS$ + * the position of the th + * occurence of in . + * If such an occurence does not exist, 0 + * is returned. + * $DESCRIPTION$ + * This function scans for . After the + * th match (or the last one, depending on the value of + * ) has been found, the position of + * that match will be returned. If there aren't enough + * matches or there is no last match, 0 will be returned. + * After a match has been found, the function continues to scan after + * that match if the CSETATMUPA() switch is turned off, with the + * second character of the matched substring otherwise. + * The function will also consider the settings of SETATLIKE(). + * $EXAMPLES$ + * ? ATNUM ("!", "What is the answer ? 4 ! 5 !") -> 28 + * ? ATNUM ("!", "What is the answer ? 4 ! 5 ?") -> 24 + * + * $TESTS$ + * ATNUM ("..", "..This..is..a..test!") == 14 + * ATNUM ("..", "..This..is..a..test!", 2) == 7 + * ATNUM ("..", "..This..is..a..test!", 2, 2) == 11 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * ATNUM() is compatible with CT3's ATNUM(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is atnum.c, library is libct. + * $SEEALSO$ + * ATNUM() AFTERATNUM() CSETATMUPA() SETATLIKE() + * $END$ + */ + +HB_FUNC (ATNUM) +{ + + do_atnum (DO_ATNUM_ATNUM); + return; + +} + + + + diff --git a/harbour/contrib/libct/ct.ch b/harbour/contrib/libct/ct.ch index 3cbfa9eb05..1e674aff80 100644 --- a/harbour/contrib/libct/ct.ch +++ b/harbour/contrib/libct/ct.ch @@ -56,7 +56,7 @@ #ifndef _CT_CH #define _CT_CH 1 -#define HBT_SETATLIKE_EXACT 0 -#define HBT_SETATLIKE_WILDCARD 1 +#define CT_SETATLIKE_EXACT 0 +#define CT_SETATLIKE_WILDCARD 1 #endif diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index 7f815d9929..7bbb311389 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -124,6 +124,10 @@ $(OBJ_DIR)\ctset.obj : $(TOOLS_DIR)\addascii.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\ctset.obj : $(TOOLS_DIR)\atnum.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 822589357c..d2287aa85c 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -111,6 +111,7 @@ LIBLIST = \ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\addascii.obj \ + $(OBJ_DIR)\atnum.obj \ $(OBJ_DIR)\ctset.obj \ $(OBJ_DIR)\ctstr.obj \ $(OBJ_DIR)\ctchksum.obj \ @@ -134,6 +135,7 @@ all: \ CLEAN: -@if exist $(OBJ_DIR)\addascii.* del $(OBJ_DIR)\addascii.* + -@if exist $(OBJ_DIR)\atnum.* del $(OBJ_DIR)\atnum.* -@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/tests/Makefile b/harbour/contrib/libct/tests/Makefile index 462ef19e76..c899ddc886 100644 --- a/harbour/contrib/libct/tests/Makefile +++ b/harbour/contrib/libct/tests/Makefile @@ -31,10 +31,13 @@ ifeq ($(PM),) # PM not defined = build all files PRG_SOURCES=\ addascii.prg \ + afteratn.prg \ + atnum.prg \ + beforatn.prg \ csetref.prg \ csetatmu.prg \ setatlik.prg \ - + PRG_HEADERS=\ diff --git a/harbour/contrib/libct/tests/afteratn.prg b/harbour/contrib/libct/tests/afteratn.prg new file mode 100644 index 0000000000..69d49a199e --- /dev/null +++ b/harbour/contrib/libct/tests/afteratn.prg @@ -0,0 +1,110 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 functions AFTERATNUM() + * + * 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 cStr := "...This...is...a...test!" + + qout ("Begin test of AFTERATNUM()") + qout ("") + qout (" Value of cStr is:"+chr(34)+cStr+chr(34)) + qout ("") + + // Some simple tests + qout (" Simple tests:") + qout ([ afteratnum ("..",cStr) should be "test!",]) + qout ([ and is "]+afteratnum ("..", cStr)+["]) + qout ([ afteratnum ("..",cStr,2) should be ".is...a...test!",]) + qout ([ and is "]+afteratnum ("..", cStr, 2)+["]) + qout ([ afteratnum ("..",cStr,2,2) should be ".a...test!",]) + qout ([ and is "]+afteratnum ("..", cStr, 2, 2)+["]) + qout () + + // Tests with CSetAtMuPa(.T.) + qout (" Multi-Pass tests") + qout (" Setting csetatmupa() to .T.") + csetatmupa (.T.) + qout ([ afteratnum ("..",cStr) should be "test!",]) + qout ([ and is "]+afteratnum ("..", cStr)+["]) + qout ([ afteratnum ("..",cStr,2) should be "This...is...a...test!",]) + qout ([ and is "]+afteratnum ("..", cStr, 2)+["]) + qout ([ afteratnum ("..",cStr,2,2) should be "is...a...test!",]) + qout ([ and is "]+afteratnum ("..", cStr, 2, 2)+["]) + qout (" Setting csetatmupa() to .F.") + csetatmupa (.F.) + qout () + + // Tests mit SetAtlike (1) + qout (" SetAtLike tests") + qout ([ Setting setatlike (CT_SETATLIKE_WILDCARD, ".")]) + setatlike (CT_SETATLIKE_WILDCARD, ".") + qout ([ afteratnum ("..",cStr) should be "",]) + qout ([ and is "]+afteratnum ("..", cStr)+["]) + qout ([ afteratnum ("..",cStr,2,2) should be "s...is...a...test!",]) + qout ([ and is "]+afteratnum ("..", cStr, 2, 2)+["]) + qout ([ afteratnum ("..",cStr,2,10) should be ".a...test!",]) + qout ([ and is "]+afteratnum ("..", cStr, 2, 10)+["]) + qout () + + qout ("End test of AFTERATNUM()") + qout () + +return + + + diff --git a/harbour/contrib/libct/tests/atnum.prg b/harbour/contrib/libct/tests/atnum.prg new file mode 100644 index 0000000000..8c7a911180 --- /dev/null +++ b/harbour/contrib/libct/tests/atnum.prg @@ -0,0 +1,110 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 functions ATNUM() + * + * 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 cStr := "...This...is...a...test!" + + qout ("Begin test of ATNUM()") + qout ("") + qout (" Value of cStr is:"+chr(34)+cStr+chr(34)) + qout ("") + + // Some simple tests + qout (" Simple tests:") + qout ([ atnum ("..",cStr) should be 18,]) + qout ([ and is ],atnum ("..", cStr)) + qout ([ atnum ("..",cStr,2) should be 8,]) + qout ([ and is ],atnum ("..", cStr, 2)) + qout ([ atnum ("..",cStr,2,2) should be 13,]) + qout ([ and is ],atnum ("..", cStr, 2, 2)) + qout () + + // Tests with CSetAtMuPa(.T.) + qout (" Multi-Pass tests") + qout (" Setting csetatmupa() to .T.") + csetatmupa (.T.) + qout ([ atnum ("..",cStr) should be 18,]) + qout ([ and is ],atnum ("..", cStr)) + qout ([ atnum ("..",cStr,2) should be 2,]) + qout ([ and is ],atnum ("..", cStr, 2)) + qout ([ atnum ("..",cStr,2,2) should be 9,]) + qout ([ and is ],atnum ("..", cStr, 2, 2)) + qout (" Setting csetatmupa() to .F.") + csetatmupa (.F.) + qout () + + // Tests mit SetAtlike (1) + qout (" SetAtLike tests") + qout ([ Setting setatlike (CT_SETATLIKE_WILDCARD, ".")]) + setatlike (CT_SETATLIKE_WILDCARD, ".") + qout ([ atnum ("..",cStr) should be 23,]) + qout ([ and is ],atnum ("..", cStr)) + qout ([ atnum ("..",cStr,2,2) should be 5,]) + qout ([ and is ],atnum ("..", cStr, 2, 2)) + qout ([ atnum ("..",cStr,2,10) should be 13,]) + qout ([ and is ],atnum ("..", cStr, 2, 10)) + qout () + + qout ("End test of ATNUM()") + qout () + +return + + + diff --git a/harbour/contrib/libct/tests/beforatn.prg b/harbour/contrib/libct/tests/beforatn.prg new file mode 100644 index 0000000000..c92c04093d --- /dev/null +++ b/harbour/contrib/libct/tests/beforatn.prg @@ -0,0 +1,110 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 functions BEFORATNUM() + * + * 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 cStr := "...This...is...a...test!" + + qout ("Begin test of BEFORATNUM()") + qout ("") + qout (" Value of cStr is:"+chr(34)+cStr+chr(34)) + qout ("") + + // Some simple tests + qout (" Simple tests:") + qout ([ beforatnum ("..",cStr) should be "...This...is...a.",]) + qout ([ and is "]+beforatnum ("..", cStr)+["]) + qout ([ beforatnum ("..",cStr,2) should be "...This",]) + qout ([ and is "]+beforatnum ("..", cStr, 2)+["]) + qout ([ beforatnum ("..",cStr,2,2) should be "...This...is",]) + qout ([ and is "]+beforatnum ("..", cStr, 2, 2)+["]) + qout () + + // Tests with CSetAtMuPa(.T.) + qout (" Multi-Pass tests") + qout (" Setting csetatmupa() to .T.") + csetatmupa (.T.) + qout ([ beforatnum ("..",cStr) should be "...This...is...a.",]) + qout ([ and is "]+beforatnum ("..", cStr)+["]) + qout ([ beforatnum ("..",cStr,2) should be ".",]) + qout ([ and is "]+beforatnum ("..", cStr, 2)+["]) + qout ([ beforatnum ("..",cStr,2,2) should be "...This.",]) + qout ([ and is "]+beforatnum ("..", cStr, 2, 2)+["]) + qout (" Setting csetatmupa() to .F.") + csetatmupa (.F.) + qout () + + // Tests mit SetAtlike (1) + qout (" SetAtLike tests") + qout ([ Setting setatlike (CT_SETATLIKE_WILDCARD, ".")]) + setatlike (CT_SETATLIKE_WILDCARD, ".") + qout ([ beforatnum ("..",cStr) should be "...This...is...a...tes",]) + qout ([ and is "]+beforatnum ("..", cStr)+["]) + qout ([ beforatnum ("..",cStr,2,2) should be "...T",]) + qout ([ and is "]+beforatnum ("..", cStr, 2, 2)+["]) + qout ([ beforatnum ("..",cStr,2,10) should be "...This...is",]) + qout ([ and is "]+beforatnum ("..", cStr, 2, 10)+["]) + qout () + + qout ("End test of BEFORATNUM()") + qout () + +return + + +