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

make files

Browse Source
This commit is contained in:
Antonio Linares
1999-05-05 05:45:23 +00:00
parent 9d457f6e48
commit 974bc2fbc2
81 changed files with 3217 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
harbour/bldtls32.bat Normal file
View File

@@ -0,0 +1 @@
make -ftools.b32

1
harbour/bldtools.bat Normal file
View File

@@ -0,0 +1 @@
make -ftools.b16

1
harbour/build.bat Normal file
View File

@@ -0,0 +1 @@
make -fmakefile.b16

1
harbour/build32.bat Normal file
View File

@@ -0,0 +1 @@
make -fmakefile.b32

1
harbour/buildvc.bat Normal file
View File

@@ -0,0 +1 @@
nmake /f makefile.vc

14
harbour/include/ctoharb.h Normal file
View File

@@ -0,0 +1,14 @@
// Calling Harbour from C code
/* executing Harbour code from C */
void PushSymbol( PSYMBOL pSym ); /* pushes a function pointer onto the stack */
void Push( PITEM pItem ); /* pushes any item to the stack */
void PushNil( void ); /* in this case it places nil at self */
/* parameters should come here using Push...() */
void PushInteger( int iNumber );
void PushLong( long lNumber );
void PushDouble( double dNumber );
void PushString( char * szText, WORD wLength ); /* pushes a string on to the stack */
void Do( WORD wParams ); /* invokes the virtual machine */
void Function( WORD wParams ); /* invokes the virtual machine */
void StackShow( void );

6
harbour/include/dates.h Normal file
View File

@@ -0,0 +1,6 @@
#ifndef _DATES_H
#define _DATES_H
char * hb_dtoc (char * szDate, char * szDateFormat);
#endif

31
harbour/include/error.api Normal file
View File

@@ -0,0 +1,31 @@
// error.api
//
#ifndef _ERROR_API
#define _ERROR_API
//+
// Harbour project
//
// 99.04.25 initial posting.
// compatible
//-
#include "error.ch"
//
// error flag definations
//
#define EF_CANRETRY 1
#define EF_CANDEFAULT 4
//
// error codes (returned from _errLaunch())
//
#define E_BREAK 0xffff
#define E_RETRY 1
#define E_DEFAULT 0
#endif

63
harbour/include/error.ch Normal file
View File

@@ -0,0 +1,63 @@
// error.ch
//+
// Harbour project
//
//
// 99.04.25 initial posting.
// no prototypes yet
//
//
//-
// Severity levels (oError:severity)
#define ES_WHOCARES 0
#define ES_WARNING 1
#define ES_ERROR 2
#define ES_CATASTROPHIC 3
// Generic error codes (oError:genCode)
#define EG_ARG 1
#define EG_BOUND 2
#define EG_STROVERFLOW 3
#define EG_NUMOVERFLOW 4
#define EG_ZERODIV 5
#define EG_NUMERR 6
#define EG_SYNTAX 7
#define EG_COMPLEXITY 8
#define EG_MEM 11
#define EG_NOFUNC 12
#define EG_NOMETHOD 13
#define EG_NOVAR 14
#define EG_NOALIAS 15
#define EG_NOVARMETHOD 16
#define EG_BADALIAS 17
#define EG_DUPALIAS 18
#define EG_CREATE 20
#define EG_OPEN 21
#define EG_CLOSE 22
#define EG_READ 23
#define EG_WRITE 24
#define EG_PRINT 25
#define EG_UNSUPPORTED 30
#define EG_LIMIT 31
#define EG_CORRUPTION 32
#define EG_DATATYPE 33
#define EG_DATAWIDTH 34
#define EG_NOTABLE 35
#define EG_NOORDER 36
#define EG_SHARED 37
#define EG_UNLOCKED 38
#define EG_READONLY 39
#define EG_APPENDLOCK 40
#define EG_LOCK 41
#define _ERROR_CH

165
harbour/include/extend.h Normal file
View File

@@ -0,0 +1,165 @@
#ifndef _EXTEND_H
#define _EXTEND_H
#include <limits.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <types.h>
typedef struct /* symbol support structure */
{
char * szName; /* the name of the symbol */
char cScope; /* the scope of the symbol */
HARBOURFUNC pFunPtr; /* function address for function symbol table entries */
void * pDynSym; /* pointer to its dynamic symbol if defined */
} SYMBOL, * PSYMBOL;
/* Harbour Functions scope */
#define FS_PUBLIC 0
#define FS_STATIC 2
#define FS_INIT 8
#define FS_EXIT 16
#define FS_MESSAGE 32
void VirtualMachine( PBYTE pCode, PSYMBOL pSymbols ); /* invokes the virtual machine */
/* items types */
#define IT_NIL 0x0000
#define IT_INTEGER 0x0002
#define IT_LONG 0x0008
#define IT_DOUBLE 0x0010
#define IT_DATE 0x0020
#define IT_LOGICAL 0x0080
#define IT_SYMBOL 0x0100
#define IT_ALIAS 0x0200
#define IT_BLOCK 0x1000
#define IT_STRING 0x0400
#define IT_BYREF 0x2000
#define IT_ARRAY 0x8000
#define IT_OBJECT IT_ARRAY
#define IT_NUMERIC ( IT_INTEGER | IT_LONG | IT_DOUBLE )
#define IT_ANY 0xFFFF
typedef struct /* items hold at the virtual machine stack */
{
WORD wType; /* type of the item */
WORD wLength; /* length of the item */
WORD wDec; /* decimal places in a numeric double item */
union { /* different things may be holded here */
char * szText; /* string values */
int iNumber; /* int values */
long lNumber; /* long values */
double dNumber; /* double values */
int iLogical; /* logical values */
long lDate; /* date values */
PSYMBOL pSymbol; /* functions call symbol */
BYTE * pCodeblock;/* pointer to a codeblock structure */
WORD wItem; /* variable by reference, stack offset */
void * pBaseArray; /* array base */
} value;
WORD wBase; /* stack frame number of items position for a function call */
PSYMBOL pSymbols; /* codeblocks symbols */
WORD wLine; /* currently processed PRG line number */
WORD wParams; /* number of received parameters for a function call */
} ITEM, * PITEM;
typedef struct
{
PITEM pItems; /* pointer to the array items */
ULONG ulLen; /* number of items in the array */
WORD wHolders; /* number of holders of this array */
WORD wClass; /* offset to the classes base if it is an object */
} BASEARRAY, * PBASEARRAY;
typedef struct /* stack managed by the virtual machine */
{
PITEM pItems; /* pointer to the stack items */
PITEM pPos; /* pointer to the latest used item */
LONG wItems; /* total items that may be holded on the stack */
ITEM Return; /* latest returned value */
PITEM pBase; /* stack frame position for the current function call */
PITEM pEvalBase;/* stack frame position for the evaluated codeblock */
int iStatics; /* statics base for the current function call */
char szDate[ 9 ]; /* last returned date from _pards() yyyymmdd format */
} STACK;
typedef struct
{
WORD wArea; /* Workarea number */
WORD wMemvar; /* Index number into memvars ( publics & privates ) array */
PSYMBOL pSymbol; /* pointer to its relative local symbol */
HARBOURFUNC pFunPtr; /* Pointer to the function address */
} DYNSYM, * PDYNSYM; /* dynamic symbol structure */
/* internal structure for codeblocks */
typedef struct
{
BYTE * pCode; /* codeblock pcode */
PITEM pItems; /* table with referenced local variables */
WORD wLocals; /* number of referenced local variables */
WORD wDetached; /* holds if pItems table variables values */
PSYMBOL pSymbols; /* codeblocks symbols */
WORD wRefBase; /* stack frame position for referenced local variables */
long lCounter; /* numer of references to this codeblock */
} CODEBLOCK, * PCODEBLOCK;
PITEM _param( WORD wParam, WORD wType ); /* retrieve a generic parameter */
char * _parc( WORD wParam, ... ); /* retrieve a string parameter */
ULONG _parclen( WORD wParam, ... ); /* retrieve a string parameter length */
char * _pards( WORD wParam, ... ); /* retrieve a date as a string yyyymmdd */
int _parl( WORD wParam, ... ); /* retrieve a logical parameter as an int */
double _parnd( WORD wParam, ... ); /* retrieve a numeric parameter as a double */
int _parni( WORD wParam, ... ); /* retrieve a numeric parameter as a integer */
long _parnl( WORD wParam, ... ); /* retrieve a numeric parameter as a long */
WORD _parinfo( WORD wParam ); /* Determine the param count or data type */
WORD _pcount( void ); /* returns the number of suplied parameters */
void _ret( void ); /* post a NIL return value */
void _retc( char * szText ); /* returns a string */
void _retclen( char * szText, ULONG ulLen ); /* returns a string with a specific length */
void _retds( char * szDate ); /* returns a date, must use yyyymmdd format */
void _retl( int iTrueFalse ); /* returns a logical integer */
void _retni( int iNumber ); /* returns a integer number */
void _retnl( long lNumber ); /* returns a long number */
void _retnd( double dNumber ); /* returns a double */
void _storc( char * szText, WORD wParam, ... ); /* stores a szString on a variable by reference */
void _storclen( char * fixText, WORD wLength, WORD wParam, ... ); /* stores a fixed length string on a variable by reference */
void _stords( char * szDate, WORD wParam, ... ); /* szDate must have yyyymmdd format */
void _storl( int iLogical, WORD wParam, ... ); /* stores a logical integer on a variable by reference */
void _storni( int iValue, WORD wParam, ... ); /* stores an integer on a variable by reference */
void _stornd( double dValue, WORD wParam, ... ); /* stores a double on a variable by reference */
void _stornl( long lValue, WORD wParam, ... ); /* stores a long on a variable by reference */
void * _xgrab( ULONG lSize ); /* allocates memory */
void * _xrealloc( void * pMem, ULONG lSize ); /* reallocates memory */
void _xfree( void * pMem ); /* frees memory */
void ItemCopy( PITEM pDest, PITEM pSource );
void ItemRelease( PITEM pItem );
void Array( PITEM pItem, ULONG ulLen ); /* creates a new array */
void ArrayGet( PITEM pArray, ULONG ulIndex, PITEM pItem ); /* retrieves an item */
int ArrayLen( PITEM pArray ); /* retrives the array len */
void ArraySet( PITEM pArray, ULONG ulIndex, PITEM pItem ); /* sets an array element */
void ArraySize( PITEM pArray, ULONG ulLen ); /* sets the array total length */
void ArrayRelease( PITEM pArray ); /* releases an array - don't call it - use ItemRelease() !!! */
char * ArrayGetString( PITEM pArray, ULONG ulIndex ); /* retrieves the string contained on an array element */
ULONG ArrayGetStringLen( PITEM pArray, ULONG ulIndex ); /* retrieves the string length contained on an array element */
int OurStrCmp( PITEM pFirst, PITEM pSecond ); /* our string compare */
HARBOURFUNC GetMethod( PITEM pObject, PSYMBOL pSymMsg ); /* returns the method pointer of a object class */
char * _GetClassName( PITEM pObject ); /* retrieves an object class name */
/* dynamic symbol table management */
PDYNSYM GetDynSym( char * szName ); /* finds and creates a dynamic symbol if not found */
PDYNSYM NewDynSym( PSYMBOL pSymbol ); /* creates a new dynamic symbol based on a local one */
/* error API */
PITEM _errNew( void );
void _errPutDescription( PITEM pError, char * szDescription );
WORD _errLaunch( PITEM pError );
void _errRelease( PITEM pError );
#endif

39
harbour/include/init.h Normal file
View File

@@ -0,0 +1,39 @@
/* Harbour local symbols initialization */
void ProcessSymbols( SYMBOL * pSymbols, WORD wSymbols );
#ifdef __GNUC__
static void __attribute__ ((constructor)) InitSymbols( void )
{
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) );
}
#endif
#ifdef __BORLANDC__
static void InitSymbols( void )
{
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) );
}
#pragma startup InitSymbols
#endif
#ifdef _MSC_VER
static int InitSymbols( void )
{
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) );
return 1;
}
static int q = InitSymbols();
#endif
#ifdef __WATCOMC__
static int InitSymbols( void )
{
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) );
return 1;
}
static int _STATIC_INT_INIT_SYMBOLS = InitSymbols();
#endif

37
harbour/include/itemapi.h Normal file
View File

@@ -0,0 +1,37 @@
#include <extend.h>
typedef struct
{
WORD type;
WORD paramCount;
PITEM pItems[ 10 ];
} EVALINFO, * PEVALINFO;
PITEM _evalLaunch( PEVALINFO pEvalInfo );
BOOL _evalNew( PEVALINFO pEvalInfo, PITEM pItem );
BOOL _evalPutParam( PEVALINFO pEvalInfo, PITEM pItem );
BOOL _evalRelease( PEVALINFO pEvalInfo );
PITEM _itemArrayGet( PITEM pArray, ULONG ulIndex );
PITEM _itemArrayNew( ULONG ulLen );
PITEM _itemArrayPut( PITEM pArray, ULONG ulIndex, PITEM pItem );
ULONG _itemCopyC( PITEM pItem, char *szBuffer, ULONG ulLen );
BOOL _itemFreeC( char *szText );
char * _itemGetC( PITEM pItem );
char *_itemGetDS( PITEM pItem, char *szDate );
BOOL _itemGetL( PITEM pItem );
double _itemGetND( PITEM pItem );
long _itemGetNL( PITEM pItem );
PITEM _itemNew( PITEM pNull );
PITEM _itemParam( WORD wParam );
PITEM _itemPutC( PITEM pItem, char *szText );
PITEM _itemPutCL( PITEM pItem, char *nszText, ULONG ulLen );
PITEM _itemPutDS( PITEM pItem, char *szDate );
PITEM _itemPutL( PITEM pItem, BOOL bValue );
PITEM _itemPutND( PITEM pItem, double dNumber );
PITEM _itemPutNL( PITEM pItem, long lNumber );
BOOL _itemRelease( PITEM pItem );
PITEM _itemReturn( PITEM pItem );
ULONG _itemSize( PITEM pItem );
WORD _itemType( PITEM pItem );

72
harbour/include/pcode.h Normal file
View File

