fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

19991207-16:29 GMT+1 Victor Szel <info@szelvesz.hu>

Browse Source
This commit is contained in:
Viktor Szakats
1999-12-07 16:42:57 +00:00
parent 5941790cc5
commit 20dde35614
21 changed files with 418 additions and 124 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
harbour/ChangeLog
View File

@@ -1,3 +1,30 @@
19991207-16:29 GMT+1 Victor Szel <info@szelvesz.hu>
* tests/regress/*
! SQRT(3) expected result fixed.
! Date() calls in test lines changed to constant dates.
(Both fix thanks to Plamen Ivanov <abrasoft@techno-link.com>)
+ 19800101 changed to 19840325 to better test handling of date parts.
* doc/hdr_tpl.txt
+ $FILES$ entry added.
* source/rtl/dbedit.prg
+ DBEDIT() documentation by Chen Kedem added
* source/rtl/extend.c
! Updated TRACE call for hb_pardsbuff()
* include/hbpp.h
- Removed two compiler variable declarations.
* source/common/hbstr.c
% Minor code cleanup.
* source/rtl/alert.prg
! Chr(13)+Chr(10) changed to hb_OSNewLine().
! Fix in the ALERT() $DESCRIPTION$.
(Both fix thanks to Chen Kedem)
* source/rtl/dircmd.prg
+ __DIR() documentation by Chen Kedem added
* source/rtl/adir.prg
! Fixed $EXAMPLE$, aSize( var, x ) would result in a RT error, since
var is NIL at this point, changed to var := Array( x ), $SEEALSO$
changed accordingly.
19991205-14:22 GMT+1 Bruno Cantero <bruno@issnet.net>
* include/rddapi.h
source/rdd/dbcmd.c

5
harbour/doc/hdr_tpl.txt
View File

@@ -82,6 +82,8 @@ FUNCTION HEADER TEMPLATE
*
* $PLATFORMS$
*
* $FILES$
*
* $SEEALSO$
*
* $END$
@@ -130,6 +132,8 @@ FUNCTION HEADER EXAMPLE
* different universe from the author of this function.
* $PLATFORMS$
* All
* $FILES$
*
* $SEEALSO$
* Date() IsWeekend() IsHarbourFinished() IsApocalypse()
* $END$
@@ -140,6 +144,7 @@ FUNCTION HEADER EXAMPLE
/*
* ChangeLog:
*
* V 1.11 Victor Szel $FILES$ added.
* V 1.10 Victor Szel $PLATFORMS$ added.
* V 1.9 Victor Szel Small format changes.
* V 1.8 Victor Szel licence -> license

4
harbour/include/extend.h
View File

@@ -362,10 +362,10 @@ extern ULONG hb_objHasMsg( PHB_ITEM pObject, char * szString );
extern PHB_DYNS hb_dynsymGet( char * szName ); /* finds and creates a dynamic symbol if not found */
extern PHB_DYNS hb_dynsymNew( PHB_SYMB pSymbol ); /* creates a new dynamic symbol based on a local one */
extern PHB_DYNS hb_dynsymFind( char * szName ); /* finds a dynamic symbol */
extern PHB_DYNS hb_dynsymFindName( char * szName ); /* converts to uppercase and finds a dynamic symbol */
extern PHB_DYNS hb_dynsymFindName( char * szName ); /* converts to uppercase and finds a dynamic symbol */
extern void hb_dynsymLog( void ); /* displays all dynamic symbols */
extern void hb_dynsymRelease( void ); /* releases the memory of the dynamic symbol table */
extern void hb_dynsymEval( PHB_DYNS_FUNC, void * ); /* enumerates all dynamic symbols */
extern void hb_dynsymEval( PHB_DYNS_FUNC, void * ); /* enumerates all dynamic symbols */
/* Command line and environment argument management */
extern void hb_cmdargInit( int argc, char * argv[] );

7
harbour/include/hbpp.h
View File

@@ -33,8 +33,6 @@
*
*/
/* Definitions related to the preprocessor */
#ifndef HB_PP_H_
#define HB_PP_H_
@@ -106,9 +104,4 @@ extern DEFINES * hb_pp_topDefine;
extern COMMANDS * hb_pp_topCommand;
extern COMMANDS * hb_pp_topTranslate;
/* Imported from the compiler */
extern PATHNAMES * hb_comp_pIncludePath;
extern PHB_FNAME hb_comp_pFileName;
#endif /* HB_PP_H_ */

19
harbour/include/hbtrace.h
View File

@@ -67,15 +67,16 @@
* levels that are less or equal to the COMPILATION time HB_TR_LEVEL.
*/
#define HB_ECHO_CREATE(l, x) do \
{ \
if (hb_tr_level() >= l) { \
hb_tr_file_ = __FILE__; \
hb_tr_line_ = __LINE__; \
hb_tr_level_ = l; \
hb_tr_trace x ; \
} \
} while (0)
#define HB_ECHO_CREATE( l, x ) do \
{ \
if( hb_tr_level() >= l ) \
{ \
hb_tr_file_ = __FILE__; \
hb_tr_line_ = __LINE__; \
hb_tr_level_ = l; \
hb_tr_trace x ; \
} \
} while( 0 )
#if HB_TR_LEVEL >= HB_TR_DEBUG
#define HB_ECHO_TRACE_HB_TR_DEBUG(x) HB_ECHO_CREATE(HB_TR_DEBUG, x)

6
harbour/source/common/hbstr.c
View File

