From 816d0a9a502dc3bf375302acc9e463a6cb2f5975 Mon Sep 17 00:00:00 2001 From: Martin Vogel Date: Tue, 17 Apr 2001 16:48:48 +0000 Subject: [PATCH] ---------------------------------------------------------------------- --- harbour/ChangeLog | 22 +++ harbour/contrib/libct/Makefile | 1 + harbour/contrib/libct/addascii.c | 211 +++++++++++++++++++++++ harbour/contrib/libct/ctset.c | 14 +- harbour/contrib/libct/makefile.bc | 4 + harbour/contrib/libct/makefile.vc | 6 +- harbour/contrib/libct/readme.txt | 11 ++ harbour/contrib/libct/tests/Makefile | 70 ++++++++ harbour/contrib/libct/tests/addascii.prg | 118 +++++++++++++ harbour/contrib/libct/tests/csetatmu.prg | 69 ++++++++ harbour/contrib/libct/tests/csetref.prg | 69 ++++++++ harbour/contrib/libct/tests/setatlik.prg | 78 +++++++++ 12 files changed, 668 insertions(+), 5 deletions(-) create mode 100644 harbour/contrib/libct/addascii.c create mode 100644 harbour/contrib/libct/tests/Makefile create mode 100644 harbour/contrib/libct/tests/addascii.prg create mode 100644 harbour/contrib/libct/tests/csetatmu.prg create mode 100644 harbour/contrib/libct/tests/csetref.prg create mode 100644 harbour/contrib/libct/tests/setatlik.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index d7dc4b78d2..51926d64ec 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,25 @@ +2001-04-17 18:40 CET Martin Vogel + * contrib/libct/readme.txt + + Added paragraph for enhancements over original CT3 library + + + contrib/libct/addascii.c + + * contrib/libct/Makefile + + added addascii.c + + * contrib/libct/makefile.vc + + added addascii.c + + * contrib/libct/makefile.bc + + added addascii.c + + + contrib/libct/tests + + contrib/libct/tests/Makefile + + contrib/libct/tests/csetref.prg + + contrib/libct/tests/csetatmu.prg + + contrib/libct/tests/setatlik.prg + + contrib/libct/tests/addascii.prg + 2001-04-17 17:55 CET Martin Vogel + contrib/libct/ct.ch + contrib/libct/ct.h diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index 9d3a16cc1c..76578ad9db 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -5,6 +5,7 @@ ROOT = ../../ C_SOURCES=\ + addascii.c \ ctset.c \ ctstr.c \ ctchksum.c \ diff --git a/harbour/contrib/libct/addascii.c b/harbour/contrib/libct/addascii.c new file mode 100644 index 0000000000..8d751d4950 --- /dev/null +++ b/harbour/contrib/libct/addascii.c @@ -0,0 +1,211 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * ADDASCII() CT3 string function + * + * 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" + + +/* $DOC$ + * $FUNCNAME$ + * ADDASCII() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Add an integer value to an ascii value of a string + * $SYNTAX$ + * ADDASCII (<[@]cString>, , [], []) --> cString + * $ARGUMENTS$ + * <[@]cString> is the string that should be edited + * is a integer value that should be added to the + * ASCII value of the character at the th position + * [] is the position of the character that should be edited. + * If not supplied, the last character of <[@]cString> is + * edited. + * [] NEW: is set to .T. if the substring from position 1 to + * position should be treated as an integer + * written to the base 256. Thus, the addition of + * can affect to whole substring (see EXAMPLES). + * Default is .F., the original behaviour of this function. + * $RETURNS$ + * The edited string is returned. The return value can be suppressed by + * using the CSETREF() function. The string must then be passed by + * reference [@]. + * $DESCRIPTION$ + * ADDASCII() can be used to add or subtract integer values from + * ASCII values in a string. The new parameter allows + * to treat a string as an integer written to the base 256. Since + * is limited to a signed long, only substrings 4 characters + * long can be affected by one ADDASCII() call. + * If the length of <[@]cString> is smaller than , the + * string remains unchanged. The same happens, if uninterpretable + * parameters are passed to this function. + * $EXAMPLES$ + * // Add 32 to the ASCII value of the character at the last position + * // in the string + * + * ? addascii ("SmitH", 32) --> "Smith" + * $TESTS$ + * addascii ("0000", 1, 1) == "1000" + * addascii ("0000", 1) == "0001" + * addascii ("AAAA", -255, 1) == "BAAA" + * addascii ("AAAA", -255) == "AAAB" + * addascii ("AAAA", 1, 2, .T.) == "ABAA" + * addascii ("AAAA", 257, 2, .T.) == "BBAA" + * addascii ("AAAA", 257, 2, .F.) == "ABAA" + * addascii ("AAAA", 258,, .T.) == "AABC" + * addascii ("ABBA", -257, 3, .T.) == "AAAA" + * $STATUS$ + * Ready + * $COMPLIANCE$ + * ADDASCII() is compatible with CT3's ADDASCII(). + * A new, 4th, parameter has been added who defaults to the original + * behaviour if omitted. + * $PLATFORMS$ + * All + * $FILES$ + * Source is addascii.c, library is libct. + * $SEEALSO$ + * CSETREF() + * $END$ + */ + + +HB_FUNC (ADDASCII) +{ + + if (ISCHAR (1)) + { + + char *pcSource = hb_parc (1); + size_t sLen = hb_parclen (1); + char *pcResult; + size_t sPos; + long lValue; + int iCarryOver; + int iNoRet; + + if (ISNUM (3)) + sPos = hb_parnl (3); + else + sPos = sLen; + + /* suppressing return value ? */ + iNoRet = ct_getref(); + + if ((sPos > sLen) || !(ISNUM (2))) + { + /* return string unchanged */ + if (iNoRet) + hb_retl (0); + else + hb_retclen (pcSource, sLen); + return; + } + + pcResult = (char *)hb_xgrab (sLen); + hb_xmemcpy (pcResult, pcSource, sLen); + + lValue = hb_parnl (2); + if (ISLOG (4)) + iCarryOver = hb_parl (4); + else + iCarryOver = 0; + + if (iCarryOver) + { + size_t sCurrent; + long lResult; + + for (sCurrent = sPos; (sCurrent>0) && (lValue != 0); sCurrent--) + { + lResult = (long)pcSource[sCurrent-1]+(lValue%256); + + lValue /= 256; + if (lResult > 255) + lValue++; + else if (lResult < 0) + lValue--; + + pcResult[sCurrent-1] = (char)(lResult%256); + } + } + else + { + pcResult[sPos-1] = (char)(((long)pcResult[sPos-1]+lValue)%256); + } + + if (iNoRet) + hb_retl (0); + else + hb_retclen (pcResult, sLen); + + if (ISBYREF (1)) + hb_storclen (pcResult, sLen, 1); + + hb_xfree (pcResult); + return; + + } + else + { + hb_retc (""); + return; + } + +} + + + + + diff --git a/harbour/contrib/libct/ctset.c b/harbour/contrib/libct/ctset.c index a026e055e9..f373d60221 100644 --- a/harbour/contrib/libct/ctset.c +++ b/harbour/contrib/libct/ctset.c @@ -127,7 +127,7 @@ int ct_getref (void) * $PLATFORMS$ * All * $FILES$ - * Source is ctset.c. + * Source is ctset.c, library is libct. * $SEEALSO$ * ADDASCII() BLANK() CHARADD() * CHARAND() CHARMIRR() CHARNOT() @@ -209,7 +209,7 @@ int ct_getatmupa (void) * $PLATFORMS$ * All * $FILES$ - * Source is ctset.c. + * Source is ctset.c, library is libct. * $SEEALSO$ * ATNUM() AFTERATNUM() BEFORATNUM() * ATREPL() NUMAT() ATADJUST() @@ -303,6 +303,14 @@ char ct_getatlikechar (void) * considered to match within these functions. If CT_SETATLIKE_WILDCARD * is set (e.g. "?"), then "?" matches every other character. * + * can be one of the following values that are defined + * in ct.ch + * + * Definition | Value + * ----------------------|------ + * CT_SETATLIKE_EXACT | 0 + * CT_SETATLIKE_WILDCARD | 1 + * * $EXAMPLES$ * $TESTS$ * $STATUS$ @@ -314,7 +322,7 @@ char ct_getatlikechar (void) * $PLATFORMS$ * All * $FILES$ - * Source is ctset.c, header is ct.ch. + * Source is ctset.c, header is ct.ch, library is libct. * $SEEALSO$ * $END$ */ diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index 360cad9f9f..7f815d9929 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -120,6 +120,10 @@ $(TOOLS_LIB) : $(TOOLS_LIB_OBJS) # TOOLS.LIB dependencies # +$(OBJ_DIR)\ctset.obj : $(TOOLS_DIR)\addascii.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 ce0e686c9e..822589357c 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -110,6 +110,7 @@ LIBLIST = \ $(MAKE) -nologo /$(MK_FLAGS) /f$(MK_FILE) $(TOOLS_LIB)2 TOOLS_LIB_OBJS = \ + $(OBJ_DIR)\addascii.obj \ $(OBJ_DIR)\ctset.obj \ $(OBJ_DIR)\ctstr.obj \ $(OBJ_DIR)\ctchksum.obj \ @@ -132,8 +133,9 @@ all: \ $(TOOLS_LIB) CLEAN: - -@if exist $(OBJ_DIR)\ctchksum.* del $(OBJ_DIR)\ctset.* - -@if exist $(OBJ_DIR)\ctchksum.* del $(OBJ_DIR)\ctstr.* + -@if exist $(OBJ_DIR)\addascii.* del $(OBJ_DIR)\addascii.* + -@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)\ctchrevn.* del $(OBJ_DIR)\ctchrevn.* -@if exist $(OBJ_DIR)\ctchrmix.* del $(OBJ_DIR)\ctchrmix.* diff --git a/harbour/contrib/libct/readme.txt b/harbour/contrib/libct/readme.txt index 1125c6956a..766f6396ef 100644 --- a/harbour/contrib/libct/readme.txt +++ b/harbour/contrib/libct/readme.txt @@ -10,3 +10,14 @@ of the original CA-T**ls 3 Library for CA-Cl*pper. Victor Szakats + +Changes and Enhancements over the original CA-T**ls 3 Library +============================================================= + +* ADDASCII() New 4th parameter to enable a carry over in the addition + process + +* SETATLIKE() 2nd parameter can be passed by reference so that SETATLIKE + can store the acutal wildcard character in it + + diff --git a/harbour/contrib/libct/tests/Makefile b/harbour/contrib/libct/tests/Makefile new file mode 100644 index 0000000000..462ef19e76 --- /dev/null +++ b/harbour/contrib/libct/tests/Makefile @@ -0,0 +1,70 @@ +# +# $Id$ +# + +ifeq ($(HB_MAIN),) +HB_MAIN = std +endif + +ROOT = ../../../ + +CONTRIBS=\ + libct\ + +LIBS=\ + debug \ + vm \ + rtl \ + lang \ + rdd \ + rtl \ + vm \ + macro \ + pp \ + common \ + +ifeq ($(PM),) + PM := $(pm) +endif + +ifeq ($(PM),) # PM not defined = build all files + +PRG_SOURCES=\ + addascii.prg \ + csetref.prg \ + csetatmu.prg \ + setatlik.prg \ + + +PRG_HEADERS=\ + + +BAD_PRG_SOURCES=\ + + +C_SOURCES=\ + + +C_HEADERS=\ + + +BAD_C_SOURCES=\ + + +include $(TOP)$(ROOT)config/test.cf + +else #PM defined = build specified file + +ifneq ($(findstring .prg,$(PM)),) + PRG_MAIN := $(PM) +else + ifneq ($(findstring .PRG,$(PM)),) + PRG_MAIN := $(PM) + else + PRG_MAIN := $(PM).prg + endif +endif +include $(TOP)$(ROOT)config/bin.cf + +endif + diff --git a/harbour/contrib/libct/tests/addascii.prg b/harbour/contrib/libct/tests/addascii.prg new file mode 100644 index 0000000000..4df79f2f88 --- /dev/null +++ b/harbour/contrib/libct/tests/addascii.prg @@ -0,0 +1,118 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function ADDASCII() + * + * 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 ADDASCII()") + qout ("") + // simple tests + qout ("Simple tests:") + qout ([ This should be "1000": ]+addascii ("0000", 1, 1)) + qout ([ This should be "0001": ]+addascii ("0000", 1)) + qout ([ This should be "BAAA": ]+addascii ("AAAA", -255, 1)) + qout ([ This should be "AAAB": ]+addascii ("AAAA", -255)) + + // csetref() tests + qout () + qout ("CSETREF tests:") + qout (" current csetref setting (should be .f.)................: ", csetref()) + qout (" return value of addascii ([A],1,1) call (should be 'B'): ", addascii("A",1,1)) + qout (" value of cStr..........................................: ", cStr) + qout (" return value of addascii (cStr,1,1) call...............: ", addascii(cStr,1,1)) + qout (" value of cStr is now...................................: ", cStr) + qout (" return value of addascii (@cStr,1,1) call..............: ", addascii(@cStr,1,1)) + qout (" value of cStr is now...................................: ", cStr) + qout (" return value of addascii (@cStr,-1,1) call.............: ", addascii(@cStr,-1,1)) + qout (" value of cStr is now...................................: ", cStr) + qout (" return value of csetref (.t.)..........................: ", csetref (.t.)) + qout (" return value of addascii ([A],1,1) call................: ", addascii("A",1,1)) + qout (" return value of addascii (cStr,1,1) call...............: ", addascii(cStr,1,1)) + qout (" value of cStr is now...................................: ", cStr) + qout (" return value of addascii (@cStr,1,1) call..............: ", addascii(@cStr,1,1)) + qout (" value of cStr is now...................................: ", cStr) + qout (" return value of addascii (@cStr,-1,1) call.............: ", addascii(@cStr,-1,1)) + qout (" value of cStr is now...................................: ", cStr) + qout (" return value of csetref (.f.)..........................: ", csetref (.f.)) + + // tests for the new 4th parameter + qout () + qout ("Carryover tests (new 4th parameter):") + qout (" return value of addascii([AAAA],1,2,.T.) call ('ABAA')....:", addascii("AAAA",1,2,.T.)) + qout (" return value of addascii([AAAA],257,2,.T.) call ('BBAA')..:", addascii("AAAA",257,2,.T.)) + qout (" return value of addascii([AAAA],257,2,.F.) call ('ABAA')..:", addascii("AAAA",257,2,.F.)) + qout (" return value of addascii([AAAA],258,,.T.) call ('AABC')...:", addascii("AAAA",258,,.T.)) + qout (" return value of addascii([ABBA],-257,3,.T.) call ('AAAA').:", addascii("ABBA",-257,3,.T.)) + + // wrong parameter test + qout () + qout ("Wrong parameter tests:") + qout (" return value of valtype (addascii (5789676,1,2,.T.)) call ('C'): ", valtype(addascii(5789676,1,2,.T.))) + qout (" return value of addascii ([ABCD],[A],2,.F.) call ('ABCD')......: ", addascii("ABCD","A",2,.F.)) + qout (" return value of addascii ([ABCD],1,5,.F.) call ('ABCD')........: ", addascii("ABCD",1,5,.F.)) + qout () + + qout ("End test of ADDASCII()") + qout ("") + +return + + + + diff --git a/harbour/contrib/libct/tests/csetatmu.prg b/harbour/contrib/libct/tests/csetatmu.prg new file mode 100644 index 0000000000..04606b7e6a --- /dev/null +++ b/harbour/contrib/libct/tests/csetatmu.prg @@ -0,0 +1,69 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CSETATMUPA() + * + * 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 CSETATMUPA()") + qout (" Default switch should be .F., is..................................", csetatmupa()) + qout (" Setting switch to .T., return value should be .F., is.............", csetatmupa (.T.)) + qout (" Switch setting should now be .T., is..............................", csetatmupa()) + qout (" Setting switch to .F. again, return value should still be .T., is ", csetatmupa (.F.)) + qout ("End test of CSETATMUPA()") + qout ("") + +return diff --git a/harbour/contrib/libct/tests/csetref.prg b/harbour/contrib/libct/tests/csetref.prg new file mode 100644 index 0000000000..2ed89407d0 --- /dev/null +++ b/harbour/contrib/libct/tests/csetref.prg @@ -0,0 +1,69 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CSETREF() + * + * 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 CSETREF()") + qout (" Default switch should be .F., is..................................", csetref()) + qout (" Setting switch to .T., return value should be .F., is.............", csetref (.T.)) + qout (" Switch setting should now be .T., is..............................", csetref()) + qout (" Setting switch to .F. again, return value should still be .T., is ", csetref (.F.)) + qout ("End test of CSETREF()") + qout ("") + +return diff --git a/harbour/contrib/libct/tests/setatlik.prg b/harbour/contrib/libct/tests/setatlik.prg new file mode 100644 index 0000000000..a0448fe57b --- /dev/null +++ b/harbour/contrib/libct/tests/setatlik.prg @@ -0,0 +1,78 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function SETATLIKE() + * + * 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 cWildcard := " " + + qout ("Begin test of SETATLIKE()") + qout (" Default mode should be 0, is................................", setatlike()) + qout (" Setting mode to 1, return value should be 0, is.............", setatlike (1)) + qout (" Mode setting should now be 1, is............................", setatlike()) + qout (" Setting mode to 0 again, return value should still be 1, is ", setatlike (0)) + qout ("") + setatlike (, @cWildcard) + qout (" Default wildcard character should be '?', is................", cWildcard) + setatlike (, "#") + setatlike (, @cWildcard) + qout (" Setting wildcard to '#' and calling SETATLIKE (,@cWildcard)") + qout (" should yield '#' for cWildcard, does......................", cWildcard) + qout ("End test of SETATLIKE()") + qout ("") + +return