@@ -0,0 +1,72 @@
#ifndef _PCODE_H
#define _PCODE_H
#include <extend.h>
typedef enum
{
_AND, /* peforms the logical AND of two latest stack values, removes them and places result */
_ARRAYAT, /* places on the virtual machine stack an array element */
_ARRAYPUT, /* sets array element, the array and the index are both on the stack */
_EQUAL, /* check if the latest two values on the stack are equal, removing them and leaving there the result */
_ENDBLOCK, /* end of a codeblock definition */
_ENDPROC, /* instructs the virtual machine to end execution */
_FALSE, /* pushes false on the virtual machine stack */
_FORTEST, /* For STEP. If step > 1 less. If step < 1 greater. */
_FUNCTION, /* instructs the virtual machine to execute a function saving its result */
_FRAME, /* instructs the virtual machine about how many parameters and locals a function uses */
_FUNCPTR, /* returns a function address pointer */
_GENARRAY, /* instructs the virtual machine to build an array and load elemnst from the stack */
_GREATER, /* checks if the second latest value on the stack is greater that the lastest one */
_GREATEREQUAL,/* checks if the second latest value on the stack is greater equal that the latest one, leaves the result only */
_DEC, /* decrements the latest value on the virtual machine stack */
_DIMARRAY, /* instructs the virtual machine to build an array with some specific dimensions */
_DIVIDE, /* divides the latest two values on the stack, removing them and leaving there the result */
_DO, /* instructs the virtual machine to execute a function discarding its result */
_DUPLICATE, /* places a copy of the latest virtual machine stack value on to the stack */
_INC, /* increments the latest value on the virtual machine stack */
_INSTRING, /* checks if the second latest value on the stack is a substring of the latest one */
_JUMP, /* jumps to a relative offset */
_JUMPFALSE, /* checks a logic expression of the stack and jumps to a relative offset */
_JUMPTRUE, /* checks a logic expression of the stack and jumps to a relative offset */
_LESSEQUAL, /* checks if the second latest value on the stack is less equal that the latest one, leaves the result only */
_LESS, /* checks if the second latest value on the stack is less that the lastest one */
_LINE, /* currently compiled source code line number */
_MESSAGE, /* sends a message to an object */
_MINUS, /* subs the latest two values on the stack, removing them and leaving there the result */
_MODULUS, /* calculates the modulus of the two values on the stack, removing them and leaving there the result */
_MULT, /* multiplies the latest two values on the stack, removing them and leaving there the result */
_NEGATE, /* numerically negates the latest value on the stack */
_NOT, /* logically negates the latest value on the stack */
_NOTEQUAL, /* checks if the latest two stack values are equal, leaves just the result */
_OR, /* peforms the logical OR of two latest stack values, removes them and places result */
_PLUS, /* adds the latest two values on the stack, removing them and leaving there the result */
_POP, /* removes the latest value from the stack */
_POPDEFSTAT, /* pops a default value to a static variable */
_POPLOCAL, /* pops the contains of the virtual machine stack onto a local variable */
_POPMEMVAR, /* pops the contains of a memvar variable to the virtual machine stack */
_POPSTATIC, /* pops the contains of the virtual machine stack onto a static variable */
_POWER, /* calculates the power of the two values on the stack, removing them and leaving there the result */
_PUSHBLOCK, /* start of a codeblock definition */
_PUSHINT, /* places an integer number on the virtual machine stack */
_PUSHLOCAL, /* pushes the contains of a local variable to the virtual machine stack */
_PUSHLOCALREF, /* pushes a local variable by reference to the virtual machine stack */
_PUSHLONG, /* places an integer number on the virtual machine stack */
_PUSHMEMVAR, /* pushes the contains of a memvar variable to the virtual machine stack */
_PUSHMEMVARREF, /* pushes the a memvar variable by reference to the virtual machine stack */
_PUSHNIL, /* places a nil on the virtual machine stack */
_PUSHDOUBLE, /* places a double number on the virtual machine stack */
_PUSHSELF, /* pushes Self for the current processed method */
_PUSHSTATIC, /* pushes the contains of a static variable to the virtual machine stack */
_PUSHSTATICREF, /* pushes the a static variable by reference to the virtual machine stack */
_PUSHSTR, /* places a string on the virtual machine stack */
_PUSHSYM, /* places a symbol on the virtual machine stack */
_PUSHWORD, /* places a two bytes number on the virtual machine stack */
_RETVALUE, /* instructs the virtual machine to return the latest stack value */
_SFRAME, /* sets the statics frame for a function */
_STATICS, /* defines the number of statics variables for a PRG */
_TRUE, /* pushes true on the virtual machine stack */
_ZERO /* places a zero on the virtual machine stack */
} PCODE;
#endif

120
harbour/include/set.h Normal file
View File

@@ -0,0 +1,120 @@
#ifndef _SET_H
#define _SET_H
#include <types.h>
HARBOUR SET (void);
HARBOUR __SETCENTURY (void);
void HB_init_set (void);
void ReleaseSets (void);
typedef enum
{
SC_NONE = 0, /* None */
SC_NORMAL = 1, /* Underline */
SC_INSERT = 2, /* Lower half block */
SC_SPECIAL1 = 3, /* Full block */
SC_SPECIAL2 = 4 /* Upper half block */
} HB_cursor_enum;
typedef enum
{
INKEY_MOVE = 1, /* Mouse Events */
INKEY_LDOWN = 2, /* Mouse Left Click Down */
INKEY_LUP = 4, /* Mouse Left Click Up */
INKEY_RDOWN = 8, /* Mouse Right Click Down */
INKEY_RUP = 16, /* Mouse Right Click Up */
INKEY_KEYBOARD = 128, /* Keyboard Events */
INKEY_ALL = 159 /* All Mouse and Keyboard Events */
} HB_inkey_enum;
typedef enum
{
_SET_ALTERNATE = 1,
_SET_ALTFILE = 2,
_SET_BELL = 3,
_SET_CANCEL = 4,
_SET_COLOR = 5,
_SET_CONFIRM = 6,
_SET_CONSOLE = 7,
_SET_CURSOR = 8,
_SET_DATEFORMAT = 9,
_SET_DEBUG = 10,
_SET_DECIMALS = 11,
_SET_DEFAULT = 12,
_SET_DELETED = 13,
_SET_DELIMCHARS = 14,
_SET_DELIMITERS = 15,
_SET_DEVICE = 16,
_SET_EPOCH = 17,
_SET_ESCAPE = 18,
_SET_EVENTMASK = 19,
_SET_EXACT = 20,
_SET_EXCLUSIVE = 21,
_SET_EXIT = 22,
_SET_EXTRA = 23,
_SET_EXTRAFILE = 24,
_SET_FIXED = 25,
_SET_INSERT = 26,
_SET_INTENSITY = 27,
_SET_MARGIN = 28,
_SET_MCENTER = 29,
_SET_MESSAGE = 30,
_SET_PATH = 31,
_SET_PRINTER = 32,
_SET_PRINTFILE = 33,
_SET_SCOREBOARD = 34,
_SET_SCROLLBREAK = 35,
_SET_SOFTSEEK = 36,
_SET_TYPEAHEAD = 37,
_SET_UNIQUE = 38,
_SET_WRAP = 39
} HB_set_enum;
typedef struct
{
BOOL _SET_ALTERNATE; /* Logical */
char *_SET_ALTFILE; /* Character */
BOOL _SET_BELL; /* Logical */
BOOL _SET_CANCEL; /* Logical */
char *_SET_COLOR; /* Character */
BOOL _SET_CONFIRM; /* Logical */
BOOL _SET_CONSOLE; /* Logical */
HB_cursor_enum _SET_CURSOR; /* Numeric */
char *_SET_DATEFORMAT; /* Character */
BOOL _SET_DEBUG; /* Logical */
int _SET_DECIMALS; /* Numeric */
char *_SET_DEFAULT; /* Character */
BOOL _SET_DELETED; /* Logical */
char *_SET_DELIMCHARS; /* Character */
BOOL _SET_DELIMITERS; /* Logical */
char * _SET_DEVICE; /* Character */
int _SET_EPOCH; /* Numeric */
BOOL _SET_ESCAPE; /* Logical */
HB_inkey_enum _SET_EVENTMASK; /* Numeric */
BOOL _SET_EXACT; /* Logical */
BOOL _SET_EXCLUSIVE; /* Logical */
BOOL _SET_EXIT; /* Logical */
BOOL _SET_EXTRA; /* Logical */ /* QUESTION: What does this do? */
char *_SET_EXTRAFILE; /* Character */ /* QUESTION: What does this do? */
BOOL _SET_FIXED; /* Logical */
BOOL _SET_INSERT; /* Logical */
BOOL _SET_INTENSITY; /* Logical */
int _SET_MARGIN; /* Numeric */
BOOL _SET_MCENTER; /* Logical */
int _SET_MESSAGE; /* Numeric */
char *_SET_PATH; /* Character */
BOOL _SET_PRINTER; /* Logical */
char *_SET_PRINTFILE; /* Character */
BOOL _SET_SCOREBOARD; /* Logcial */
int _SET_SCROLLBREAK; /* Logical */ /* QUESTION: What does this do? */
BOOL _SET_SOFTSEEK; /* Logical */
int _SET_TYPEAHEAD; /* Numeric */
BOOL _SET_UNIQUE; /* Logical */
BOOL _SET_WRAP; /* Logical */
} HB_set_struct;
extern HB_set_struct HB_set;
extern BOOL HB_set_century;
#endif

73
harbour/include/types.h Normal file
View File

@@ -0,0 +1,73 @@
#ifndef _TYPES_H
#define _TYPES_H
#undef BYTE
typedef unsigned char BYTE, * PBYTE; /* 1 byte */
#undef WORD /* 2 bytes unsigned */
typedef unsigned short int WORD;
#undef SHORT /* 2 bytes signed */
typedef short int SHORT;
#undef LONG /* 4 bytes unsigned */
typedef long LONG;
typedef unsigned long ULONG;
#undef DWORD /* 4 bytes unsigned */
typedef unsigned long DWORD;
#undef FALSE
#undef TRUE
#define FALSE 0
#define TRUE 1
typedef int BOOL;
#undef PVOID
typedef void * PVOID;
#define LOBYTE(w) ((BYTE)(w))
#define HIBYTE(w) ((BYTE)(((WORD)(w) >> 8) & 0xFF))
#define LOWORD(l) ((WORD)(l))
#ifdef __GNUC__
#define pascal __attribute__ ((stdcall))
#endif
#ifdef _MSC_VER
#define HARBOUR void
#else
#define HARBOUR void pascal
#endif
typedef HARBOUR ( * HARBOURFUNC )( void );
#ifndef _POSIX_PATH_MAX
#define _POSIX_PATH_MAX 255
#endif
#define IS_OF_TYPE( p, t ) ( ( p )->wType == t )
#define IS_ARRAY( p ) IS_OF_TYPE( p, IT_ARRAY )
#define IS_BYREF( p ) IS_OF_TYPE( p, IT_BYREF )
#define IS_NIL( p ) IS_OF_TYPE( p, IT_NIL )
#define IS_BLOCK( p ) IS_OF_TYPE( p, IT_BLOCK )
#define IS_DATE( p ) IS_OF_TYPE( p, IT_DATE )
#define IS_DOUBLE( p ) IS_OF_TYPE( p, IT_DOUBLE )
#define IS_INTEGER( p ) IS_OF_TYPE( p, IT_INTEGER )
#define IS_LOGICAL( p ) IS_OF_TYPE( p, IT_LOGICAL )
#define IS_LONG( p ) IS_OF_TYPE( p, IT_LONG )
#define IS_NUMERIC( p ) ( ( p )->wType & IT_NUMERIC )
#define IS_OBJECT( p ) IS_OF_TYPE( p, IT_ARRAY )
#define IS_STRING( p ) IS_OF_TYPE( p, IT_STRING )
#define IS_SYMBOL( p ) IS_OF_TYPE( p, IT_SYMBOL )
#define _PCOUNT _parinfo( 0 )
#define ISCHAR( n ) _param( n, IT_STRING )
#define ISNUM( n ) _param( n, IT_NUMERIC )
#define ISLOG( n ) _param( n, IT_LOGICAL )
#define ISDATE( n ) _param( n, IT_DATE )
/* #define ISMEMO( n ) _param( n, IT_MEMO ) TODO */
#define ISBYREF( n ) _param( n, IT_BYREF )
#define ISARRAY( n ) _param( n, IT_ARRAY )
#define ALENGTH( n ) _parinfa( n, 0 ) /* TODO! */
#endif

11
harbour/makedos.env Normal file
View File

@@ -0,0 +1,11 @@
# Makefile definitions for DOS DJGPP
#
# HARBOURDIR: should be set to directory where the Harbour project is installed
#
#
HARBOURDIR=h:/harbour/harbour
HARBOURLIB=$(HARBOURDIR)/libs/libharb.a
# compiler macros for DOS DJGPP
CC=gcc
CFLAGS=-Wall -g -DDEBUG -I$(HARBOURDIR)/include -x c

72
harbour/makefile.b16 Normal file
View File

@@ -0,0 +1,72 @@
# makefile for Borland C/C++ 16 bits
.path.c = source\compiler;source\vm;source\rtl;source\tools
.path.h = include
.path.l = source\compiler
.path.y = source\compiler
.path.exe = bin
.path.lib = libs\b16
.path.obj = obj
.path.prg = source\rtl
PROJECT: harbour.lib libs\b16\terminal.lib libs\win16\terminal.lib harbour.exe
harbour.lib : arrays.obj classes.obj codebloc.obj dates.obj datesx.obj dynsym.obj \
environ.obj error.obj \
errorapi.obj errorsys.obj extend.obj files.obj itemapi.obj math.obj \
mathx.obj set.obj strings.obj stringsx.obj strcmp.obj tclass.obj transfrm.obj
libs\b16\terminal.lib : console.obj
libs\win16\terminal.lib : console.obj
console.obj : console.c extend.h types.h
bcc -c -O2 -I.\include -o$@ source\rtl\console.c
tlib .\libs\b16\terminal.lib -+$@,,
bcc -c -O2 -DWINDOWS -I.\include -o$@ source\rtl\console.c
tlib .\libs\win16\terminal.lib -+$@,,
arrays.obj : arrays.c extend.h types.h
classes.obj : classes.c extend.h types.h
codebloc.obj : codebloc.c extend.h types.h
dates.obj : dates.c extend.h types.h
datesx.obj : datesx.c extend.h types.h
dynsym.obj : dynsym.c extend.h types.h
environ.obj : environ.c extend.h types.h
error.obj : error.c extend.h types.h
errorapi.obj : errorapi.c extend.h types.h
errorsys.obj : errorsys.c extend.h types.h
extend.obj : extend.c extend.h types.h
files.obj : extend.c extend.h types.h
itemapi.obj : itemapi.c extend.h types.h
math.obj : math.c extend.h types.h
mathx.obj : mathx.c extend.h types.h
set.obj : set.c extend.h types.h
strcmp.obj : strcmp.c extend.h types.h
strings.obj : strings.c extend.h types.h
stringsx.obj : stringsx.c extend.h types.h
tclass.obj : tclass.c extend.h types.h
transfrm.obj : transfrm.c extend.h types.h
error.c : error.prg harbour.exe
errorsys.c : errorsys.prg harbour.exe
tclass.c : tclass.prg harbour.exe
.prg.c:
bin\harbour $< /n /osource\rtl
.c.obj:
bcc -c -ml -O2 -I.\include -o$@ $<
tlib .\libs\b16\harbour.lib -+$@,,
harbour.exe : y_tab.c lexyy.c
bcc -mh -O2 -ebin\harbour.exe -Iinclude;source\compiler \
source\compiler\y_tab.c source\compiler\lexyy.c
del y_tab.obj
del lexyy.obj
y_tab.c : harbour.y
bison -d -v -y -osource\compiler\y_tab.c source\compiler\harbour.y
lexyy.c : harbour.l
flex -i -8 -osource\compiler\lexyy.c source\compiler\harbour.l