@@ -43,11 +43,12 @@ ULONG hb_strAt( const char * szSub, ULONG ulSubLen, const char * szText, ULONG u
if( ulSubLen > 0 && ulLen >= ulSubLen )
{
ULONG ulPos = 0, ulSubPos = 0;
ULONG ulPos = 0;
ULONG ulSubPos = 0;
while( ulPos < ulLen && ulSubPos < ulSubLen )
{
if( *( szText + ulPos ) == *( szSub + ulSubPos ) )
if( szText[ ulPos ] == szSub[ ulSubPos ] )
{
ulSubPos++;
ulPos++;
@@ -57,6 +58,7 @@ ULONG hb_strAt( const char * szSub, ULONG ulSubLen, const char * szText, ULONG u
else
ulPos++;
}
return ( ulSubPos < ulSubLen ) ? 0 : ( ulPos - ulSubLen + 1 );
}
else

12
harbour/source/rtl/adir.prg
View File

@@ -101,11 +101,11 @@
* LOCAL aName, aSize, aDate, aTime, aAttr, nLen, i
* nLen := ADIR( "*.JPG" ) // Number of JPG files in this directory
* IF nLen > 0
* ASIZE( aName, nLen ) // make room to store the information
* ASIZE( aSize, nLen )
* ASIZE( aDate, nLen )
* ASIZE( aTime, nLen )
* ASIZE( aAttr, nLen )
* aName := Array( nLen ) // make room to store the information
* aSize := Array( nLen )
* aDate := Array( nLen )
* aTime := Array( nLen )
* aAttr := Array( nLen )
* FOR i = 1 TO nLen
* ? aName[i], aSize[i], aDate[i], aTime[i], aAttr[i]
* NEXT
@@ -118,7 +118,7 @@
* <aName> is going to be fill with long file name and not necessarily
* the 8.3 uppercase name.
* $SEEALSO$
* ASIZE(), DIRECTORY(), SET DEFAULT
* ARRAY(), DIRECTORY(), SET DEFAULT
* $END$
*/

6
harbour/source/rtl/alert.prg
View File

@@ -85,8 +85,8 @@ STATIC s_lNoAlert := NIL
* first letter of the option.
*
* If the program is executed with the //NOALERT command line switch,
* nothing is displayed and the program simply QUIT. This switch could
* be override with __NONOALERT().
* nothing is displayed and it simply returns NIL. This switch could
* be overridden with __NONOALERT().
*
* If the GT system is linked in, ALERT() display the message using
* the full screen I/O system, if not, the information is printed to
@@ -273,7 +273,7 @@ FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay )
FOR nEval := 1 TO Len( aSay )
OutStd( aSay[ nEval ] )
IF nEval < Len( aSay )
OutStd( Chr( 13 ) + Chr( 10 ) )
OutStd( hb_OSNewLine() )
ENDIF
NEXT

194
harbour/source/rtl/dbedit.prg
View File

@@ -33,6 +33,17 @@
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Chen Kedem <niki@actcom.co.il>
* DBEDIT() documentation
*
* See doc/license.txt for licensing terms.
*
*/
#include "common.ch"
#include "dbedit.ch"
#include "inkey.ch"
@@ -40,6 +51,14 @@
#define HB_DBEMPTY() ( LastRec() == 0 .OR. ( ( Eof() .OR. RecNo() == LastRec() + 1 ) .AND. Bof() ) )
/* TODO: put more comprehensive $EXAMPLES$.
DBEDIT() is a complex function, the doc I had made cover all the
parameters but probably not good enough for a new user that does
not know what this function is all about and how to use it. I am
not that good with the English language (and I did not want to
COPY the NG text) I suggest later some one should add to this
text. [chkedem] */
/* NOTE: Extension: Harbour supports codeblocks as the xUserFunc parameter */
/* NOTE: Clipper is buggy and will throw an error if the number of
columns is zero. (Check: dbEdit(0,0,20,20,{})) */
@@ -49,6 +68,181 @@
supported in Harbour */
/* NOTE: Harbour is multithreading ready/reentrant, Clipper is not */
/* $DOC$
* $FUNCNAME$
* DBEDIT()*
* $CATEGORY$
* Data input and output
* $ONELINER$
* Browse records in a table
* $SYNTAX$
* DBEDIT( [<nTop>], [<nLeft>], [<nBottom>], [<nRight>], [<acColumns>],
* [<xUserFunc>], [<xColumnSayPictures>], [<xColumnHeaders>],
* [<xHeadingSeparators>], [<xColumnSeparators>],
* [<xFootingSeparators>], [<xColumnFootings>] ) --> lOk
* $ARGUMENTS$
* <nTop> coordinate for top row display. <nTop> could range from 0 to
* MAXROW(), default is 0.
*
* <nLeft> coordinate for left column display. <nLeft> could range from
* 0 to MAXCOL(), default is 0.
*
* <nBottom> coordinate for bottom row display. <nBottom> could range
* from 0 to MAXROW(), default is MAXROW().
*
* <nRight> coordinate for right column display. <nRight> could range
* from 0 to MAXCOL(), default is MAXCOL().
*
* <acColumns> is an array of character expressions that contain
* database fields names or expressions to display in each column.
* If not specified, the default is to display all fields from the
* database in the current work area.
*
* <xUserFunc> is a name of a user defined function or a code block
* that would be called every time unrecognized key is been pressed or
* when there are no keys waiting to be processed and DBEDIT() goes
* into idle mode. If <xUserFunc> is a character string, it must
* contain root name of a valid user define function without
* parentheses. Both the user define function or the code block should
* accept two parameters: nMode, nCurrentColumn. Both should return
* a numeric value that correspond to one of the expected return codes
* (see table below for a list of nMode and return codes).
*
* <xColumnSayPictures> is an optional picture. If <xColumnSayPictures>
* is a character string, all columns would used this value as a
* picture string. If <xColumnSayPictures> is an array, each element
* should be a character string that correspond to a picture string
* for the column with the same index. Look at the help for @...SAY
* to get more information about picture values.
*
* <xColumnHeaders> contain the header titles for each column, if this
* is a character string, all columns would have that same header, if
* this is an array, each element is a character string that contain
* the header title for one column. Header may be split to more than
* one line by placing semicolon (;) in places where you want to break
* line. If omitted, the default value for each column header is taken
* from <acColumns> or field name if <acColumns> was not specified.
*
* <xHeadingSeparators> is an array that contain characters that draw
* the lines separating the headers and the fields data. Instead of an
* array you can use a character string that would be used to display
* the same line for all fields. Default value is a double line.
*
* <xColumnSeparators> is an array that contain characters that draw
* the lines separating displayed columns. Instead of an array you can
* use a character string that would be used to display the same line
* for all fields. Default value is a single line.
*
* <xFootingSeparators> is an array that contain characters that draw
* the lines separating the fields data area and the footing area.
* Instead of an array you can use a character string that would be
* used to display the same line for all footers. Default is to have to
* no footing separators.
*
* <xColumnFootings> contain the footing to be displayed at the bottom
* of each column, if this is a character string, all columns would
* have that same footer, if this is an array, each element is a
* character string that contain the footer for one column. Footer may
* be split to more than one line by placing semicolon (;) in places
* where you want to break line. If omitted, no footer are displayed.
* $RETURNS$
* DBEDIT() return .F. if there is no database in use or if the number
* of columns to display is zero, else DBEDIT() return .T.
* $DESCRIPTION$
* DBEDIT() display and edit records from one or more work areas in
* a grid on screen. Each column is defined by element from <acColumns>
* and is the equivalent of one field. Each row is equivalent of one
* database record.
*
* Following are active keys that handled by DBEDIT():
* ---------------------------------------------------
*
* Left - Move one column to the left (previous field)
* Right - Move one column to the right (next field)
* Up - Move up one row (previous record)
* Down - Move down one row (next record)
* Page-Up - Move to the previous screen
* Page-Down - Move to the next screen
* Ctrl Page-Up - Move to the top of the file
* Ctrl Page-Down - Move to the end of the file
* Home - Move to the leftmost visible column
* End - Move to the rightmost visible column
* Ctrl Left - Pan one column to the left
* Ctrl Right - Pan one column to the right
* Ctrl Home - Move to the leftmost column
* Ctrl End - Move to the rightmost column
*
* When <xUserFunc> is omitted, two more keys are active:
*
* Esc - Terminate BROWSE()
* Enter - Terminate BROWSE()
*
* When DBEDIT() execute <xUserFunc> it pass the following arguments:
* nMode and the index of current record in <acColumns>. If <acColumns>
* is omitted, the index number is the FIELD() number of the open
* database structure.
*
* DBEDIT() nMode could be one of the following:
* ---------------------------------------------
*
* DE_IDLE 0 DBEDIT() is idle, all movement keys have been
* handled.
* DE_HITTOP 1 Attempt to cursor past top of file.
* DE_HITBOTTOM 2 Attempt to cursor past bottom of file.
* DE_EMPTY 3 No records in work area, database is empty.
* DE_EXCEPT 4 Key exception.
*
* The user define function or code block must return a value that tell
* DBEDIT() what to do next.
*
* User function return codes:
* ---------------------------
*
* DE_ABORT 0 Abort DBEDIT().
* DE_CONT 1 Continue DBEDIT() as is.
* DE_REFRESH 2 Force reread/redisplay of all data rows.
*
* The user function is called once in each of the following cases:
* - The database is empty.
* - The user try to move past top of file or past bottom file.
* - Key exception, the uses had pressed a key that is not handled by
* DBEDIT().
* - The keyboard buffer is empty or a screen refresh had just occurred
*
* DBEDIT() is a compatibility function, it is superseded by the
* TBrowse class and there for not recommended for new applications.
* $EXAMPLES$
* // Browse a file using default values
* USE Test
* DBEDIT()
*
* // TODO: put a longer example or point to a sample file
* $TESTS$
* $STATUS$
* $COMPLIANCE$
* <xUserFunc> can take a code block value, this is an Harbour
* extension.
*
* CA-Clipper will throw an error if there's no database open, Harbour
* would return .F.
*
* CA-Clipper is buggy and will throw an error if the number of columns
* zero, Harbour would return .F.
*
* The CA-Clipper 5.2 NG state that the return value is NIL, this is
* wrong and should be read logical.
*
* There is an undocumented result code (3) from the user defined
* function in Clipper (both 87 and 5.x). This is an Append Mode which:
* "split the screen to allow data to be appended in windowed area".
* This mode is not supported by Harbour.
* $FILES$
* Header files are dbedit.ch, inkey.ch
* $SEEALSO$
* @...SAY, BROWSE(), TBrowse class, TRANSFORM()
* $END$
*/
FUNCTION dbEdit(;
nTop,;
nLeft,;

70
harbour/source/rtl/dircmd.prg
View File

@@ -33,9 +33,79 @@
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Chen Kedem <niki@actcom.co.il>
* __DIR() documentation
*
* See doc/license.txt for licensing terms.
*
*/
#include "directry.ch"
#include "fileio.ch"
/* $DOC$
* $FUNCNAME$
* __Dir()* (DIR command)
* $CATEGORY$
* File management
* $ONELINER$
* Display listings of files
* $SYNTAX$
* __Dir( [<cFileMask>] ) --> NIL
*
* or
*
* DIR [<cFileMask>]
* $ARGUMENTS$
* <cFileMask> File mask to include in the function return. It could
* contain path and standard wildcard characters as supported by your
* OS (like * and ?). If <cFileMask> contain no path, then SET DEFAULT
* path is used to display files in the mask.
* $RETURNS$
* __Dir() always returns NIL.
* $DESCRIPTION$
* If no <cFileMask> is given, __Dir() display information about all
* *.dbf in the SET DEFAULT path, this information contain: file name,
* number of records, last update date and the size of each file.
*
* If <cFileMask> is given, __Dir() list all files that match the mask
* with the following details: Name, Extension, Size, Date.
*
* DIR command is preprocessed into __Dir() function during compile
* time.
*
* __Dir() is a compatibility function, it is superseded by DIRECTORY()
* which return all the information in a multidimensional array.
* $EXAMPLES$
* __Dir() // information for all DBF files in current directory
*
* __Dir( "*.dbf" ) // list all DBF file in current directory
*
* // list all PRG files in Harbour Run-Time library
* // for DOS compatible operating systems
* __Dir( "c:\harbour\source\rtl\*.prg" )
*
* // list all files in the public section on a Unix like machine
* __Dir( "/pub" )
* $TESTS$
* $STATUS$
* $COMPLIANCE$
* DBF information: CA-Clipper display 8.3 file names, Harbour display
* the first 15 characters of a long file name if available.
*
* File listing: To format file names displayed we use something like:
* PadR( Name, 8 ) + " " + PadR( Ext, 3 )
* CA-Clipper use 8.3 file name, with Harbour it would probably cut
* long file names to feet this template.
* $SEEALSO$
* ADIR(), DIRECTORY(), SET DEFAULT
* $END$
*/
PROCEDURE __Dir( cFileMask )
LOCAL cPath
LOCAL cName

2
harbour/source/rtl/extend.c
View File

@@ -239,7 +239,7 @@ char * hb_pards( int iParam, ... )
char * hb_pardsbuff( char * szDate, int iParam, ... )
{
HB_TRACE(HB_TR_DEBUG, ("hb_pardsbuff(%d, ...)", iParam));
HB_TRACE(HB_TR_DEBUG, ("hb_pardsbuff(%p, %d, ...)", szDate, iParam));
if( ( iParam >= 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) )
{

5
harbour/tests/regress/make_c5x.bat
View File

@@ -13,8 +13,9 @@ clipper rt_misc.prg /w /n
clipper rt_str.prg /w /n
clipper rt_trans.prg /w /n
if %1.==. set _=rtlink
if not %1.==. set _=exospace
if "%1"=="" set _=rtlink
if not "%1"=="" set _=exospace
%_% out rt_main fi rt_main, rt_array, rt_date, rt_file, rt_hvm, rt_math, rt_misc, rt_str, rt_trans
del *.obj

14
harbour/tests/regress/rt_array.prg
View File

@@ -106,7 +106,7 @@ INIT PROCEDURE RT_InitStatics()
snLongN := -100000
snDoubleN := -10.567 /* Use different number of decimals than the default */
snDoubleI := 0 //Log( 0 )
sdDate := SToD( "19800101" )
sdDate := SToD( "19840325" )
sdDateE := SToD( "" )
slFalse := .F.
slTrue := .T.
@@ -215,19 +215,19 @@ FUNCTION Main_ARRAY()
TEST_LINE( aTail( { 1, 2 } ) , 2 )
TEST_LINE( aTail( ErrorNew() ) , NIL )
TEST_LINE( aSize() , NIL )
TEST_LINE( aSize( NIL ) , NIL )
TEST_LINE( aSize( {} ) , NIL )
TEST_LINE( aSize( ErrorNew() ) , NIL )
TEST_LINE( aSize( NIL, 0 ) , NIL )
TEST_LINE( aSize( NIL ) , "E BASE 2023 Argument error ASIZE " )
TEST_LINE( aSize( {} ) , "E BASE 2023 Argument error ASIZE " )
TEST_LINE( aSize( ErrorNew() ) , "E BASE 2023 Argument error ASIZE " )
TEST_LINE( aSize( NIL, 0 ) , "E BASE 2023 Argument error ASIZE " )
TEST_LINE( aSize( {}, 0 ) , "{.[0].}" )
TEST_LINE( aSize( ErrorNew(), 0 ) , "ERROR Object" )
TEST_LINE( aSize( NIL, 1 ) , NIL )
TEST_LINE( aSize( NIL, 1 ) , "E BASE 2023 Argument error ASIZE " )
TEST_LINE( aSize( {}, 1 ) , "{.[1].}" )
TEST_LINE( aSize( { 1, 2 }, 1 ) , "{.[1].}" )
TEST_LINE( aSize( { 1, "AAAA" }, 1 ) , "{.[1].}" )
TEST_LINE( aSize( { "BBB", "AAAA" }, 0 ) , "{.[0].}" )
TEST_LINE( aSize( ErrorNew(), 1 ) , "ERROR Object" )
TEST_LINE( aSize( NIL, -1 ) , NIL )
TEST_LINE( aSize( NIL, -1 ) , "E BASE 2023 Argument error ASIZE " )
TEST_LINE( aSize( {}, -1 ) , "{.[0].}" )
TEST_LINE( aSize( { 1 }, -1 ) , "{.[0].}" )
#ifdef __HARBOUR__

34
harbour/tests/regress/rt_date.prg
View File

@@ -106,7 +106,7 @@ INIT PROCEDURE RT_InitStatics()
snLongN := -100000
snDoubleN := -10.567 /* Use different number of decimals than the default */
snDoubleI := 0 //Log( 0 )
sdDate := SToD( "19800101" )
sdDate := SToD( "19840325" )
sdDateE := SToD( "" )
slFalse := .F.
slTrue := .T.
@@ -148,9 +148,9 @@ FUNCTION Main_DATE()
TEST_LINE( Year(NIL) , "E BASE 1112 Argument error YEAR F:S" )
TEST_LINE( Year(100) , "E BASE 1112 Argument error YEAR F:S" )
#ifdef __HARBOUR__
TEST_LINE( Year(@sdDate) , 1980 ) /* Bug in CA-Cl*pper, it returns: "E BASE 1112 Argument error YEAR F:S" */
TEST_LINE( Year(@sdDate) , 1984 ) /* Bug in CA-Cl*pper, it returns: "E BASE 1112 Argument error YEAR F:S" */
#endif
TEST_LINE( Year(sdDate) , 1980 )
TEST_LINE( Year(sdDate) , 1984 )
TEST_LINE( Year(sdDateE) , 0 )
TEST_LINE( Str(Year(SToD("19990905"))) , " 1999" )
@@ -159,9 +159,9 @@ FUNCTION Main_DATE()
TEST_LINE( Month(NIL) , "E BASE 1113 Argument error MONTH F:S" )
TEST_LINE( Month(100) , "E BASE 1113 Argument error MONTH F:S" )
#ifdef __HARBOUR__
TEST_LINE( Month(@sdDate) , 1 ) /* Bug in CA-Cl*pper, it returns: "E BASE 1113 Argument error MONTH F:S" */
TEST_LINE( Month(@sdDate) , 3 ) /* Bug in CA-Cl*pper, it returns: "E BASE 1113 Argument error MONTH F:S" */
#endif
TEST_LINE( Month(sdDate) , 1 )
TEST_LINE( Month(sdDate) , 3 )
TEST_LINE( Month(sdDateE) , 0 )
TEST_LINE( Str(Month(SToD("19990905"))) , " 9" )
@@ -170,9 +170,9 @@ FUNCTION Main_DATE()
TEST_LINE( Day(NIL) , "E BASE 1114 Argument error DAY F:S" )
TEST_LINE( Day(100) , "E BASE 1114 Argument error DAY F:S" )
#ifdef __HARBOUR__
TEST_LINE( Day(@sdDate) , 1 ) /* Bug in CA-Cl*pper, it returns: "E BASE 1114 Argument error DAY F:S" */
TEST_LINE( Day(@sdDate) , 25 ) /* Bug in CA-Cl*pper, it returns: "E BASE 1114 Argument error DAY F:S" */
#endif
TEST_LINE( Day(sdDate) , 1 )
TEST_LINE( Day(sdDate) , 25 )
TEST_LINE( Day(sdDateE) , 0 )
TEST_LINE( Str(Day(SToD("19990905"))) , " 5" )
@@ -185,9 +185,9 @@ FUNCTION Main_DATE()
TEST_LINE( Dow(NIL) , "E BASE 1115 Argument error DOW F:S" )
TEST_LINE( Dow(100) , "E BASE 1115 Argument error DOW F:S" )
#ifdef __HARBOUR__
TEST_LINE( Dow(@sdDate) , 3 ) /* Bug in CA-Cl*pper, it returns: "E BASE 1115 Argument error DOW F:S" */
TEST_LINE( Dow(@sdDate) , 1 ) /* Bug in CA-Cl*pper, it returns: "E BASE 1115 Argument error DOW F:S" */
#endif
TEST_LINE( Dow(sdDate) , 3 )
TEST_LINE( Dow(sdDate) , 1 )
TEST_LINE( Dow(sdDateE) , 0 )
TEST_LINE( Dow(SToD("20000222")) , 3 )
TEST_LINE( Dow(SToD("20000223")) , 4 )
@@ -206,9 +206,9 @@ FUNCTION Main_DATE()
TEST_LINE( CMonth(NIL) , "E BASE 1116 Argument error CMONTH F:S" )
TEST_LINE( CMonth(100) , "E BASE 1116 Argument error CMONTH F:S" )
#ifdef __HARBOUR__
TEST_LINE( CMonth(@sdDate) , "January" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1116 Argument error CMONTH F:S" */
TEST_LINE( CMonth(@sdDate) , "March" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1116 Argument error CMONTH F:S" */
#endif
TEST_LINE( CMonth(sdDate) , "January" )
TEST_LINE( CMonth(sdDate) , "March" )
TEST_LINE( CMonth(sdDateE) , "" )
TEST_LINE( CMonth(SToD("19990101")) , "January" )
TEST_LINE( CMonth(SToD("19990201")) , "February" )
@@ -228,9 +228,9 @@ FUNCTION Main_DATE()
TEST_LINE( CDow(NIL) , "E BASE 1117 Argument error CDOW F:S" )
TEST_LINE( CDow(100) , "E BASE 1117 Argument error CDOW F:S" )
#ifdef __HARBOUR__
TEST_LINE( CDow(@sdDate) , "Tuesday" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1117 Argument error CDOW F:S" */
TEST_LINE( CDow(@sdDate) , "Sunday" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1117 Argument error CDOW F:S" */
#endif
TEST_LINE( CDow(sdDate) , "Tuesday" )
TEST_LINE( CDow(sdDate) , "Sunday" )
TEST_LINE( CDow(sdDateE) , "" )
TEST_LINE( CDow(SToD("20000222")) , "Tuesday" )
TEST_LINE( CDow(SToD("20000223")) , "Wednesday" )
@@ -250,9 +250,9 @@ FUNCTION Main_DATE()
TEST_LINE( DToC(100) , "E BASE 1118 Argument error DTOC F:S" )
TEST_LINE( DToC("") , "E BASE 1118 Argument error DTOC F:S" )
#ifdef __HARBOUR__
TEST_LINE( DToC(@sdDate) , "1980.01.01" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1118 Argument error DTOC F:S" */
TEST_LINE( DToC(@sdDate) , "1984.03.25" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1118 Argument error DTOC F:S" */
#endif
TEST_LINE( DToC(sdDate) , "1980.01.01" )
TEST_LINE( DToC(sdDate) , "1984.03.25" )
TEST_LINE( DToC(sdDateE) , " . . " )
/* CTOD() */
@@ -271,9 +271,9 @@ FUNCTION Main_DATE()
TEST_LINE( DToS(NIL) , "E BASE 1120 Argument error DTOS F:S" )
TEST_LINE( DToS(100) , "E BASE 1120 Argument error DTOS F:S" )
#ifdef __HARBOUR__
TEST_LINE( DToS(@sdDate) , "19800101" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1120 Argument error DTOS F:S" */
TEST_LINE( DToS(@sdDate) , "19840325" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1120 Argument error DTOS F:S" */
#endif
TEST_LINE( DToS(sdDate) , "19800101" )
TEST_LINE( DToS(sdDate) , "19840325" )
TEST_LINE( DToS(sdDateE) , " " )
RETURN NIL

2
harbour/tests/regress/rt_file.prg
View File

@@ -108,7 +108,7 @@ INIT PROCEDURE RT_InitStatics()
snLongN := -100000
snDoubleN := -10.567 /* Use different number of decimals than the default */
snDoubleI := 0 //Log( 0 )
sdDate := SToD( "19800101" )
sdDate := SToD( "19840325" )
sdDateE := SToD( "" )
slFalse := .F.
slTrue := .T.

6
harbour/tests/regress/rt_hvm.prg
View File

@@ -106,7 +106,7 @@ INIT PROCEDURE RT_InitStatics()
snLongN := -100000
snDoubleN := -10.567 /* Use different number of decimals than the default */
snDoubleI := 0 //Log( 0 )
sdDate := SToD( "19800101" )
sdDate := SToD( "19840325" )
sdDateE := SToD( "" )
slFalse := .F.
slTrue := .T.
@@ -703,8 +703,8 @@ FUNCTION Main_HVM()
/* */
TEST_LINE( -Month(sdDate) , -1 )
TEST_LINE( Str(-(Month(sdDate))) , " -1" )
TEST_LINE( -Month(sdDate) , -3 )
TEST_LINE( Str(-(Month(sdDate))) , " -3" )
TEST_LINE( Str(-(Val("10"))) , " -10" )
TEST_LINE( Str(-(Val("100000"))) , " -100000" )
TEST_LINE( Str(-(Val("20.876"))) , " -20.876" )

49
harbour/tests/regress/rt_main.prg
View File

@@ -242,27 +242,27 @@ STATIC FUNCTION TEST_BEGIN( cParam )
/* NOTE: mxNotHere intentionally not declared */
PUBLIC mcLongerNameThen10Chars := "Long String Name!"
PUBLIC mcString := "HELLO"
PUBLIC mcStringE := ""
PUBLIC mcStringZ := "A" + Chr( 0 ) + "B"
PUBLIC mcStringW := Chr(13)+Chr(10)+Chr(141)+Chr(10)+Chr(9)
PUBLIC mnIntZ := 0
PUBLIC mnDoubleZ := 0.0
PUBLIC mnIntP := 10
PUBLIC mnLongP := 100000
PUBLIC mnDoubleP := 10.567
PUBLIC mnIntN := -10
PUBLIC mnLongN := -100000
PUBLIC mnDoubleN := -10.567
PUBLIC mnDoubleI := 0 //Log( 0 )
PUBLIC mdDate := SToD( "19800101" )
PUBLIC mdDateE := SToD( "" )
PUBLIC mlFalse := .F.
PUBLIC mlTrue := .T.
PUBLIC mcString := scString
PUBLIC mcStringE := scStringE
PUBLIC mcStringZ := scStringZ
PUBLIC mcStringW := scStringW
PUBLIC mnIntZ := snIntZ
PUBLIC mnDoubleZ := snDoubleZ
PUBLIC mnIntP := snIntP
PUBLIC mnLongP := snLongP
PUBLIC mnDoubleP := snDoubleP
PUBLIC mnIntN := snIntN
PUBLIC mnLongN := snLongN
PUBLIC mnDoubleN := snDoubleN
PUBLIC mnDoubleI := snDoubleI
PUBLIC mdDate := sdDate
PUBLIC mdDateE := sdDateE
PUBLIC mlFalse := slFalse
PUBLIC mlTrue := slTrue
PUBLIC moObject := ErrorNew()
PUBLIC muNIL := NIL
PUBLIC mbBlock := {|| NIL }
PUBLIC mbBlockC := {|| "(string)" }
PUBLIC muNIL := suNIL
PUBLIC mbBlock := sbBlock
PUBLIC mbBlockC := sbBlockC
PUBLIC maArray := { 9898 }
rddSetDefault( "DBFNTX" )
@@ -287,8 +287,8 @@ STATIC FUNCTION TEST_BEGIN( cParam )
w_TEST->TYPE_C := "<FieldValue>"
w_TEST->TYPE_C_E := ""
w_TEST->TYPE_D := STOD( "19800101" )
w_TEST->TYPE_D_E := STOD( "" )
w_TEST->TYPE_D := sdDate
w_TEST->TYPE_D_E := sdDateE
w_TEST->TYPE_M := "<MemoValue>"
w_TEST->TYPE_M_E := ""
w_TEST->TYPE_N_I := 100
@@ -556,8 +556,8 @@ INIT PROCEDURE RT_InitStatics()
snIntN := -10
snLongN := -100000
snDoubleN := -10.567 /* Use different number of decimals than the default */
snDoubleI := 0 //Log( 0 )
sdDate := SToD( "19800101" )
snDoubleI := 0 // Log( 0 )
sdDate := SToD( "19840325" )
sdDateE := SToD( "" )
slFalse := .F.
slTrue := .T.
@@ -590,3 +590,4 @@ INIT PROCEDURE RT_InitStatics()
saArray }
RETURN

14
harbour/tests/regress/rt_math.prg
View File

@@ -103,7 +103,7 @@ INIT PROCEDURE RT_InitStatics()
snLongN := -100000
snDoubleN := -10.567 /* Use different number of decimals than the default */
snDoubleI := 0 //Log( 0 )
sdDate := SToD( "19800101" )
sdDate := SToD( "19840325" )
sdDateE := SToD( "" )
slFalse := .F.
slTrue := .T.
@@ -162,7 +162,7 @@ FUNCTION Main_MATH()
TEST_LINE( Str(Sqrt(@snIntP)) , " 3.16" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1097 Argument error SQRT F:S" */
#endif
TEST_LINE( Str(Sqrt(4),21,18) , " 2.000000000000000000" )
TEST_LINE( Str(Sqrt(3),21,18) , " 1.732050807568877193" ) /* Bug in CA-Cl*pper 5.2e, it returns: " 1.732050807568877000" */
TEST_LINE( Str(Sqrt(3),21,18) , " 1.732050807568877293" ) /* Bug in CA-Cl*pper 5.2e, it returns: " 1.732050807568877000" */
/* ABS() */
@@ -174,10 +174,10 @@ FUNCTION Main_MATH()
#ifdef __HARBOUR__
TEST_LINE( Str(Abs(@snIntN)) , " 10" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1089 Argument error ABS F:S" */
#endif
TEST_LINE( Abs(Month(sdDate)) , 1 )
TEST_LINE( Abs(-Month(sdDate)) , 1 )
TEST_LINE( Str(Abs(Month(sdDate))) , " 1" )
TEST_LINE( Str(Abs(-Month(sdDate))) , " 1" )
TEST_LINE( Abs(Month(sdDate)) , 3 )
TEST_LINE( Abs(-Month(sdDate)) , 3 )
TEST_LINE( Str(Abs(Month(sdDate))) , " 3" )
TEST_LINE( Str(Abs(-Month(sdDate))) , " 3" )
TEST_LINE( Str(Abs(Val("0"))) , "0" )
TEST_LINE( Str(Abs(Val("-0"))) , " 0" )
TEST_LINE( Str(Abs(Val("150"))) , "150" )
@@ -421,7 +421,7 @@ FUNCTION Main_MATH()
TEST_LINE( Str(100 / 10.00 ) , " 10.00" )
TEST_LINE( Str(100 / 10.000 ) , " 10.00" )
TEST_LINE( Str(100.00 / 10.0 ) , " 10.00" )
TEST_LINE( Str(sdDate - sdDateE ) , " 2444240" )
TEST_LINE( Str(sdDate - sdDateE ) , " 2445785" )
TEST_LINE( Str(sdDate - sdDate ) , " 0" )
TEST_LINE( Str(1234567890 * 1234567890 ) , " 1524157875019052100" ) /* Bug in CA-Cl*pper, it returns: " 1524157875019052000" */

4
harbour/tests/regress/rt_misc.prg
View File

@@ -103,7 +103,7 @@ INIT PROCEDURE RT_InitStatics()
snLongN := -100000
snDoubleN := -10.567 /* Use different number of decimals than the default */
snDoubleI := 0 //Log( 0 )
sdDate := SToD( "19800101" )
sdDate := SToD( "19840325" )
sdDateE := SToD( "" )
slFalse := .F.
slTrue := .T.
@@ -221,7 +221,7 @@ FUNCTION Main_MISC()
TEST_LINE( NationMsg(11) , " - " )
TEST_LINE( NationMsg(12) , "Y/N" )
TEST_LINE( NationMsg(13) , "INVALID EXPRESSION" )
TEST_LINE( NationMsg(14) , "" )
TEST_LINE( NationMsg(14) , "" ) /* Bug in CA-Clipper 5.3a/b, it will return "ATSORT v1.3i x19 06/Mar/95" */
#ifndef __CLIPPER__ /* Causes GPF in CA-Cl*pper (5.2e International, 5.3b) */
TEST_LINE( NationMsg(200) , "" ) /* Bug in CA-Cl*pper, it will return "74?" or other trash */
#endif

26
harbour/tests/regress/rt_str.prg
View File

@@ -103,7 +103,7 @@ INIT PROCEDURE RT_InitStatics()
snLongN := -100000
snDoubleN := -10.567 /* Use different number of decimals than the default */
snDoubleI := 0 //Log( 0 )
sdDate := SToD( "19800101" )
sdDate := SToD( "19840325" )
sdDateE := SToD( "" )
slFalse := .F.
slTrue := .T.
@@ -609,9 +609,9 @@ FUNCTION Main_STR()
TEST_LINE( Pad(100000, 8, "-") , "100000--" )
TEST_LINE( Pad(-100000, 8, "-") , "-100000-" )
TEST_LINE( Pad(5000000000, 15) , "5000000000 ")
TEST_LINE( Pad(SToD("19800101"), 12) , "1980.01.01 " )
TEST_LINE( Pad(Year(SToD("19800101")), 5) , "1980 " )
TEST_LINE( Pad(Day(SToD("19800101")), 5) , "1 " )
TEST_LINE( Pad(SToD("19840325"), 12) , "1984.03.25 " )
TEST_LINE( Pad(Year(SToD("19840325")), 5) , "1984 " )
TEST_LINE( Pad(Day(SToD("19840325")), 5) , "25 " )
#ifdef __HARBOUR__
TEST_LINE( Pad(@scString, 10) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */
TEST_LINE( Pad(scString, @snIntP) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */
@@ -634,9 +634,9 @@ FUNCTION Main_STR()
TEST_LINE( PadR(100000, 8) , "100000 " )
TEST_LINE( PadR(100000, 8, "-") , "100000--" )
TEST_LINE( PadR(-100000, 8, "-") , "-100000-" )
TEST_LINE( PadR(SToD("19800101"), 12) , "1980.01.01 " )
TEST_LINE( PadR(Year(SToD("19800101")), 5) , "1980 " )
TEST_LINE( PadR(Day(SToD("19800101")), 5) , "1 " )
TEST_LINE( PadR(SToD("19840325"), 12) , "1984.03.25 " )
TEST_LINE( PadR(Year(SToD("19840325")), 5) , "1984 " )
TEST_LINE( PadR(Day(SToD("19840325")), 5) , "25 " )
#ifdef __HARBOUR__
TEST_LINE( PadR(@scString, 10) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */
TEST_LINE( PadR(scString, @snIntP) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */
@@ -659,9 +659,9 @@ FUNCTION Main_STR()
TEST_LINE( PadL(100000, 8) , " 100000" )
TEST_LINE( PadL(100000, 8, "-") , "--100000" )
TEST_LINE( PadL(-100000, 8, "-") , "--100000" )
TEST_LINE( PadL(SToD("19800101"), 12) , " 1980.01.01" )
TEST_LINE( PadL(Year(SToD("19800101")), 5) , " 1980" )
TEST_LINE( PadL(Day(SToD("19800101")), 5) , " 1" )
TEST_LINE( PadL(SToD("19840325"), 12) , " 1984.03.25" )
TEST_LINE( PadL(Year(SToD("19840325")), 5) , " 1984" )
TEST_LINE( PadL(Day(SToD("19840325")), 5) , " 25" )
#ifdef __HARBOUR__
TEST_LINE( PadL(@scString, 10) , " HELLO" ) /* Bug in CA-Cl*pper, it will return "" */
TEST_LINE( PadL(scString, @snIntP) , " HELLO" ) /* Bug in CA-Cl*pper, it will return "" */
@@ -684,9 +684,9 @@ FUNCTION Main_STR()
TEST_LINE( PadC(100000, 8) , " 100000 " )
TEST_LINE( PadC(100000, 8, "-") , "-100000-" )
TEST_LINE( PadC(-100000, 8, "-") , "-100000-" )
TEST_LINE( PadC(SToD("19800101"), 12) , " 1980.01.01 " )
TEST_LINE( PadC(Year(SToD("19800101")), 5) , "1980 " )
TEST_LINE( PadC(Day(SToD("19800101")), 5) , " 1 " )
TEST_LINE( PadC(SToD("19840325"), 12) , " 1984.03.25 " )
TEST_LINE( PadC(Year(SToD("19840325")), 5) , "1984 " )
TEST_LINE( PadC(Day(SToD("19840325")), 5) , " 25 " )
#ifdef __HARBOUR__
TEST_LINE( PadC(@scString, 10) , " HELLO " ) /* Bug in CA-Cl*pper, it will return "" */
TEST_LINE( PadC(scString, @snIntP) , " HELLO " ) /* Bug in CA-Cl*pper, it will return "" */

36
harbour/tests/regress/rt_trans.prg
View File

@@ -103,7 +103,7 @@ INIT PROCEDURE RT_InitStatics()
snLongN := -100000
snDoubleN := -10.567 /* Use different number of decimals than the default */
snDoubleI := 0 //Log( 0 )
sdDate := SToD( "19800101" )
sdDate := SToD( "19840325" )
sdDateE := SToD( "" )
slFalse := .F.
slTrue := .T.
@@ -179,9 +179,9 @@ FUNCTION Main_TRANS()
// TEST_LINE( Transform( Val("100.20"), "@" ) , "100.20" )
TEST_LINE( Transform( Val("100.20"), NIL ) , "100.20" )
TEST_LINE( Transform( Val("100.20"), 100 ) , "E BASE 1122 Argument error TRANSFORM F:S" )
TEST_LINE( Transform( sdDate, "" ) , "1980.01.01" )
TEST_LINE( Transform( sdDate, "@" ) , "1980.01.01" )
TEST_LINE( Transform( sdDate, NIL ) , "1980.01.01" )
TEST_LINE( Transform( sdDate, "" ) , "1984.03.25" )
TEST_LINE( Transform( sdDate, "@" ) , "1984.03.25" )
TEST_LINE( Transform( sdDate, NIL ) , "1984.03.25" )
TEST_LINE( Transform( sdDate, 100 ) , "E BASE 1122 Argument error TRANSFORM F:S" )
TEST_LINE( Transform( .T., "" ) , "T" )
TEST_LINE( Transform( .T., "@" ) , "T" )
@@ -451,22 +451,22 @@ FUNCTION Main_TRANS()
TEST_LINE( Transform(" H", "@Z" ) , " " )
TEST_LINE( Transform(" H", "@ZB" ) , " " )
TEST_LINE( Transform(" H", "@!" ) , " H" )
TEST_LINE( Transform("19800101", "@D" ) , "1980.10." )
TEST_LINE( Transform("19800101", "@DE" ) , "0.81910." )
TEST_LINE( Transform("1980010198765", "@DE" ) , "0.81910.98" )
TEST_LINE( Transform("19840325", "@D" ) , "1984.32." )
TEST_LINE( Transform("19840325", "@DE" ) , "4.81932." )
TEST_LINE( Transform("1984032598765", "@DE" ) , "4.81932.98" )
SET CENTURY ON
TEST_LINE( Transform("19800101", "@D" ) , "1980.10." )
TEST_LINE( Transform("19800101", "@DE" ) , "0.81910." )
TEST_LINE( Transform("1980010198765", "@DE" ) , "0.81910.98" )
TEST_LINE( Transform("19840325", "@D" ) , "1984.32." )
TEST_LINE( Transform("19840325", "@DE" ) , "4.81932." )
TEST_LINE( Transform("1984032598765", "@DE" ) , "4.81932.98" )
SET CENTURY OFF
TEST_LINE( Transform("19800101", "@D" ) , "19.00.01" )
TEST_LINE( Transform("19800101", "@DE" ) , "00.19.01" )
TEST_LINE( Transform("1980010198765", "@DE" ) , "00.19.01" )
TEST_LINE( Transform("19840325", "@D" ) , "19.40.25" )
TEST_LINE( Transform("19840325", "@DE" ) , "40.19.25" )
TEST_LINE( Transform("1984032598765", "@DE" ) , "40.19.25" )
TEST_LINE( Transform("1", "@D" ) , "1" )
TEST_LINE( Transform("19800101", "@D" ) , "19.00.01" )
TEST_LINE( Transform("19800101", "@DR" ) , "19.80.01" )
TEST_LINE( Transform("19840325", "@D" ) , "19.40.25" )
TEST_LINE( Transform("19840325", "@DR" ) , "19.84.03" )
TEST_LINE( Transform("ABCDEFG", "@D" ) , "AB.DE.G" )
TEST_LINE( Transform("abcdefg", "@D !!") , "ab.de.g" )
TEST_LINE( Transform("abcdefg", "@D!") , "AB.DE.G" )
@@ -496,9 +496,9 @@ FUNCTION Main_TRANS()
TEST_LINE( Transform(0, "@B(X $99999") , "$ 0" )
TEST_LINE( Transform(0, "@B(ZX $99999") , " " )
TEST_LINE( Transform(Date(), NIL) , "99.11.30" )
TEST_LINE( Transform(Date(), "") , "99.11.30" )
TEST_LINE( Transform(Date(), "@Z") , " " )
TEST_LINE( Transform(sdDate, NIL) , "84.03.25" )
TEST_LINE( Transform(sdDate, "") , "84.03.25" )
TEST_LINE( Transform(sdDate, "@Z") , " " )
SET(_SET_DATEFORMAT, "DD/MMM/YYYY")