----------------------------------------------------------------------

This commit is contained in:
Martin Vogel
2001-04-17 16:48:48 +00:00
parent d6b722a525
commit 816d0a9a50
12 changed files with 668 additions and 5 deletions

View File

@@ -1,3 +1,25 @@
2001-04-17 18:40 CET Martin Vogel <vogel@inttec.de>
* 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 <vogel@inttec.de>
+ contrib/libct/ct.ch
+ contrib/libct/ct.h

View File

@@ -5,6 +5,7 @@
ROOT = ../../
C_SOURCES=\
addascii.c \
ctset.c \
ctstr.c \
ctchksum.c \

View File

@@ -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 <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "ct.h"
/* $DOC$
* $FUNCNAME$
* ADDASCII()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Add an integer value to an ascii value of a string
* $SYNTAX$
* ADDASCII (<[@]cString>, <nValue>, [<nPosition>], [<lCarryOver>]) --> cString
* $ARGUMENTS$
* <[@]cString> is the string that should be edited
* <nValue> is a integer value that should be added to the
* ASCII value of the character at the <nPosition>th position
* [<nPosition>] is the position of the character that should be edited.
* If not supplied, the last character of <[@]cString> is
* edited.
* [<lCarryOver>] NEW: is set to .T. if the substring from position 1 to
* position <nPosition> should be treated as an integer
* written to the base 256. Thus, the addition of <nValue>
* 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 <lCarryOver> parameter allows
* to treat a string as an integer written to the base 256. Since
* <nValue> 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 <nPosition>, 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;
}
}

View File

@@ -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.
*
* <nMode> 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$
*/

View File

@@ -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) -+$@,,

View File

@@ -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.*

View File

@@ -10,3 +10,14 @@ of the original CA-T**ls 3 Library for CA-Cl*pper.
Victor Szakats <info@szelvesz.hu>
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

View File

@@ -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

View File

@@ -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 <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
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

View File

@@ -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 <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of 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

View File

@@ -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 <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of 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

View File

@@ -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 <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
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