72
harbour/makefile.b32 Normal file
View File

@@ -0,0 +1,72 @@
# makefile for Borland C/C++ 32 bits
.path.c = source\compiler;source\vm;source\rtl;source\tools
.path.h = include
.path.l = source\compiler
.path.y = source\compiler
.path.exe = bin
.path.lib = libs\b32
.path.obj = obj
.path.prg = source\rtl
PROJECT: harbour.lib libs\b32\terminal.lib libs\win32\terminal.lib harbour.exe
harbour.lib : arrays.obj classes.obj codebloc.obj dates.obj datesx.obj dynsym.obj \
environ.obj error.obj \
errorapi.obj errorsys.obj extend.obj files.obj itemapi.obj math.obj \
mathx.obj set.obj strings.obj stringsx.obj strcmp.obj tclass.obj transfrm.obj
libs\b32\terminal.lib : console.obj
libs\win32\terminal.lib : console.obj
console.obj : console.c extend.h types.h
bcc32 -c -O2 -I.\include -o$@ source\rtl\console.c
tlib .\libs\b32\terminal.lib -+$@,,
bcc32 -c -O2 -DWINDOWS -I.\include -o$@ source\rtl\console.c
tlib .\libs\win32\terminal.lib -+$@,,
arrays.obj : arrays.c extend.h types.h
classes.obj : classes.c extend.h types.h
codebloc.obj : codebloc.c extend.h types.h
dates.obj : dates.c extend.h types.h
datesx.obj : datesx.c extend.h types.h
dynsym.obj : dynsym.c extend.h types.h
environ.obj : environ.c extend.h types.h
error.obj : error.c extend.h types.h
errorapi.obj : errorapi.c extend.h types.h
errorsys.obj : errorsys.c extend.h types.h
extend.obj : extend.c extend.h types.h
files.obj : extend.c extend.h types.h
itemapi.obj : itemapi.c extend.h types.h
math.obj : math.c extend.h types.h
mathx.obj : mathx.c extend.h types.h
set.obj : set.c extend.h types.h
strcmp.obj : strcmp.c extend.h types.h
strings.obj : strings.c extend.h types.h
stringsx.obj : stringsx.c extend.h types.h
tclass.obj : tclass.c extend.h types.h
transfrm.obj : transfrm.c extend.h types.h
error.c : error.prg harbour.exe
errorsys.c : errorsys.prg harbour.exe
tclass.c : tclass.prg harbour.exe
.prg.c:
bin\harbour $< /n /osource\rtl
.c.obj:
bcc32 -c -O2 -I.\include -o$@ $<
tlib .\libs\b32\harbour.lib -+$@,,
harbour.exe : y_tab.c lexyy.c
bcc32 -O2 -ebin\harbour.exe -Iinclude;source\compiler \
source\compiler\y_tab.c source\compiler\lexyy.c
del y_tab.obj
del lexyy.obj
y_tab.c : harbour.y
bison -d -v -y -osource\compiler\y_tab.c source\compiler\harbour.y
lexyy.c : harbour.l
flex -i -8 -osource\compiler\lexyy.c source\compiler\harbour.l

23
harbour/makefile.gcc Normal file
View File

@@ -0,0 +1,23 @@
# Tell emacs that this is a -*- makefile -*-
.PHONY: COMPILER VM RTL TESTS
all: COMPILER VM RTL TESTS
COMPILER:
make -w --directory=SOURCE/COMPILER -f MAKEFILE.GCC
VM:
make -w --directory=SOURCE/VM -f MAKEFILE.GCC
RTL:
make -w --directory=SOURCE/RTL -f MAKEFILE.GCC
TESTS:
make -w --directory=TESTS/WORKING -f MAKEFILE.GCC
clean:
make -w --directory=SOURCE/COMPILER -f MAKEFILE.GCC clean
make -w --directory=SOURCE/VM -f MAKEFILE.GCC clean
make -w --directory=SOURCE/RTL -f MAKEFILE.GCC clean
make -w --directory=TESTS -f MAKEFILE.GCC clean

60
harbour/makefile.vc Normal file
View File

@@ -0,0 +1,60 @@
#
# Makefile for Harbour project for Microsoft Visual C
#
COMPILER_DIR=source\compiler
RTL_DIR=source\rtl
VM_DIR=source\vm
INCLUDE_DIR=include
BIN_DIR=bin
LIB_DIR=libs\vc
OBJ_DIR=obj
CC=cl
CFLAGS=-w -I$(INCLUDE_DIR)
CLIBFLAGS=$(CFLAGS) -c
HARBOUR_LIB=$(LIB_DIR)\harbour.lib
HARBOUR_EXE=$(BIN_DIR)\harbour.exe
LIB_OBJS = $(OBJ_DIR)\arrays.obj $(OBJ_DIR)\classes.obj $(OBJ_DIR)\console.obj \
$(OBJ_DIR)\dates.obj $(OBJ_DIR)\dynsym.obj $(OBJ_DIR)\extend.obj \
$(OBJ_DIR)\files.obj $(OBJ_DIR)\strings.obj
all: $(HARBOUR_LIB) $(HARBOUR_EXE)
$(HARBOUR_LIB) : $(LIB_OBJS)
lib /OUT:$(HARBOUR_LIB) $(LIB_OBJS)
$(HARBOUR_EXE) : $(COMPILER_DIR)\y_tab.c $(COMPILER_DIR)\lexyy.c
$(CC) $(CFLAGS) $(COMPILER_DIR)\y_tab.c $(COMPILER_DIR)\lexyy.c -o $(BIN_DIR)\harbour
-del y_tab.obj
-del lexyy.obj
$(COMPILER_DIR)\y_tab.c : $(COMPILER_DIR)\harbour.y
bison -d -v $(COMPILER_DIR)\harbour.y -o $(COMPILER_DIR)\y_tab.c
$(COMPILER_DIR)\lexyy.c : $(COMPILER_DIR)\harbour.l
flex -i -o$(COMPILER_DIR)\lexyy.c $(COMPILER_DIR)\harbour.l
$(OBJ_DIR)\arrays.obj : $(RTL_DIR)\arrays.c
$(CC) $(CLIBFLAGS) -Fo$@ $**
$(OBJ_DIR)\classes.obj : $(RTL_DIR)\classes.c
$(CC) $(CLIBFLAGS) -Fo$@ $**
$(OBJ_DIR)\console.obj : $(RTL_DIR)\console.c
$(CC) $(CLIBFLAGS) -Fo$@ $**
$(OBJ_DIR)\dates.obj : $(RTL_DIR)\dates.c
$(CC) $(CLIBFLAGS) -Fo$@ $**
$(OBJ_DIR)\dynsym.obj : $(VM_DIR)\dynsym.c
$(CC) $(CLIBFLAGS) -Fo$@ $**
$(OBJ_DIR)\extend.obj : $(RTL_DIR)\extend.c
$(CC) $(CLIBFLAGS) -Fo$@ $**
$(OBJ_DIR)\files.obj : $(RTL_DIR)\files.c
$(CC) $(CLIBFLAGS) -Fo$@ $**
$(OBJ_DIR)\strings.obj : $(RTL_DIR)\strings.c
$(CC) $(CLIBFLAGS) -Fo$@ $**

35
harbour/makewat.env Normal file
View File

@@ -0,0 +1,35 @@
# Makefile definitions for WATCOM C/C++ 10.x
#
# HARBOURDIR: set to where the Harbour project is installed
#
#
# Harbour project directories
HARBOURDIR = h:\harbour\harbour
HARBOURLIB = $(HARBOURDIR)\libs\harbour.lib
# Watcom directories
WATDIR=$(%WATCOM)
WATLIBDIR=$(WATDIR)\lib386
WATINCDIR=$(WATDIR)\h
OS_TARGET=DOS4G
# Compiler options
WC = wcc386
WPP = wpp386
WCDEBUG = /d2
WCOPTIONS = /w2 /5r /zq /zt0 /bt=$(OS_TARGET)
WCINCLUDE = -i=$(HARBOURDIR)\include -i=$(WATINCDIR)
WCDEFINE = /d_OS_DOS
WCEXTRA =
# Linker options
WLINK = wlink
WLOPTIONS = op osn=$(OS_TARGET)
WLSTACK = op stack=16384
WLDEBUG = debug all
WLLIBS = $(HARBOURLIB)
.c.obj: # $< # .AUTODEPEND
*$(WPP) $(WCOPTIONS) $(WCINCLUDE) $(WCDEBUG) $(WCDEFINE) $(WCEXTRA) $<

36
harbour/readmake.txt Normal file
View File

@@ -0,0 +1,36 @@
This makefile tree provides an easy method to build
the entire Harbour project. The development environment
was Cygnus win32 B19 developers distribution, which
means GNU Make and GCC. The root makefile will build
the Harbour compiler, the VM, the RTL, and all tests found
in the TESTS/WORKING dir. There is also a MAKEFILE.GCC in
TESTS/BROKEN, but it is not called by the root makefile.
I have left all the MAKEFILE names as MAKEFILE.GCC.
Using the makefiles for development: Say you've just written
a new RTL function in C. Just type
make -f MAKEFILE.GCC
in the RTL directory and it will compile it for you, and if
the compile succeeds, add it to libharbour.a.
Say you've just written a new test function in Harbour, in the
TESTS directory. Just type
make -f MAKEFILE.GCC
and it will harbour it, gcc it, and link it (along with any other
uncompiled tests) into an EXE file.
Say you just want to work with one Harbour test called FOO.PRG.
Do this:
make -f MAKEFILE.GCC foo.exe
Because of how my system unpacks a build, I assumed that all
of the original files have uppercase filenames. Therefore
I put in workarounds for .C instead of .c, .PRG instead of .prg,
etc. Hopefully this won't cause much trouble if you happen to
change all filenames to lowercase on your system.
-- Ross Presser 4/24/1999

84
harbour/tests/working/ainstest.prg Normal file
View File

@@ -0,0 +1,84 @@
//
// Array test aIns / aDel / aSize / aFill
//
// Date : 26/4/99
// Time : 09:30
//
function Main()
local aFirst
local aSecond
local aMore
aFirst := { 1,2,4 }
aIns( aFirst, 3 )
aFirst[3] = "3"
QQOut( "Testing aIns .. " )
aDump( aFirst )
aSecond := { 1,2,4 }
aSize( aSecond, 4 )
QQOut( "Testing aSize .. " )
aDump( aSecond )
aSecond := { 1,2,4 }
aSize( aSecond, 4 )
aIns( aSecond, 3 )
aSecond[3] = "3"
QQOut( "Testing aSize + aIns .. " )
aDump( aSecond )
aSecond := { 1,2,3,3,4,5 }
aDel( aSecond, 3 )
QQOut( "Testing aDel .. " )
aDump( aSecond )
aSecond := { 1,2,3,3,4,5 }
aDel( aSecond, 3 )
aSize( aSecond, len(aSecond) - 1 )
QQOut( "Testing aSize + aDel .. " )
aDump( aSecond )
aFill( aSecond, "!" )
QQOut( "Testing aFill .. " )
aDump( aSecond )
aMore := { 1,2,3,4,5,6 }
aFill( aMore, "X", 3 )
QQOut( "Testing aFill with start .. " )
aDump( aMore )
aMore := { 1,2,3,4,5,6 }
aFill( aMore, "X", 3, 2 )
QQOut( "Testing aFill with start and count .. " )
aDump( aMore )
aMore := { {1,2}, {3,4} }
aDel( aMore, 1 )
aDump( aMore )
return nil
function aDump( aShow )
local n
local CRLF := chr(13)+chr(10)
QQOut( "Len=", len(aShow) )
for n=1 to len(aShow)
QQOut( ValType( aShow[n] ) )
if ValType( aShow[n] ) == "A" /* Iterate array */
QQOut("[")
aDump( aShow[n] )
QQOut("]")
else
QQOut( aShow[n] )
endif
if n != len(aShow)
QQOut( "," )
endif
next n
QQOut( CRLF )
return nil

38
harbour/tests/working/and_or.prg Normal file
View File

@@ -0,0 +1,38 @@
// Testing Harbour AND OR operators
function And_Or() // Main() is not required!
QOut( "Testing logical shortcuts" )
if .f. .and. QOut( "this should not show!" ) // and it should not break!
endif
QOut( "Testing .t. .t." )
AndOr( .t., .t. )
QOut( "Testing .t. .f." )
AndOr( .t., .f. )
QOut( "Testing .f. .f." )
AndOr( .f., .f. )
QOut( "Testing errors..." )
AndOr( 1, .t. )
return nil
function AndOr( lValue1, lValue2 )
if lValue1 .and. lValue2
QOut( "They are both true" )
else
QOut( "They are not both true" )
endif
if lValue1 .or. lValue2
QOut( "At least one of them is true" )
else
QOut( "None of them are true" )
endif
return nil

69
harbour/tests/working/array16.prg Normal file
View File

@@ -0,0 +1,69 @@
// Harbour multidimensional arrays support
function Main()
local a := { 100, 200, "Third" }
local b := Array( 8832 ) // 8832 elements !!! Maximum for 16 Bit !!!
QOut( ValType( a ) )
QOut( ValType( { "A" } ) )
AAdd( a, "new element" )
QOut( Len( a ) )
QOut( a[ 1 ] )
QOut( a[ 2 ] )
QOut( a[ 3 ] )
QOut( a[ 4 ] )
QOut( ATail( a ) )
a[ 3 ] = { "this", { "seems", "to", { "work", "so", "well" } } }
* QOut( a[ 3 ][ 2 ][ 3 ][ 1 ] ) // "work"
a[ 3, 2 ][ 3, 1 ] := "Harbour power!" // different ways to specify the indexes
QOut( a[ 3, 2, 3, 1 ] )
QOut( ValType( b ) )
QOut( Len( b ) )
b[ 8832 ] = "Harbour"
QOut( b[ 8832 ] )
QOut( atail( b ) )
ASize( b, 200 )
QOut( Len( b ) )
b[ 100 ] = 10
Test( b[ 100 ]++ )
QOut( b[ 100 ] )
b[ 100 ] = 10
Test( ++b[ 100 ] )
QOut( b[ 100 ] )
b = { 1, { 2, { 4, 5 } } }
Test( b[ 2 ][ 2 ][ 1 ]++ )
QOut( b[ 2 ][ 2 ][ 1 ] )
b[ 2 ][ 2 ][ 1 ] = 2
Test( ++b[ 2 ][ 2 ][ 1 ] )
QOut( b[ 2 ][ 2 ][ 1 ] )
ReleaseTest()
return nil
function Test( n )
QOut( n )
return nil
function ReleaseTest()
local a := { 1, 2, 3 }
return nil

67
harbour/tests/working/arrays.prg Normal file
View File

@@ -0,0 +1,67 @@
// Harbour multidimensional arrays support
function Main()
local a := { 100, 200, "Third" }
local b := Array( 10000 ) // 10.000 elements !!!
QOut( ValType( a ) )
QOut( ValType( { "A" } ) )
AAdd( a, "new element" )
QOut( Len( a ) )
QOut( a[ 1 ] )
QOut( a[ 2 ] )
QOut( a[ 3 ] )
QOut( a[ 4 ] )
QOut( ATail( a ) )
a[ 3 ] = { "this", { "seems", "to", { "work", "so", "well" } } }
* QOut( a[ 3 ][ 2 ][ 3 ][ 1 ] ) // "work"
a[ 3, 2 ][ 3, 1 ] := "Harbour power!" // different ways to specify the indexes
QOut( a[ 3, 2, 3, 1 ] )
QOut( ValType( b ) )
QOut( Len( b ) )
b[ 8000 ] = "Harbour"
QOut( b[ 8000 ] )
ASize( b, 2000 )
QOut( Len( b ) )
b[ 1000 ] = 10
Test( b[ 1000 ]++ )
QOut( b[ 1000 ] )
b[ 1000 ] = 10
Test( ++b[ 1000 ] )
QOut( b[ 1000 ] )
b = { 1, { 2, { 4, 5 } } }
Test( b[ 2 ][ 2 ][ 1 ]++ )
QOut( b[ 2 ][ 2 ][ 1 ] )
b[ 2 ][ 2 ][ 1 ] = 2
Test( ++b[ 2 ][ 2 ][ 1 ] )
QOut( b[ 2 ][ 2 ][ 1 ] )
ReleaseTest()
return nil
function Test( n )
QOut( n )
return nil
function ReleaseTest()
local a := { 1, 2, 3 }
return nil

35
harbour/tests/working/asctest.prg Normal file
View File

@@ -0,0 +1,35 @@
// example from clipper reference guide
procedure main()
local aArr1 := { "Tom", "Mary", "Sue" }
local aArr2 := { "Tom", "Mary", "Sue", "Mary" }
local aArr3 := {}
local nLen, nStart := 1, nPos
QOut( "Search 'Mary' in 'Tom, Mary, Sue' => " )
QQOut( AScan( aArr1, "Mary" ) )
QOut( "Search 'mary' in 'Tom, Mary, Sue' => " )
QQOut( AScan( aArr1, "mary" ) )
nLen := Len( aArr2 )
do while ( nPos := AScan( aArr2, "Mary", nStart ) ) > 0
QOut( "Search 'Mary' in 'Tom, Mary, Sue, Mary' from ", nStart, " => " )
QQOut( nPos, aArr2[ nPos ] )
nStart := nPos + 1
if nStart > nLen
exit
endif
enddo
AAdd( aArr3, { "one", "two" } )
AAdd( aArr3, { "three", "four" } )
AAdd( aArr3, { "five", "six" } )
QOut( AScan( aArr3, { | aVal | Dump( aVal ) } ) )
return
function Dump( aVal )
QOut( ValType( aVal ) )
return

12
harbour/tests/working/atest.prg Normal file
View File

@@ -0,0 +1,12 @@
// releasing arrays test
function Main()
local a := { 1 }
a[ 1 ] = a
a[ 1 ] = nil
QOut( "The array will try to be released now..." )
return nil

16
harbour/tests/working/block2.PRG Normal file
View File

@@ -0,0 +1,16 @@
// CodeBlocks management
function Main()
local bBlock := GenBlock()
Eval( bBlock, "I am a ", "codeblock" )
QOut( "ok" )
return nil
function GenBlock()
return { | c, d | QOut( c + d ) }

20
harbour/tests/working/byref.prg Normal file
View File

@@ -0,0 +1,20 @@
// Managing variables by reference
function Main()
local x := 0
QOut( "Managing variables by reference" )
ref( @x )
QOut( x )
return nil
function ref( x )
x := 999
return nil

31
harbour/tests/working/calling.prg Normal file
View File

@@ -0,0 +1,31 @@
// Calling different PRG functions
function Main()
Second()
DO Fourth WITH "from Fourth() function" // Testing the old fashion DO ...
QOut( "Ok, back to Main()" )
return nil
function Second()
QOut( "Ok, this is from Second() function call" )
Third()
return nil
function Third()
QOut( "Ok, this is from Third() function call" )
return nil
function Fourth( cText )
QOut( cText )
return nil

51
harbour/tests/working/classes.prg Normal file
View File

@@ -0,0 +1,51 @@
// Using Harbour Class TClass
function Main()
local oForm := TForm():New()
QOut( oForm:ClassName() )
oForm:Show()
return nil
function TForm()
static oClass
if oClass == nil
oClass = TClass():New( "TFORM" ) // starts a new class definition
oClass:AddData( "cName" ) // define this class objects datas
oClass:AddData( "nTop" )
oClass:AddData( "nLeft" )
oClass:AddData( "nBottom" )
oClass:AddData( "nRight" )
oClass:AddMethod( "New", @New() ) // define this class objects methods
oClass:AddMethod( "Show", @Show() )
oClass:Create() // builds this class
endif
return oClass:Instance() // builds an object of this class
static function New()
local Self := QSelf()
::nTop = 10
::nLeft = 10
::nBottom = 20
::nRight = 40
return Self
static function Show()
local Self := QSelf()
QOut( "lets show a form from here :-)" )
return nil

28
harbour/tests/working/codebl2.prg Normal file
View File

@@ -0,0 +1,28 @@
FUNCTION MAIN()
LOCAL a, b, c
c =2
b =Detach( 5, @c )
OUTSTD( EVAL( b, 6, 1 ) )
QOUT("")
b =Detach( c, 15 )
OUTSTD( EVAL( b, 8 ) )
QOUT("")
b =Call1( b )
QOUT( EVAL( b, 10 ) )
RETURN nil
FUNCTION Detach( x, y )
RETURN( {|z| OutStd("z="),OutStd(z), OutStd(" x="),OutStd(x), OutStd(" y="),Outstd(y), Outstd(" z*y+x="), z*x+y} )
FUNCTION Call1( cb )
RETURN( Call2( cb ) )
FUNCTION Call2( cb )
RETURN( Call3( cb ) )
FUNCTION Call3( cb )
RETURN( {|x| EVAL(cb,2) *x} )

117
harbour/tests/working/codebloc.prg Normal file
View File

@@ -0,0 +1,117 @@
// codeblocks test
function Main()
local B := "this will never print"
local a := { |b,c| OutStd( "I am a codeblock" + b + c ) }
local d
local de
local ar := { 1, 2 }
local crlf:=CHR(13)+chr(10)
local YY, X
local x1, x2
OutStd( "this should print first" )
OutStd( crlf )
Eval( a, " with parameters", " ... and it works!" )
OutStd( crlf )
d ="with access to local variables"
a ={ |b,c| OutStd( "I am a second codeblock " +d +b +;
IIF(c==NIL, ' empty second parameter ', c)), OutStd(crlf), "WITH return value" }
EVAL( a, ", codeblock parameters" )
OutStd( crlf )
EVAL( a, ", codeblock parameters ", "and with second parameter" )
OutStd( crlf )
OutStd( MyEval( a ) )
OutStd( crlf )
OtherTest( a )
OutStd( crlf )
AnotherTest( a, "==> Another " )
OutStd( crlf )
a ={|c| IIF( c=NIL, {|a| "First "+a}, {|a| "Second "+a}) }
a =EVAL( a )
OutStd( crlf )
OutStd( EVAL( a, "codeblock created in a codeblock" ) )
OutStd( crlf )
OutStd( ar[ 1 ] )
OutStd( crlf )
a :={|| ar[ 1 ]++}
EVAL( a )
OutStd( ar[ 1 ] )
OutStd( crlf )
yy :=5
x :={|xx| OutStd(LTRIM(STR(xx))), OutStd("+"), OutStd(LTRIM(STR(yy))), OutStd("="), xx + yy }
OutStd( EVAL( x, 1 ) ) //this is OK
OutStd( CRLF )
OutStd( EVAL( x, 1, 2 ) ) //this should ignore unnecesary parameters
QOut( EVAL( RetBlock(), 5 ) )
// BugToFix()
OutStd( crlf )
OutStd( "Traying to use detached variable ..." )
OutStd( crlf )
x1 :=5
x2 :=6
de =DetachLocal( x1, x2 )
OutStd( EVAL( de ) )
//changing the value of variables
OutStd( crlf )
x1 := 10
x2 := 11
QOut( EVAL( de ) )
de =DetachLocal( x1, x2 )
QOut( EVAL( de ) )
return nil
FUNCTION MyEval( bCodeBlock )
LOCAL D:="this is another variable"
RETURN( EVAL(bCodeBlock, " from ", "MyEval Function" ) )
PROCEDURE OtherTest( cblock )
LOCAL cb
cb :={|a,b| EVAL( cblock,a,b ) }
EVAL( cb, "--> with nested ", "EVAL" )
RETURN
PROCEDURE AnotherTest( cb, a )
OutStd( EVAL( cb, a ) )
OutStd( chr(13)+chr(10) )
OutStd( EVAL( cb, a, "again and again" ) )
OutStd( chr(13)+chr(10) )
RETURN
FUNCTION DetachLocal( x, y )
//NOTE! this should work
LOCAL z:=x+y
LOCAL cb:={|| QOut("z=x+y="), QOut(z), QOut("x*x="), QOut(x*x), QOut("x*x+z="), x*x+z}
RETURN( cb )
PROCEDURE BugToFix()
LOCAL b, a := {|| a+b }
b ="bug "
EVAL( a )
RETURN
FUNCTION RetBlock()
RETURN( {|x| x*x} )

20
harbour/tests/working/comments.prg Normal file
View File

@@ -0,0 +1,20 @@
// Testing Harbour comments
*
* star comment
* more star comments
*
NOTE Old fashion comment
function Main()
/* multiple
lines
comment */
QOut( "Ok!" ) && old fashion comment
return nil

79
harbour/tests/working/dates.prg Normal file
View File

@@ -0,0 +1,79 @@
// Testing Harbour dates management.
#include "set.ch"
function Main()
local cNewLine := CHR( 10 )
local dDate, dDate2, cMask, cDate
OUTSTD (cNewLine, "Testing Harbour dates management", cNewLine)
OUTSTD (cNewLine, __SETCENTURY ())
__SETCENTURY ("ON")
OUTSTD (__SETCENTURY ())
__SETCENTURY ("OFF")
OUTSTD (__SETCENTURY ())
__SETCENTURY ("GIBBERISH")
OUTSTD (__SETCENTURY ())
__SETCENTURY (.T.)
OUTSTD (__SETCENTURY ())
__SETCENTURY (5)
OUTSTD (__SETCENTURY ())
OUTSTD (cNewLine, "")
OUTSTD (cNewLine, "dDate = CToD( '02/04/1999' ) => ", dDate := CToD( "02/04/1999" ))
OUTSTD (cNewLine, "ValType( dDate ) = ", ValType( dDate ))
OUTSTD (cNewLine, "Day( dDate ) = ", Day( dDate ))
OUTSTD (cNewLine, "Month( dDate ) = ", Month( dDate ))
OUTSTD (cNewLine, "Year( dDate ) = ", Year( dDate ), cNewLine)
OUTSTD (cNewLine, "dDate + 5 = ", dDate2 := dDate + 5)
OUTSTD (cNewLine, "dDate - 5 = ", dDate - 5, cNewLine )
OUTSTD (cNewLine, "dDate2 - dDate = ", dDate2 - dDate)
OUTSTD (cNewLine, "")
OUTSTD (cNewLine, dDate, DTOS (dDate))
OUTSTD (cNewLine, "19990429", STOD ("19990429"))
OUTSTD (cNewLine, "")
SET (_SET_EPOCH, 1950)
cMask := "dd/mm/yyyy"
cDate := "02/04/49"
SET (_SET_DATEFORMAT, cMask)
dDate := CTOD (cDate)
OUTSTD (cNewLine, cDate, cMask, dDate, DTOS (dDate), DTOC (dDate))
OUTSTD (cNewLine, "")
cMask := "mm/dd/yyyy"
SET (_SET_DATEFORMAT, cMask)
dDate := CTOD (cDate)
OUTSTD (cNewLine, cDate, cMask, dDate, DTOS (dDate), DTOC (dDate))
OUTSTD (cNewLine, "")
cMask := "yyyy/mm/dd"
SET (_SET_DATEFORMAT, cMask)
dDate := CTOD (cDate)
OUTSTD (cNewLine, cDate, cMask, dDate, DTOS (dDate), DTOC (dDate))
OUTSTD (cNewLine, "")
OUTSTD (cNewLine, "49/02/04", cMask, CTOD ("49/02/04"))
OUTSTD (cNewLine, "")
cMask := "yyyy/dd/mm"
SET (_SET_DATEFORMAT, cMask)
dDate := CTOD (cDate)
OUTSTD (cNewLine, cDate, cMask, dDate, DTOS (dDate), DTOC (dDate))
OUTSTD (cNewLine, "")
OUTSTD (cNewLine, "49/02/04", cMask, CTOD ("49/02/04"))
OUTSTD (cNewLine, "")
cMask := "ddd/mmm/yy"
SET (_SET_DATEFORMAT, cMask)
dDate := CTOD (cDate)
OUTSTD (cNewLine, cDate, cMask, dDate, DTOS (dDate), DTOC (dDate))
return nil

29
harbour/tests/working/docase.prg Normal file
View File

@@ -0,0 +1,29 @@
// Testing Harbour Do case
function Main()
local n := 2
QOut( "testing Harbour Do case" )
do case
case n == 1
QOut( "n is 1" )
QOut( "first case" )
case n == 2
QOut( "n is 2" )
QOut( "second case" )
case n == 3
QOut( "n is 3" )
QOut( "third case" )
otherwise
QOut( "Sorry, I don't know what n is :-)" )
QOut( "otherwise" )
endcase
QOut( "Ok!" )
return nil

9
harbour/tests/working/dupvars.prg Normal file
View File

@@ -0,0 +1,9 @@
// Testing Harbour duplicate variable definition detection
function Main()
local a, a
QOut( "ok" )
return nil

56
harbour/tests/working/empty.prg Normal file
View File

@@ -0,0 +1,56 @@
//
// Testing Empty() function
//
// Date : 29/04/1999
// Time : 14:30
//
function Main()
QOut( "PLEASE SET DATE TO BRITISH / CENTURY ON" )
QOut( "C 'Hallo' ", empty( "Hallo" ) )
QOut( "C '' ", empty( "" ) )
QOut( "C ' ' ", empty( " " ) )
QOut( "C ' \0' ", empty( " "+chr(0) ) )
QOut( "C ' \n\t' ", empty( " "+chr(13)+chr(9) ) )
QOut( "C ' A' ", empty( " A" ) )
QOut( "C ' x ' ", empty( " x " ) )
QOut( "C ' x\0' ", empty( " x"+chr(0) ) )
QOut( "C ' \nx\t' ", empty( " "+chr(13)+"x"+chr(9) ) )
QOut( "N 0 ", empty( 0 ) )
QOut( "N -0 ", empty( -0 ) )
QOut( "N 0.0 ", empty( 0.0 ) )
QOut( "N 70000-70000 ", empty( 70000-70000 ) )
QOut( "N 1.5*1.5-2.25 ", empty( 1.5*1.5-2.25 ) )
QOut( "N 10 ", empty( 10 ) )
QOut( "N 10.0 ", empty( 10.0 ) )
QOut( "N 70000+70000 ", empty( 70000+70000 ) )
QOut( "N 1.5*1.5*2.25 ", empty( 1.5*1.5*2.25 ) )
Pause()
QOut( "D 10/10/1824 ", empty( ctod("10/10/1824") ) )
QOut( "D 31/02/1825 ", empty( ctod("31/02/1825") ), " CTOD needs fixing" )
QOut( "D 99/99/9999 ", empty( ctod("99/99/9999") ) )
QOut( "D / / ", empty( ctod(" / / ") ) )
QOut( "D ", empty( ctod("") ), " Another CTOD fix !" )
QOut( "L .T. ", empty( .T. ) )
QOut( "L .F. ", empty( .F. ) )
QOut( "U NIL ", empty( NIL ) )
QOut( "U ", empty( ) )
QOut( "A {1} ", empty( {1} ) )
QOut( "A {} ", empty( {} ) )
QOut( "A {0} ", empty( {0} ) )
QOut( "B {|x|x+x} ", empty( {|x|x+x} ) )
QOut()
return nil
function Pause()
QOut()
__Accept( "Pause:" )
return nil

14
harbour/tests/working/errorsys.prg Normal file
View File

@@ -0,0 +1,14 @@
// Testing the Harbour related error system functions
function Main()
local oError := ErrorNew()
QOut( oError:ClassName() ) // Be aware this will print ERROR
oError:Description = "Its description"
QOut( oError:Description )
QOut( Len( oError ) )
return nil

40
harbour/tests/working/fib.prg Normal file
View File

@@ -0,0 +1,40 @@
Function Main()
Local n
For n := 1 To 20
QOut( FibR( n ) )
QOut( FibI( n ) )
Next
Return( NIL )
Function FibR( n )
Local nFib
If n < 2
nFib := n
Else
nFib := FibR( n - 2 ) + FibR( n - 1 )
EndIf
Return( nFib )
Function FibI( n )
Local nFibMin1 := 1
Local nFibMinN1 := 0
Local i := 1
Local nFib
If n < 2
nFib := n
Else
Do While i < n
nFib := nFibMin1 + nFibMinN1
nFibMinN1 := nFibMin1
nFibMin1 := nFib
++i
EndDo
EndIf
Return( nFib )

11
harbour/tests/working/fileio.prg Normal file
View File

@@ -0,0 +1,11 @@
// Testing Harbour file io features
function Main()
local h := FCreate( "test.txt" )
FWrite( h, "This is a test" )
FClose( h )
return nil

33
harbour/tests/working/fornext.prg Normal file
View File

@@ -0,0 +1,33 @@
// Testing Harbour For Next loops
function Main()
local n := 1
QOut( "Testing Harbour For Next loops. Going up quick" )
for n:=1 to 10 step 4
QOut( n )
next n
QOut( "Going down" )
for n:=10 to 1 step -1
QOut( n )
next n
QOut( "No step" )
for n:=1 to 10
QOut( n )
next n
QOut( "No production" )
for n:=1 to 10 step -1
QOut( n )
next n
QOut( "Ok!" )
return nil

23
harbour/tests/working/fornext2.prg Normal file
View File

@@ -0,0 +1,23 @@
// Testing Harbour For Next loops
function Main()
local n
for n = 1 to Limit() Step Step()
QOut( n )
next
return nil
function Limit()
QOut( "Limit" )
return 10
function Step()
QOut( "Step" )
return 2

58
harbour/tests/working/guess.prg Normal file
View File

@@ -0,0 +1,58 @@
//
// Guess a number
//
// Written by : E.Runia
// Date : 22/4/99
//
// Requirements :
//
// The last RTL from Antonio and the string.c from Matthew.
//
// Please run the attached DIFs as well
//
// My first application (big word) written in Harbour
//
extern OutStd
function Main()
local flGuessed
local CRLF := chr(13)+chr(10)
local nSeed := 241
local nPick
QQOut( "Welcome to guess a number....", CRLF )
QQOut( "You have to guess a number between ",0," and 255", CRLF )
do while Upper( Read( "Continue Y/N : " ) ) == "Y"
nSeed := (( nSeed * 11) + 5) % 256
flGuessed := 0
do while flGuessed == 0
nPick := Val( Read( "Value : " ) )
if nPick > 255
QQOut( "More than 255", CRLF )
elseif nPick < 0
QQOut( "Less than 0", CRLF )
elseif nPick > nSeed
QQOut( "Try lower", CRLF )
elseif nPick < nSeed
QQOut( "Try higher", CRLF )
else
QQOut( "Congratulations, you've guessed the number", CRLF, CRLF )
flGuessed := 1
endif
enddo
enddo
return nil
function Read( cPrompt ) // Simple read function.
return __Accept( cPrompt )

7
harbour/tests/working/hello.prg Normal file
View File

@@ -0,0 +1,7 @@
// Typical welcome message
function Main()
QOut( "Hello world!" )
return nil

27
harbour/tests/working/ifelse.prg Normal file
View File

@@ -0,0 +1,27 @@
// Testing Harbour If elseif else endif
function Main()
local x := 3 // change this value from 1 to 5 and see the results!
QOut( "Testing Harbour If elseif else endif" )
if x = 1
QOut( "x is 1" )
elseif x = 2
QOut( "x is 2" )
elseif x = 3
QOut( "x is 3" )
elseif x = 4
QOut( "x is 4" )
else
QOut( "x is not 1 or 2 or 3 or 4" )
endif
QOut( "Ok!" )
return nil

23
harbour/tests/working/ifinline.prg Normal file
View File

@@ -0,0 +1,23 @@
// Testing Harbour If inline
function Main()
local n := 1
QOut( "Testing Harbour If inline" )
If( n == 1, QOut( 1 ), QOut( 2 ) )
IIf( n <> nil, QOut( "not nil" ),)
QOut( "Now changing n to 2" )
n = 2
If( n == 1, QOut( 1 ), QOut( 2 ) )
IIf( n <> nil, QOut( "not nil" ),)
QOut( "ok!" )
return nil

31
harbour/tests/working/initexit.prg Normal file
View File

@@ -0,0 +1,31 @@
// Testing Harbour INIT and EXIT functions
function Main()
QOut( "Hello from Main()" )
return nil
init function Second()
QOut( "Hello from Second()" )
return nil
init function Third()
QOut( "Hello from Third()" )
return nil
exit function Fifth()
QOut( "Hello from Fifth()" )
return nil
exit function Sixth()
QOut( "Hello from Sixth()" )
return nil

7
harbour/tests/working/longstr.prg Normal file
View File

@@ -0,0 +1,7 @@
function Main()
local c := "This is a very long string. This may seem silly however strings like this are still used. Not by good programmers though, but I've seen stuff like this used for Copyright messages and other long text. What is the point to all of this you'd say. Well I am coming to the point right now, the constant string is limited to 256 characters and this string is a lot bigger. Do you get my drift ? If there is somebody who has read this line upto the very end: Esto es un sombrero grande rid¡culo."+chr(13)+chr(10)+"/"+chr(13)+chr(10)+"[;-)"+chr(13)+chr(10)+"\"
OutStd( c )
return nil

150
harbour/tests/working/mankala.prg Normal file
View File

@@ -0,0 +1,150 @@
//
// Mankala. The first Harbour board game.
//
// Date : 30/04/1999
// Time : 14:00
//
// It is just you against the computer. The board is as follows :
//
// Computer
// ÚÄÄÄÂÄÄÄ¿
// ³X X³X X³
// ÃÄÄÄÅÄÄÄ´
// ³X X³X X³
// ÀÄÄÄÁÄÄÄÙ
// You
//
// The game begins with two stones in each square.
//
// You can choose to play either the left or the right (L/R) square.
//
// If you select a square, the stones are moved anti-clockwise through the
// squares.
//
// Example : You select Left. The board will now become :
//
// Computer
// ÚÄÄÄÂÄÄÄ¿
// ³X X³XXX³
// ÃÄÄÄÅÄÄÄ´
// ³ ³XXX³
// ÀÄÄÄÁÄÄÄÙ
// You
//
// The person which gets all the stones has won the game
//
// Just try to beat the computer :-)
//
//
function Main()
local cAnswer := "X"
local cPlayer
local lWon := .F.
local aBoard := {2,2,2,2}
local nMove
local cMove
local nLoop
local nLoop2
QOut( "Mankala. Another Harbour Game Production")
QOut()
do while cAnswer != "Y" .and. cAnswer != "N"
cAnswer := Read( "Would you like to play first ?" )
cAnswer := Upper( cAnswer ) // Nested functions ??
enddo
if cAnswer == "N"
cPlayer := "Computer"
else
cPlayer := "Human"
endif
do while !lWon
QOut()
QOut("Computer ",aBoard[2],' ',aBoard[1])
QOut("Human ",aBoard[3],' ',aBoard[4])
QOut()
QOut("Player ",cPlayer)
if (aBoard[2]==0 .and. aBoard[1]==0) .or. ;
(aBoard[3]==0 .and. aBoard[4]==0)
lWon := .T.
endif
if !lWon
if cPlayer == "Computer"
do case
case aBoard[1]==0
nMove := 1
case aBoard[1]==3 .and. aBoard[2]==2 .and. ;
aBoard[3]==2 .and. aBoard[4]==1
nMove := 1
case aBoard[1]==1 .and. aBoard[2]==6 .and. ;
aBoard[3]==1 .and. aBoard[4]==0
nMove := 1
case aBoard[1]==1 .and. aBoard[2]==1 .and. ;
aBoard[3]==6 .and. aBoard[4]==0
nMove := 1
case aBoard[1]==4 .and. aBoard[2]==1 .and. ;
aBoard[3]==3 .and. aBoard[4]==0
nMove := 1
case aBoard[1]==3 .and. aBoard[2]==1 .and. ;
aBoard[3]==4 .and. aBoard[4]==0
nMove := 1
otherwise
nMove := 0
endcase
else
nMove := 0
do while nMove == 0
cMove := Read( "Left/Right :" )
cMove := Upper( cMove )
if cMove == "L"
nMove := 2
else
if cMove == "R"
nMove := 3
endif
endif
enddo
lWon := aBoard[nMove+1] == 0
endif
nLoop2 := nMove
nLoop := aBoard[nMove+1]
aBoard[nMove+1] := 0
do while nLoop != 0
nLoop2++
aBoard[(nLoop2 % 4)+1]++ // It works :-)
nLoop--
enddo
if cPlayer == "Human"
cPlayer := "Computer"
else
cPlayer := "Human"
endif
endif
enddo
if cPlayer == "Human"
QOut( "You have beaten me :-)" )
else
QOut( "You'll never learn !" )
endif
return nil
function Read( cPrompt )
return __Accept( cPrompt )

14
harbour/tests/working/mathtest.prg Normal file
View File

@@ -0,0 +1,14 @@
func main()
qout(sin(33) )
qout(cos(43) )
qout(tan(54))
qout(log10(112))
qout(log(12))
qout(sqrt(16))
qout(asin(33) )
qout(acos(43) )
qout(atan(54))
qout(abs(10))
qout(exp(15))
qout(int(454.14))
return nil

18
harbour/tests/working/nums.prg Normal file
View File

@@ -0,0 +1,18 @@
// Testing the different numeric formats Harbour produces
function main()
local a := 0 // it should generate a _ZERO pcode opcode
local b := 123 // it should generate a _PUSHINT pcode opcodes
local c := 50000 // it should generate a _PUSHLONG pcode opcodes
local d := 12000.123 // it should generate a _PUSHDOUBLE pcode opcodes
local e := 0xABAB // Automatic support for hexadecimal numbers
local f := .12
QOut( a )
QOut( b )
QOut( c )
QOut( d )
QOut( e )
return nil

66
harbour/tests/working/objects.prg Normal file
View File

@@ -0,0 +1,66 @@
// Testing Harbour classes and objects management
// be aware Harbour provides a much simpler way using Class TClass (source\rtl\class.prg)
#define MET_METHOD 0 // these defines should be declared with these specific values
#define MET_DATA 1 // as Harbour Classes building modules uses them
#define MET_CLASSDATA 2
#define MET_INLINE 3
#define MET_VIRTUAL 4
function Main()
local oObject := TAny():New()
QOut( ValType( oObject ) )
QOut( Len( oObject ) ) // 3 datas !
QOut( oObject:ClassH() ) // retrieves the handle of its class
QOut( oObject:ClassName() ) // retrieves its class name
oObject:Test() // This invokes the below defined Test function
// See QSelf() and :: use
QOut( oObject:cName )
oObject:DoNothing() // a virtual method does nothing,
// but it is very usefull for Classes building logic
return nil
function TAny() /* builds a class */
static hClass
if hClass == nil
hClass = ClassCreate( "TANY", 3 ) // cClassName, nDatas
ClassAdd( hClass, "cName", 1, MET_DATA ) // retrieve data
ClassAdd( hClass, "_cName", 1, MET_DATA ) // assign data. Note the '_'
ClassAdd( hClass, "New", @New(), MET_METHOD )
ClassAdd( hClass, "Test", @Test(), MET_METHOD )
ClassAdd( hClass, "DoNothing", 0, MET_VIRTUAL )
endif
/* warning: we are not defining datas names and methods yet */
return ClassInstance( hClass ) // creates an object of this class
static function New()
local Self := QSelf()
QOut( ValType( Self ) )
QOut( "Inside New()" )
::cName = "Harbour OOP"
return Self
static function Test()
local Self := QSelf() // We access Self for this method
QOut( "Test method invoked!" )
QOut( ::ClassName() ) // :: means Self: It is a Harbour built-in operator
return nil

41
harbour/tests/working/operat.prg Normal file
View File

@@ -0,0 +1,41 @@
// Testing Harbour operators management
#define CRLF Chr( 13 ) + Chr( 10 )
function Main()
local a := 1
local b := 2
local c := 3
QOut( "testing Harbour operators management" )
QQOut( "a = ", a, CRLF )
QQOut( "b = ", b, CRLF )
QQOut( "c = ", c, CRLF )
QQOut( "a + b = ", a + b, CRLF ) // 3
QQOut( "b - a = ", b - a, CRLF ) // 1
QQOut( "b * c = ", b * c, CRLF ) // 6
QQOut( "b * c / 2 = ", b * c / 2, CRLF ) // 3
QQOut( "a += b = ", a += b, CRLF ) // 3
QQOut( "a = ", a, CRLF ) // 3
QQOut( "a -= b = ", a -= b, CRLF ) // 1
QQOut( "a = ", a, CRLF ) // 1
QQOut( "a < b ", a < b, CRLF ) // TRUE
QQOut( "a > b ", a > b, CRLF ) // FALSE
QQOut( "a + b <= c ", a + b <= c, CRLF) // TRUE
QQOut( "a + b >= c ", a + b >= c, CRLF) // TRUE
QQOut( "a *= b = ", a *= b, CRLF ) // 2
QQOut( "a /= b = ", a /= b, CRLF ) // 1
QQOut( "a = ", a, CRLF ) // 1
QQOut( "b ** 3 = ", b ** 3, CRLF ) // 8
QQOut( "b ^ 3 = ", b ^ 3, CRLF ) // 8
QQOut( "8 % 3 = ", 8 % 3, CRLF ) // 2
return nil

38
harbour/tests/working/procname.prg Normal file
View File

@@ -0,0 +1,38 @@
// Testing Harbour ProcName() and ProcLine()
#define CRLF Chr( 13 ) + Chr( 10 )
function Main()
Two()
return nil
function Two()
Three()
return nil
function Three()
Four()
return nil
function Four()
Five()
return nil
function Five()
local n := 0
while ! Empty( ProcName( n ) )
QQOut( "Called from: ", ProcName( n ), ProcLine( n++ ), CRLF )
end
return nil

15
harbour/tests/working/recursiv.prg Normal file
View File

@@ -0,0 +1,15 @@
// testing recursive calls
function main()
QOut( "Testing recursive calls" + Chr( 13 ) + Chr( 10 ) )
QOut(f(10))
QOut( 10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2 * 1 )
return nil
function f(a)
return iif(a<2,1,a*f(a-1))

31
harbour/tests/working/returns.prg Normal file
View File

@@ -0,0 +1,31 @@
// Testing multiple returns into a function
function Main()
QOut( "From Main()" )
Two( 1 )
QOut( "back to Main()" )
Two( 2 )
QOut( "back to Main()" )
return nil
function Two( n )
do case
case n == 1
QOut( "n == 1" )
return nil
case n == 2
QOut( "n == 2" )
return nil
endcase
QOut( "This message should not been seen" )
return nil

108
harbour/tests/working/rtl_test.prg Normal file
View File

@@ -0,0 +1,108 @@
/* TODO: Add checks for string parameters with embedded NUL character */
/* TODO: Add test cases for other string functions */
/* TODO: Incorporate tests from TEST\WORKING\STRING*.PRG
/* QUESTION: Can Harbour compile and run this (PadR(), Chr(), fWrite(), StrTran()) ? */
#define NUL Chr(0)
SHOW_TEST('At("", "")' , Str(At("", "")) ) // 1
SHOW_TEST('At("", "ABCDEF")' , Str(At("", "ABCDEF")) ) // 1
SHOW_TEST('At("ABCDEF", "")' , Str(At("ABCDEF", "")) ) // 0
SHOW_TEST('At("AB", "AAB")' , Str(At("AB", "AAB")) ) // 2
SHOW_TEST('At("A", "ABCDEF")' , Str(At("A", "ABCDEF")) ) // 1
SHOW_TEST('At("F", "ABCDEF")' , Str(At("F", "ABCDEF")) ) // 6
SHOW_TEST('At("D", "ABCDEF")' , Str(At("D", "ABCDEF")) ) // 4
SHOW_TEST('At("X", "ABCDEF")' , Str(At("X", "ABCDEF")) ) // 0
SHOW_TEST('At("AB", "ABCDEF")' , Str(At("AB", "ABCDEF")) ) // 1
SHOW_TEST('At("AA", "ABCDEF")' , Str(At("AA", "ABCDEF")) ) // 0
SHOW_TEST('At("ABCDEF", "ABCDEF")' , Str(At("ABCDEF", "ABCDEF")) ) // 1
SHOW_TEST('At("BCDEF", "ABCDEF")' , Str(At("BCDEF", "ABCDEF")) ) // 2
SHOW_TEST('At("BCDEFG", "ABCDEF")' , Str(At("BCDEFG", "ABCDEF")) ) // 0
SHOW_TEST('At("ABCDEFG", "ABCDEF")' , Str(At("ABCDEFG", "ABCDEF"))) // 0
SHOW_TEST('At("FI", "ABCDEF")' , Str(At("FI", "ABCDEF")) ) // 0
SHOW_TEST('SubStr("abcdef", 0, -1)' , SubStr("abcdef", 0, -1) ) // ""
SHOW_TEST('SubStr("abcdef", 0, 0)' , SubStr("abcdef", 0, 0) ) // ""
SHOW_TEST('SubStr("abcdef", 0, 1)' , SubStr("abcdef", 0, 1) ) // "a"
SHOW_TEST('SubStr("abcdef", 0, 7)' , SubStr("abcdef", 0, 7) ) // "abcdef"
SHOW_TEST('SubStr("abcdef", 0)' , SubStr("abcdef", 0) ) // "abcdef"
SHOW_TEST('SubStr("abcdef", 2, -1)' , SubStr("abcdef", 2, -1) ) // ""
SHOW_TEST('SubStr("abcdef", 2, 0)' , SubStr("abcdef", 2, 0) ) // ""
SHOW_TEST('SubStr("abcdef", 2, 1)' , SubStr("abcdef", 2, 1) ) // "b"
SHOW_TEST('SubStr("abcdef", 2, 7)' , SubStr("abcdef", 2, 7) ) // "bcdef"
SHOW_TEST('SubStr("abcdef", 2)' , SubStr("abcdef", 2) ) // "bcdef"
SHOW_TEST('SubStr("abcdef", -2, -1)' , SubStr("abcdef", -2, -1) ) // ""
SHOW_TEST('SubStr("abcdef", -2, 0)' , SubStr("abcdef", -2, 0) ) // ""
SHOW_TEST('SubStr("abcdef", -2, 1)' , SubStr("abcdef", -2, 1) ) // "e"
SHOW_TEST('SubStr("abcdef", -2, 7)' , SubStr("abcdef", -2, 7) ) // "ef"
SHOW_TEST('SubStr("abcdef", -2)' , SubStr("abcdef", -2) ) // "ef"
SHOW_TEST('SubStr("abcdef", 10, -1)' , SubStr("abcdef", 10, -1) ) // ""
SHOW_TEST('SubStr("abcdef", 10, 0)' , SubStr("abcdef", 10, 0) ) // ""
SHOW_TEST('SubStr("abcdef", 10, 1)' , SubStr("abcdef", 10, 1) ) // ""
SHOW_TEST('SubStr("abcdef", 10, 7)' , SubStr("abcdef", 10, 7) ) // ""
SHOW_TEST('SubStr("abcdef", 10)' , SubStr("abcdef", 10) ) // ""
SHOW_TEST('SubStr("abcdef", -10, -1)' , SubStr("abcdef", -10, -1) ) // ""
SHOW_TEST('SubStr("abcdef", -10, 0)' , SubStr("abcdef", -10, 0) ) // ""
SHOW_TEST('SubStr("abcdef", -10, 1)' , SubStr("abcdef", -10, 1) ) // "a"
SHOW_TEST('SubStr("abcdef", -10, 7)' , SubStr("abcdef", -10, 7) ) // "abcdef"
SHOW_TEST('SubStr("abcdef", -10, 15)' , SubStr("abcdef", -10, 15) ) // "abcdef"
SHOW_TEST('SubStr("abcdef", -10)' , SubStr("abcdef", -10) ) // "abcdef"
SHOW_LINE()
SHOW_TEST('Left("abcdef", -10)' , Left("abcdef", -10) ) // ""
SHOW_TEST('Left("abcdef", -2)' , Left("abcdef", -2) ) // ""
SHOW_TEST('Left("abcdef", 0)' , Left("abcdef", 0) ) // ""
SHOW_TEST('Left("abcdef", 2)' , Left("abcdef", 2) ) // "ab"
SHOW_TEST('Left("abcdef", 10)' , Left("abcdef", 10) ) // "abcdef"
SHOW_LINE()
SHOW_TEST('Right("abcdef", -10)' , Right("abcdef", -10) ) // ""
SHOW_TEST('Right("abcdef", -2)' , Right("abcdef", -2) ) // ""
SHOW_TEST('Right("abcdef", 0)' , Right("abcdef", 0) ) // ""
SHOW_TEST('Right("abcdef", 2)' , Right("abcdef", 2) ) // "ef"
SHOW_TEST('Right("abcdef", 10)' , Right("abcdef", 10) ) // "abcdef"
SHOW_LINE()
SHOW_TEST('PadR("abcdef", -5)' , PadR("abcdef", -5) ) // ""
SHOW_TEST('PadR("abcdef", 0)' , PadR("abcdef", 0) ) // ""
SHOW_TEST('PadR("abcdef", 5)' , PadR("abcdef", 5) ) // "abcde"
SHOW_TEST('PadR("abcdef", 10)' , PadR("abcdef", 10) ) // "abcdef "
SHOW_TEST('PadR("abcdef", 10, "1")' , PadR("abcdef", 10, "1") ) // "abcdef1111"
SHOW_TEST('PadR("abcdef", 10, "12")' , PadR("abcdef", 10, "12") ) // "abcdef1111"
SHOW_LINE()
SHOW_TEST('PadL("abcdef", -5)' , PadL("abcdef", -5) ) // ""
SHOW_TEST('PadL("abcdef", 0)' , PadL("abcdef", 0) ) // ""
SHOW_TEST('PadL("abcdef", 5)' , PadL("abcdef", 5) ) // "abcde" /* QUESTION: CA-Clipper "bug", should return: "bcdef" ? */
SHOW_TEST('PadL("abcdef", 10)' , PadL("abcdef", 10) ) // " abcdef"
SHOW_TEST('PadL("abcdef", 10, "1")' , PadL("abcdef", 10, "1") ) // "1111abcdef"
SHOW_TEST('PadL("abcdef", 10, "12")' , PadL("abcdef", 10, "12") ) // "1111abcdef"
SHOW_LINE()
SHOW_TEST('PadC("abcdef", -5)' , PadC("abcdef", -5) ) // ""
SHOW_TEST('PadC("abcdef", 0)' , PadC("abcdef", 0) ) // ""
SHOW_TEST('PadC("abcdef", 2)' , PadC("abcdef", 2) ) // "ab" /* QUESTION: CA-Clipper "bug", should return: "cd" ? */
SHOW_TEST('PadC("abcdef", 5)' , PadC("abcdef", 5) ) // "abcde"
SHOW_TEST('PadC("abcdef", 10)' , PadC("abcdef", 10) ) // " abcdef "
SHOW_TEST('PadC("abcdef", 10, "1")' , PadC("abcdef", 10, "1") ) // "11abcdef11"
SHOW_TEST('PadC("abcdef", 10, "12")' , PadC("abcdef", 10, "12") ) // "11abcdef11"
SHOW_LINE()
/* TODO: These could be more complete */
SHOW_TEST('SubStr("ab" + NUL + "def", 2, 3)', SubStr("ab" + NUL + "def", 2, 3) )
SHOW_TEST('Left("ab" + NUL + "def", 5)', Left("ab" + NUL + "def", 5) )
SHOW_TEST('Right("ab" + NUL + "def", 5)', Right("ab" + NUL + "def", 5) )
STATIC FUNCTION SHOW_TEST(cExpr, cResult)
RETURN fWrite(1, PadR(StrTran(cExpr, Chr(0), "."), 40) + " -> " + '"' + StrTran(cResult, Chr(0), ".") + '"' + Chr(13) + Chr(10))
STATIC FUNCTION SHOW_LINE()
RETURN fWrite(1, Chr(13) + Chr(10))

11
harbour/tests/working/set_num.prg Normal file
View File

@@ -0,0 +1,11 @@
// Testing SET
function Main()
local n, NEWLINE := CHR (10)
for n := 1 to 39
outstd (NEWLINE)
outstd (set (n))
next
return nil

87
harbour/tests/working/set_test.prg Normal file
View File

@@ -0,0 +1,87 @@
// Testing SET
#include "set.ch"
function Main()
local NEWLINE := CHR (13) + CHR (10)
outstd (NEWLINE)
outstd (set (_SET_ALTERNATE))
outstd (NEWLINE)
outstd (set (_SET_ALTFILE))
outstd (NEWLINE)
outstd (set (_SET_BELL))
outstd (NEWLINE)
outstd (set (_SET_CANCEL))
outstd (NEWLINE)
outstd (set (_SET_COLOR))
outstd (NEWLINE)
outstd (set (_SET_CONFIRM))
outstd (NEWLINE)
outstd (set (_SET_CONSOLE))
outstd (NEWLINE)
outstd (set (_SET_CURSOR))
outstd (NEWLINE)
outstd (set (_SET_DATEFORMAT))
outstd (NEWLINE)
outstd (set (_SET_DEBUG))
outstd (NEWLINE)
outstd (set (_SET_DECIMALS))
outstd (NEWLINE)
outstd (set (_SET_DEFAULT))
outstd (NEWLINE)
outstd (set (_SET_DELETED))
outstd (NEWLINE)
outstd (set (_SET_DELIMCHARS))
outstd (NEWLINE)
outstd (set (_SET_DELIMITERS))
outstd (NEWLINE)
outstd (set (_SET_DEVICE))
outstd (NEWLINE)
outstd (set (_SET_EPOCH))
outstd (NEWLINE)
outstd (set (_SET_ESCAPE))
outstd (NEWLINE)
outstd (set (_SET_EVENTMASK))
outstd (NEWLINE)
outstd (set (_SET_EXACT))
outstd (NEWLINE)
outstd (set (_SET_EXCLUSIVE))
outstd (NEWLINE)
outstd (set (_SET_EXIT))
outstd (NEWLINE)
outstd (set (_SET_EXTRA))
outstd (NEWLINE)
outstd (set (_SET_EXTRAFILE))
outstd (NEWLINE)
outstd (set (_SET_FIXED))
outstd (NEWLINE)
outstd (set (_SET_INSERT))
outstd (NEWLINE)
outstd (set (_SET_INTENSITY))
outstd (NEWLINE)
outstd (set (_SET_MARGIN))
outstd (NEWLINE)
outstd (set (_SET_MCENTER))
outstd (NEWLINE)
outstd (set (_SET_MESSAGE))
outstd (NEWLINE)
outstd (set (_SET_PATH))
outstd (NEWLINE)
outstd (set (_SET_PRINTER))
outstd (NEWLINE)
outstd (set (_SET_PRINTFILE))
outstd (NEWLINE)
outstd (set (_SET_SCOREBOARD))
outstd (NEWLINE)
outstd (set (_SET_SCROLLBREAK))
outstd (NEWLINE)
outstd (set (_SET_SOFTSEEK))
outstd (NEWLINE)
outstd (set (_SET_TYPEAHEAD))
outstd (NEWLINE)
outstd (set (_SET_UNIQUE))
outstd (NEWLINE)
outstd (set (_SET_WRAP))
return nil

17
harbour/tests/working/statfun.prg Normal file
View File

@@ -0,0 +1,17 @@
// Testing a static function call
function Main()
QOut( "From Main()" )
Second()
QOut( "From Main() again" )
return nil
static function Second()
QOut( "From Second()" )
return nil

24
harbour/tests/working/statics.prg Normal file
View File

@@ -0,0 +1,24 @@
// Testing Harbour statics variables management
static z := "First"
function Main()
static a := "Hello", b := { 1, 3 }
QOut( a )
QOut( b[ 2 ] )
Two()
QOut( "Ok!" )
return nil
function Two()
static a := "Test"
QOut( a )
return nil

43
harbour/tests/working/strcmp.prg Normal file
View File

@@ -0,0 +1,43 @@
//
// OurStrCmp() tests
//
// Date : 24/4/99 Time : 17:50
//
procedure main()
local CRLF := chr(13)+chr(10)
QQOut( "Testing <first> <comparison> <second>. <Second>='Hello'", CRLF )
QQOut( "<First>:", CRLF )
QQOut( " Hallo Hello Hell Hellow J 1'' 2'' all'' ", CRLF)
QQOut( "==", "Hallo" == "Hello", " ", "Hello" == "Hello", " ", ;
"Hell" == "Hello", " ", "Hellow"== "Hello", " ", ;
"J" == "Hello", " ", "" == "Hello", " ", ;
"J" == "" , " ", "" == "" , CRLF )
QQOut( "!=", "Hallo" != "Hello", " ", "Hello" != "Hello", " ", ;
"Hell" != "Hello", " ", "Hellow"!= "Hello", " ", ;
"J" != "Hello", " ", "" != "Hello", " ", ;
"J" != "" , " ", "" != "" , CRLF )
QQOut( "> ", "Hallo" > "Hello", " ", "Hello" > "Hello", " ", ;
"Hell" > "Hello", " ", "Hellow"> "Hello", " ", ;
"J" > "Hello", " ", "" > "Hello", " ", ;
"J" > "" , " ", "" > "" , CRLF )
QQOut( ">=", "Hallo" >= "Hello", " ", "Hello" >= "Hello", " ", ;
"Hell" >= "Hello", " ", "Hellow">= "Hello", " ", ;
"J" >= "Hello", " ", "" >= "Hello", " ", ;
"J" >= "" , " ", "" >= "" , CRLF )
QQOut( "<=", "Hallo" <= "Hello", " ", "Hello" <= "Hello", " ", ;
"Hell" <= "Hello", " ", "Hellow"<= "Hello", " ", ;
"J" <= "Hello", " ", "" <= "Hello", " ", ;
"J" <= "" , " ", "" <= "" , CRLF )
QQOut( "< ", "Hallo" < "Hello", " ", "Hello" < "Hello", " ", ;
"Hell" < "Hello", " ", "Hellow"< "Hello", " ", ;
"J" < "Hello", " ", "" < "Hello", " ", ;
"J" < "" , " ", "" < "" , CRLF )
return

27
harbour/tests/working/strings.prg Normal file
View File

@@ -0,0 +1,27 @@
// Testing Harbour strings management runtime library
function Main()
QOut( "Testing Harbour strings management runtime library" )
QOut( "Chr( 97 ) = ", Chr( 97 ) )
QOut( "Lower( 'ABCdE' ) = ", Lower( "ABCdE" ) )
QOut( "Replicate( 'abc', 5 ) = ", Replicate( "abc", 5 ) )
QOut( '"*" + Space( 5 ) + "*" = ', "*" + Space( 5 ) + "*" )
QOut( '"*" + LTrim( " test" ) + "*" = ', "*" + LTrim( " test" ) + "*" )
QOut( 'SubStr( "abcdef", 2, 3 ) = ', SubStr( "abcdef", 2, 3 ) )
QOut( 'Asc( "a" ) = ', Asc( "a" ) )
QOut( 'IsDigit( "123" ) = ', IsDigit( "123" ) )
QOut( 'Right( "world", 2 ) = ', Right( "world", 2 ) )
QOut( 'Left( "world", 2 ) = ', Left( "world", 2 ) )
return nil

29
harbour/tests/working/strings2.prg Normal file
View File

@@ -0,0 +1,29 @@
procedure main()
local AString := "A should be 65"
local Another := " lost in space "
QOut( right(AString, 2) + substr(AString, 2, 11) + left(AString, 1))
QOut('"' + ltrim(Another) + '"')
QOut('"' + rtrim(Another) + '"')
QOut('"' + alltrim(Another) + '"')
QOut('"' + padr(AString, 20) + '"')
QOut('"' + padr(AString, 20, '_') + '"')
QOut('"' + padl(AString, 20) + '"')
QOut('"' + padl(AString, 20, '_') + '"')
QOut('"' + padc(AString, 20) + '"')
QOut('"' + padc(AString, 20, '_') + '"')
QOut('"' + padc(AString, 21) + '"')
QOut('"' + padc(AString, 21, '_') + '"')
return

123
harbour/tests/working/strings3.prg Normal file
View File

@@ -0,0 +1,123 @@
function main
local cStr := "This is " + CHR(0) + " a test."
local cTest, nI, nJ, crlf := CHR(13)+CHR(10)
// Test various string operators.
OUTSTD (LEN(cStr))
OUTSTD (cStr)
OUTSTD (UPPER (cStr))
OUTSTD (LOWER (cStr))
OUTSTD (CHR (13) + CHR (10))
OUTSTD (ASC (SUBSTR (cStr, 8)))
OUTSTD (ASC (SUBSTR (cStr, 9)))
OUTSTD (ASC (SUBSTR (cStr, 10)))
OUTSTD (crlf)
OUTSTD (crlf)
OUTSTD (crlf)
OUTSTD (">")
OUTSTD (LEFT (cStr, 8))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (">")
OUTSTD (RIGHT (cStr, 8))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (ISDIGIT ("9"))
OUTSTD (crlf)
OUTSTD (ISDIGIT ("9A"))
OUTSTD (crlf)
OUTSTD (ISDIGIT ("AA"))
OUTSTD (crlf)
OUTSTD (ISDIGIT ("A"))
OUTSTD (crlf)
OUTSTD (crlf)
cTest := " " + CHR (0) + "ABC" + CHR (0) + " "
OUTSTD (crlf)
OUTSTD (">")
OUTSTD(LTRIM (cTest))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (">")
OUTSTD(TRIM (cTest))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (">")
OUTSTD(ALLTRIM (cTest))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (crlf)
OUTSTD (crlf)
OUTSTD (">")
OUTSTD (REPLICATE ("!", 32))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (">")
OUTSTD (SPACE (32))
OUTSTD("<")
// Test string copying.
cTest := cStr
OUTSTD (crlf)
OUTSTD (cStr)
OUTSTD (crlf)
OUTSTD (cTest)
OUTSTD (crlf)
OUTSTD (crlf)
// Test string concatenation.
cTest += cStr
OUTSTD (crlf)
OUTSTD (cStr)
OUTSTD (crlf)
OUTSTD (cTest)
OUTSTD (crlf)
OUTSTD (crlf)
// Test the string comparison operators in the HVM.
StrTest ("ABC", "ABC")
StrTest ("ABC", "ABCD")
StrTest ("ABCD", "ABC")
StrTest ("ABC", "DEF")
StrTest ("ABC", "DEFG")
StrTest ("ABCD", "DEF")
OUTSTD (crlf)
OUTSTD (crlf)
return nil
function StrTest (Str1, Str2)
OUTSTD (CHR(13)+CHR(10)+CHR(10))
OUTSTD (Str1)
OUTSTD (", ")
OUTSTD (Str2)
OUTSTD (" == ")
OUTSTD (Str1 == Str2)
OUTSTD (", != ")
OUTSTD (Str1 != Str2)
OUTSTD (", < ")
OUTSTD (Str1 < Str2)
OUTSTD (", <= ")
OUTSTD (Str1 <= Str2)
OUTSTD (", > ")
OUTSTD (Str1 > Str2)
OUTSTD (", >= ")
OUTSTD (Str1 >= Str2)
OUTSTD (CHR(13)+CHR(10))
OUTSTD (Str2)
OUTSTD (", ")
OUTSTD (Str1)
OUTSTD (" == ")
OUTSTD (Str2 == Str1)
OUTSTD (", != ")
OUTSTD (Str2 != Str1)
OUTSTD (", < ")
OUTSTD (Str2 < Str1)
OUTSTD (", <= ")
OUTSTD (Str2 <= Str1)
OUTSTD (", > ")
OUTSTD (Str2 > Str1)
OUTSTD (", >= ")
OUTSTD (Str2 >= Str1)
return nil

7
harbour/tests/working/strings4.prg Normal file
View File

@@ -0,0 +1,7 @@
function Main()
QOut( "Inside strings4" )
At() // generating an error
return nil

14
harbour/tests/working/t1.prg Normal file
View File

@@ -0,0 +1,14 @@
// while loop test
function Main()
local i := 0
local cb := {|| QOut("test")}
while i < 10000
QOut(i)
eval(cb)
i++
end
return nil

15
harbour/tests/working/test.prg Normal file
View File

@@ -0,0 +1,15 @@
//
procedure main()
local s := " " + chr(0) + " mab " + chr(0) + " "
StrDump( s )
QOut( s )
qout( '"' + ltrim(s) + '"' )
qout( '"' + rtrim(s) + '"' )
qout( '"' + alltrim(s) + '"' )
return

11
harbour/tests/working/test10.prg Normal file
View File

@@ -0,0 +1,11 @@
// compile this using Harbour /10 flag
Function Main()
QOut( MyReplicatZZ( 'a', 10 ) )
return NIL
Function MyReplicator( cChar, nLen )
return Replicate( cChar, nLen )

11
harbour/tests/working/testerro.prg Normal file
View File

@@ -0,0 +1,11 @@
// Testing Harbour Error system
function Main()
local n
QOut( "We are running and now an error will raise" )
n++ // an error should raise here
return nil

37
harbour/tests/working/testid.prg Normal file
View File

@@ -0,0 +1,37 @@
// Warning: This sample must be tested using /dTEST compiler flag
#define FIRST
#define SECOND
#define THIRD
function Main()
QOut( "testing Harbour /d compiler flag" )
#ifdef TEST
QOut( "Fine, you have just tested the /d compiler flag" )
#else
QOut( "Please change hb32.bat and include /dTEST compiler flag" )
#endif
#ifdef FIRST
QOut( "FIRST is defined" )
#ifdef SECOND
QOut( "FIRST and SECOND are defined" )
#ifdef THIRD
QOut( "FIRST, SECOND and THIRD are defined" )
#else
QOut( "THIRD is not defined" )
#endif
#else
QOut( "SECOND is not defined" )
#endif
#else
QOut( "FIRST is not defined" )
#endif
return nil

9
harbour/tests/working/testinc.prg Normal file
View File

@@ -0,0 +1,9 @@
// Testing #includes
#include "Test.ch"
function Main()
QOut( _HARBOUR_VERS )
return nil

10
harbour/tests/working/testmem.prg Normal file
View File

@@ -0,0 +1,10 @@
// Testing memory release
function main()
local a, b
a := "Hello"
b := 2
return nil

23
harbour/tests/working/testtok.prg Normal file
View File

@@ -0,0 +1,23 @@
procedure main()
local a := strtoarray("this is a great big test of strtoken")
local i
for i := 1 to len(a)
qout( a[i] )
next
return
function strtoarray(s)
local aResult := {}
local t, l
while( s <> "" )
t := strtoken(s, 1,, @l)
aadd(aResult, t)
s := substr(s, l + 2) // skip the delimiter
qout( t, str(l), s )
end
return aResult

117
harbour/tests/working/transfrm.prg Normal file
View File

@@ -0,0 +1,117 @@
//extern OutStd
//extern Str
function Main()
QOut("// PLEASE SET DATE TO BRITISH AND CENTURY ON")
QOut( "Hallo ", "!!!!! ", transform( "Hallo ", "!!!!!" ) )
QOut( "Hallo ", "!!A!! ", transform( "Hallo ", "!!A!!" ) )
QOut( "Hallo ", "!!A9! ", transform( "Hallo ", "!!A9!" ) )
QOut( "Hallo ", "!QA9! ", transform( "Hallo ", "!QA9!" ) )
QOut( "Hallo ", "ZQA9! ", transform( "Hallo ", "ZQA9!" ) )
QOut( "Hall ", "ZQA9! ", transform( "Hall" , "ZQA9!" ) )
QOut( "Hallo ", "!AAA ", transform( "Hallo ", "!AAA" ) )
QOut( "Hallo ", "@! ", transform( "Hallo ", "@!" ) )
QOut( "Hallo ", "@! AA ", transform( "Hallo ", "@! AA" ) )
QOut( "Hallo ", "@R ", transform( "Hallo ", "@R" ) )
QOut( "Hallo ", "@Z ", transform( "Hallo ", "@Z" ) )
QOut( "Hallo ", "@R !! ", transform( "Hallo ", "@R !!" ) )
QOut( "Hi ", "@R !!! ", transform( "Hi" , "@R !!!" ) )
QOut( "Hallo ", " ", transform( "Hallo ", "" ) )
Pause()
QOut( ".T. ", " ", transform( .T. , "" ) )
QOut( ".F. ", " ", transform( .F. , "" ) )
QOut( ".T. ", "L ", transform( .T. , "L" ) )
QOut( ".F. ", "L ", transform( .F. , "L" ) )
QOut( ".T. ", "Y ", transform( .T. , "Y" ) )
QOut( ".F. ", "Y ", transform( .F. , "Y" ) )
QOut( ".T. ", "X ", transform( .T. , "X" ) )
QOut( ".F. ", "# ", transform( .F. , "#" ) )
QOut( ".T. ", "X! ", transform( .T. , "X!" ) )
QOut( ".F. ", "@R Y ", transform( .F. , "@R Y" ) )
QOut( ".T. ", "@R X! ", transform( .T. , "@R X!" ) )
Pause()
QOut( "15 ", "9999 ", transform( 15 , "9999" ) )
QOut( "1.5 ", "99.99 ", transform( 1.5 , "99.99" ) )
QOut( "1.5 ", "9999 ", transform( 1.5 , "9999" ) )
QOut( "15 ", "#### ", transform( 15 , "####" ) )
QOut( "1.5 ", "##.## ", transform( 1.5 , "##.##" ) )
QOut( "1.5 ", "#### ", transform( 1.5 , "####" ) )
QOut( "15 ", " AX## " ,transform( 15 , " AX##" ) )
QOut( "1.5 ", "!9XPA.9 " ,transform( 1.5 , "!9XPA.9" ) )
QOut( "-15 ", "9999 ", transform( -15 , "9999" ) )
QOut( "-1.5 ", "99.99 ", transform( -1.5 , "99.99" ) )
QOut( "-15 ", "$999 ", transform( -15 , "$999" ) )
QOut( "-1.5 ", "*9.99 ", transform( -1.5 , "*9.99" ) )
QOut( "41 ", "$$$9 ", transform( 41 , "$$$9" ) )
QOut( "41 ", "***9 ", transform( 41 , "***9" ) )
QOut( "15000 ", "9999 ", transform( 15000 , "9999" ) )
QOut( "15000 ", "99,999 ", transform( 15000 , "99,999" ) )
Pause()
QOut( "1500 ", "99,999 ", transform( 1500 , "99,999" ) )
QOut( "150 ", "99,999 ", transform( 150 , "99,999" ) )
QOut( "150 ", "99,99 ", transform( 150 , "99,99" ) )
QOut( "41 ", "@Z 9999 ", transform( 41 , "@Z 9999" ) )
QOut( "0 ", "@Z 9999 ", transform( 0 , "@Z 9999" ) )
QOut( "41 ", "@0 9999 ", transform( 41 , "@0 9999" ), " (Harbour Power !)" )
QOut( "0 ", "@0 9999 ", transform( 0 , "@0 9999" ), " (Harbour Power !)" )
QOut( "41 ", "@B 9999 ", transform( 41 , "@B 9999" ) )
QOut( "41 ", "@B 99.9 ", transform( 41 , "@B 99.9" ) )
Pause()
QOut( "7 ", "@B 99.9 ", transform( 7 , "@B 99.9" ) )
QOut( "7 ", "@C 99.9 ", transform( 7 , "@C 99.9" ) )
QOut( "-7 ", "@C 99.9 ", transform( -7 , "@C 99.9" ) )
QOut( "7 ", "@X 99.9 ", transform( 7 , "@X 99.9" ) )
QOut( "-7 ", "@X 99.9 ", transform( -7 , "@X 99.9" ) )
QOut( "7 ", "@( 99.9 ", transform( 7 , "@( 99.9" ) )
QOut( "-7 ", "@( 99.9 ", transform( -7 , "@( 99.9" ) )
QOut( "7 ", "9X9Z5.9 ", transform( 7 , "9X9Z5.9" ) )
QOut( "-7 ", "@R 9X9^ ", transform( -7 , "@R 9X9^" ) )
QOut( "-7 ", "9X9^ ", transform( -7 , "9X9^" ) )
QOut( "1 ", "@R 9HI! ", transform( 1 , "@R 9HI!" ) )
QOut( "1 ", "9HI! ", transform( 1 , "9HI!" ) )
QOut( "-12 ", "@( 99 ", transform( -12 , "@( 99" ), " (BUG Fix)" )
QOut( "12 ", "@( 99 ", transform( 12 , "@( 99" ) )
Pause()
QOut( "1 ", " ", transform( 1 , "" ) )
QOut( "32768 ", " ", transform( 32768 , "" ) )
QOut( "-20 ", " ", transform( -20 , "" ) )
QOut( "1048576 ", " ", transform( 1048576 , "" ) )
QOut( "21.65 ", " ", transform( 21.65 , "" ) )
QOut( "-3.33 ", " ", transform( -3.33 , "" ) )
Pause()
QOut( "-1234 ", "@( 9999 ", transform( -1234 , "@( 9999" ), " (BUG Fix)" )
QOut( "-1234 ", "@B( 9999 ", transform( -1234 , "@B 9999" ) )
QOut( "1234 ", "@E 9,999.99 ", transform( 1234 , "@E 9,999.99" ) )
QOut( "12.2 ", "@E 9,999.99 ", transform( 12.2 , "@E 9,999.99" ) )
QOut( "-1234 ", "@X 9999 ", transform( -1234 , "@X 9999" ) )
QOut( "-1234 ", "@BX 9999 ", transform( -1234 , "@BX 9999" ) )
QOut( "1234 ", "@X 9999 ", transform( 1234 , "@B 9999" ) )
QOut( "1234 ", "@BX 9999 ", transform( 1234 , "@BX 9999" ) )
QOut( "1234 ", "@D 9999 ", transform( 1234 , "@D 9999" ), " (BUG Fix)" )
QOut( "1234 ", "@BD 9999 ", transform( 1234 , "@BD 9999" ), " (BUG Fix)" )
QOut( "0 ", "@Z 9999 ", transform( 0 , "@Z 9999" ) )
QOut( "0 ", "@BZ 9999 ", transform( 0 , "@BZ 9999" ) )
QOut( "NIL ", "9 ", transform( NIL , "9" ) )
Pause()
QOut( "12/12/1990 ", "99/99/9999 ", transform( ctod("12/12/1990") , "99/99/9999" ) )
QOut( "02/12/1990 ", "99.99.9999 ", transform( ctod("02/12/1990") , "99.99.9999" ) )
QOut( " / / ", "99/99/9999 ", transform( ctod(" / / ") , "99/99/9999" ) )
QOut( "02/12/1990 ", "99/99/99 ", transform( ctod("02/12/1990") , "99/99/99" ) )
QOut( "12/12/1990 ", "99-99-99 ", transform( ctod("12/12/1990") , "99-99-99" ) )
QOut( "30/04/2004 ", "99.99.99 ", transform( ctod("30/04/2004") , "99.99.99" ) )
QOut( " / / ", "99/99/99 ", transform( ctod(" / / ") , "99/99/99" ) )
QOut( "01/01/1992 ", "THISWRNG ", transform( ctod("01/01/1992") , "THISWRNG" ) )
QOut( "05/06/1935 ", "999/99/9 ", transform( ctod("05/06/1935") , "999/99/9" ) )
QOut( "12/11/1910 ", "9#-9#/## ", transform( ctod("12/11/1910") , "9#-9#/##" ) )
QOut( "01/01/1992 ", " ", transform( ctod("01/01/1992") , "" ) )
QOut( "01/01/1992 ", "DO THIS ", transform( ctod("01/01/1992") , "DO THIS " ) )
QOut( "02/01/1992 ", "@E ", transform( ctod("02/01/1992") , "@E" ) )
QOut("")
return nil
function Pause()
QOut("")
__Accept( "Pause:" )
return nil

7
harbour/tests/working/val.prg Normal file
View File

@@ -0,0 +1,7 @@
// Testing ValType
function Main()
QOut( ValType( { 1, 2, 3 } ) )
return nil

11
harbour/tests/working/while.prg Normal file
View File

@@ -0,0 +1,11 @@
// while loop test
function Main()
local x := 0
while x++ < 1000
QOut( x )
end
return nil

67
harbour/tools.b16 Normal file
View File

@@ -0,0 +1,67 @@
# makefile for Borland C/C++ 16 bits
.path.c = mylib
.path.h = include
.path.l = source\compiler
.path.y = source\compiler
.path.exe = bin
.path.lib = libs\b16
.path.obj = obj
.path.prg = mylib
PROJECT: tools.lib
Tools.lib : mouse.obj md.obj attrib.obj \
cd.obj rd.obj f_eplx81.obj f_impctl.obj \
f_tesprn.obj f_acolor.obj f_errton.obj nettryui.obj \
f_escpri.obj nconvert.obj f_mensa.obj \
pathx.obj nettry.obj encrypt.obj uncrypt.obj
mouse.obj : mouse.c
md.obj : md.c
attrib.obj : attrib.c
cd.obj : cd.c
rd.obj : rd.c
f_eplx81.obj : f_eplx81.prg
f_impctl.obj : f_impctl.prg
f_tesprn.obj : f_tesprn.prg
f_acolor.obj : f_acolor.prg
f_errton.obj : f_errton.prg
nettryui.obj : nettryui.prg
f_escpri.obj : f_escpri.prg
nconvert.obj : nconvert.prg
f_mensa.obj : f_mensa.prg
pathx.obj : pathx.prg
nettry.obj : nettry.prg
encrypt.obj : encrypt.prg
uncrypt.obj : uncrypt.prg
.prg.c:
bin\harbour $< /n
.c.obj:
bcc -4 -c -ml -O2 -Fm -I.\include -o$@ $<
tlib .\libs\b16\tools.lib -+$@,,
mouse.obj : mouse.c
md.obj : md.c
attrib.obj : attrib.c
cd.obj : cd.c
rd.obj : rd.c
f_eplx81.obj : f_eplx81.prg
f_impctl.obj : f_impctl.prg
f_tesprn.obj : f_tesprn.prg
f_acolor.obj : f_acolor.prg
f_errton.obj : f_errton.prg
nettryui.obj : nettryui.prg
f_escpri.obj : f_escpri.prg
nconvert.obj : nconvert.prg
f_mensa.obj : f_mensa.prg
pathx.obj : pathx.prg
nettry.obj : nettry.prg
encrypt.obj : encrypt.prg
uncrypt.obj : uncrypt.prg

67
harbour/tools.b32 Normal file
View File

@@ -0,0 +1,67 @@
# makefile for Borland C/C++ 16 bits
.path.c = mylib
.path.h = include
.path.l = source\compiler
.path.y = source\compiler
.path.exe = bin
.path.lib = libs\b32
.path.obj = obj
.path.prg = mylib
PROJECT: tools.lib
Tools.lib : mouse.obj md.obj attrib.obj \
cd.obj rd.obj f_eplx81.obj f_impctl.obj \
f_tesprn.obj f_acolor.obj f_errton.obj nettryui.obj \
f_escpri.obj nconvert.obj f_mensa.obj \
pathx.obj nettry.obj encrypt.obj uncrypt.obj shutdown.obj
mouse.obj : mouse.c
md.obj : md.c
attrib.obj : attrib.c
cd.obj : cd.c
rd.obj : rd.c
shutdown.obj : shutdown.c
f_eplx81.obj : f_eplx81.prg
f_impctl.obj : f_impctl.prg
f_tesprn.obj : f_tesprn.prg
f_acolor.obj : f_acolor.prg
f_errton.obj : f_errton.prg
nettryui.obj : nettryui.prg
f_escpri.obj : f_escpri.prg
nconvert.obj : nconvert.prg
f_mensa.obj : f_mensa.prg
pathx.obj : pathx.prg
nettry.obj : nettry.prg
encrypt.obj : encrypt.prg
uncrypt.obj : uncrypt.prg
.prg.c:
bin\harbour32 $< /n
.c.obj:
bcc32 -c -O2 -I.\include -o$@ $<
tlib .\libs\b32\tools.lib -+$@,,
mouse.obj : mouse.c
md.obj : md.c
attrib.obj : attrib.c
cd.obj : cd.c
rd.obj : rd.c
f_eplx81.obj : f_eplx81.prg
f_impctl.obj : f_impctl.prg
f_tesprn.obj : f_tesprn.prg
f_acolor.obj : f_acolor.prg
f_errton.obj : f_errton.prg
nettryui.obj : nettryui.prg
f_escpri.obj : f_escpri.prg
nconvert.obj : nconvert.prg
f_mensa.obj : f_mensa.prg
pathx.obj : pathx.prg
nettry.obj : nettry.prg
encrypt.obj : encrypt.prg
uncrypt.obj : uncrypt.prg