diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 0ae7a56aa3..e530f16f49 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,112 @@ +19990816-02:45 GMT+1 Victor Szel + + * include/extend.h + source/rtl/classes.c + source/rtl/objfunc.prg + source/rtl/tclass.prg + source/vm/hvm.c + source/tools/stringp.prg + tests/working/dynobj.prg + tests/working/debugtst.prg + tests/working/inherit.prg + tests/working/strip.prg + tests/working/objects.prg + + % Some variables and functions made static in classes.c + ! Completed init symbol list. + + * Names changed to standard ones (they should also work in 10 chars mode): + + ClassCreate -> __clsNew + ClassInstance -> __clsInst + __InstSuper -> __clsInstSuper + ClassAdd -> __clsAddMsg + ClassDel -> __clsDelMsg + ClassMod -> __clsModMsg + WClsDatas -> __cls_CntClsData + __wDatas -> __cls_CntData + __wDataDec -> __cls_DecData + __wDataInc -> __cls_IncData + + aOMethod -> __objGetMethodList + aOData -> __objGetMsgList + aOGet -> __objGetValueList + aOSet -> __objSetValueList + oClone -> __objClone + ClassName -> __objGetClsName + oSend -> __objSendMsg + isMessage -> __objHasMsg + IsData -> __objHasData + IsMethod -> __objHasMethod + oAddMethod -> __objAddMethod + oAddInline -> __objAddInLine + oAddData -> __objAddData + oModMethod -> __objModMethod + oModInline -> __objModInLine + oDelMethod -> __objDelMethod + oDelInline -> __objDelInLine + oDelData -> __objDelData + + ClassH -> __msgClsH + ClassName -> __msgClsName + ClassSel -> __msgClsSel + SelectSuper -> __msgSuper + EvalInline -> __msgEvalInline + GetClassData -> __msgGetClsData + SetClassData -> __msgSetClsData + GetData -> __msgGetData + SetData -> __msgSetData + Virtual -> __msgVirtual + + DictRealloc -> hb_clsDictRealloc + ReleaseClass -> hb_clsRelease + ReleaseClasses -> hb_clsReleaseAll + hb_GetClassName -> hb_objGetClsName + hb_GetMethod -> hb_objGetMethod + hb_isMessage -> hb_objHasMsg + + * include/hboo.ch + source/rtl/classes.c + source/rtl/objfunc.prg + source/rtl/tclass.prg + source/tools/stringp.prg + tests/working/dynobj.prg + tests/working/objects.prg + tests/working/overload.prg + tests/working/objects.prg + + + MET_ and DATA_ declaration moved to one place (hboo.ch). + + * source/rtl/errorapi.c + include/errorapi.h + + % hb_error*() functions are returning void instead of WORD, except for + hb_errorRT_BASE_Ext1(). + + * include/error.ch + include/langapi.h + source/rtl/langapi.c + + + New error code EG_ARRDIMENSION added + + * source/rtl/arrays.c + + ! ARRAY() now properly checks the passed parameters (Clipper compatible). + + ARRAY() TODO: added (to support multiple dimensions) + ! AADD() Fixed parameter handling, throws errors like Clipper. + ! ASIZE() Fixed parameter handling. + ! hb_arrayIns() removed one error to be Clipper compatible. + ! hb_arrayDel() removed one error to be Clipper compatible. + + AFILL(), ASCAN(), AEVAL(), ACOPY() TOFIX: added. + + * source/rtl/transform.c + + ! _exit -> exit (_exit had no prototype, and that was the only place + where it was used) + ! Some BYTE and int changed to BOOL at obviouse place. + ! Some functions made static. + ! Some unused variables removed (lFact*) + 19990815-18:45 GMT+2 Ryszard Glab *source/rtl/hvm.c @@ -35,7 +144,7 @@ * added functionality - some methods implemented, added support of footing, head separator, footer separator, freeze. Now it seems almost complete. - + 19990815-17:40 GMT+1 Victor Szel * bldodbc.bat hbodbc.b32 diff --git a/harbour/include/error.ch b/harbour/include/error.ch index c184981ab6..14ea2d4940 100644 --- a/harbour/include/error.ch +++ b/harbour/include/error.ch @@ -56,7 +56,8 @@ #define EG_ARGCOUNT 45 /* Harbour special */ #define EG_ARRACCESS 46 /* Harbour special */ #define EG_ARRASSIGN 47 /* Harbour special */ -#define EG_NOTARRAY 48 /* Harbour special */ -#define EG_CONDITION 49 /* Harbour special */ +#define EG_ARRDIMENSION 48 /* Harbour special */ +#define EG_NOTARRAY 49 /* Harbour special */ +#define EG_CONDITION 50 /* Harbour special */ #endif /* _ERROR_CH */ diff --git a/harbour/include/errorapi.h b/harbour/include/errorapi.h index b0a2c7b2e3..9ea54109bd 100644 --- a/harbour/include/errorapi.h +++ b/harbour/include/errorapi.h @@ -99,11 +99,11 @@ extern void hb_errRelease ( PHB_ITEM pError ); extern void hb_errorInternal ( ULONG ulIntCode, char * szText, char * szModul, WORD wLine, char * szPar1, char * szPar2, char * szPar3 ); -extern WORD hb_errorRT_BASE ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); +extern void hb_errorRT_BASE ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); extern WORD hb_errorRT_BASE_Ext1 ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOsCode, USHORT uiFlags ); -extern WORD hb_errorRT_TERMINAL ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); -extern WORD hb_errorRT_DBCMD ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); -extern WORD hb_errorRT_TOOLS ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); +extern void hb_errorRT_TERMINAL ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); +extern void hb_errorRT_DBCMD ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); +extern void hb_errorRT_TOOLS ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); extern char * hb_errorNatDescription ( ULONG ulGenCode ); /* Reads error description in national language */ extern char * hb_errorNatInternal ( ULONG ulIntCode ); /* Reads internal error description in national language */ diff --git a/harbour/include/extend.h b/harbour/include/extend.h index 2f2488b8b0..1e39f6ffd7 100644 --- a/harbour/include/extend.h +++ b/harbour/include/extend.h @@ -290,9 +290,12 @@ extern char * hb_strUpper( char * szText, long lLen ); extern char * hb_strLower( char * szText, long lLen ); /* class management */ -extern PHB_FUNC hb_GetMethod( PHB_ITEM pObject, PHB_SYMB pSymMsg ); /* returns the method pointer of a object class */ -extern char * hb_GetClassName( PHB_ITEM pObject ); /* retrieves an object class name */ -extern ULONG hb_isMessage( PHB_ITEM, char * ); +extern void hb_clsReleaseAll( void ); /* releases all defined classes */ + +/* object management */ +extern char * hb_objGetClsName( PHB_ITEM pObject ); /* retrieves an object class name */ +extern PHB_FUNC hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pSymMsg ); /* returns the method pointer of a object class */ +extern ULONG hb_objHasMsg( PHB_ITEM pObject, char *szString ); /* dynamic symbol table management */ extern PHB_DYNS hb_dynsymGet( char * szName ); /* finds and creates a dynamic symbol if not found */ diff --git a/harbour/include/hboo.ch b/harbour/include/hboo.ch new file mode 100644 index 0000000000..9de7ceca2d --- /dev/null +++ b/harbour/include/hboo.ch @@ -0,0 +1,20 @@ +/* + * $Id$ + */ + +/* NOTE: This file is also used by C code. */ + +#ifndef _HBOO_CH +#define _HBOO_CH + +#define MET_METHOD 0 +#define MET_DATA 1 +#define MET_CLASSDATA 2 +#define MET_INLINE 3 +#define MET_VIRTUAL 4 +#define MET_SUPER 5 + +#define DATA_SYMBOL 1 +#define DATA_VAL 2 + +#endif /* _HBOO_CH */ diff --git a/harbour/include/langapi.h b/harbour/include/langapi.h index 88e6254e42..e5c1be988a 100644 --- a/harbour/include/langapi.h +++ b/harbour/include/langapi.h @@ -41,7 +41,7 @@ #define HB_LANG_TEXT_NOCHAR 2 #define HB_LANG_TEXT_MAX_ 3 -#define HB_LANG_ED_MAX_ 50 +#define HB_LANG_ED_MAX_ 51 #define HB_LANG_EI_MAX_ 6 /* ; */ diff --git a/harbour/source/rtl/arrays.c b/harbour/source/rtl/arrays.c index 31d4716f6f..d28f571ce4 100644 --- a/harbour/source/rtl/arrays.c +++ b/harbour/source/rtl/arrays.c @@ -395,10 +395,6 @@ void hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex ) hb_itemClear( pBaseArray->pItems + ( ulLen - 1 ) ); } - else - { - hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_langDGetErrorDesc(EG_ARRACCESS)); - } } else { @@ -423,10 +419,6 @@ void hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex ) hb_itemClear( pBaseArray->pItems + ulLen ); } - else - { - hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_langDGetErrorDesc(EG_ARRACCESS)); - } } else { @@ -649,33 +641,76 @@ PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray ) /* * HARBOUR */ + +/* TODO: Support multiple dimensions */ + HARBOUR HB_ARRAY( void ) { - hb_arrayNew( &stack.Return, hb_parnl( 1 ) ); + int iParCount = hb_pcount(); + + if ( iParCount > 0 ) + { + int tmp; + BOOL lError = FALSE; + + for ( tmp = 1; tmp <= iParCount; tmp++ ) + { + if ( !ISNUM( tmp ) ) + { + lError = TRUE; + break; + } + + if ( hb_parnl( tmp ) < 0 ) + { + hb_errorRT_BASE( EG_BOUND, 1131, NULL, hb_langDGetErrorDesc( EG_ARRDIMENSION ) ); + } + } + + if ( lError ) + hb_ret(); + else + hb_arrayNew( &stack.Return, hb_parnl( 1 ) ); + } + else + hb_ret(); } HARBOUR HB_AADD( void ) { - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); - PHB_ITEM pValue = hb_param( 2, IT_ANY ); + if ( hb_pcount() == 2 ) + { + if ( ISARRAY( 1 ) ) + { + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + PHB_ITEM pValue = hb_param( 2, IT_ANY ); - if ( pArray ) - hb_arrayAdd( pArray, pValue ); + hb_arrayAdd( pArray, pValue ); - hb_itemCopy( &stack.Return, pValue ); + hb_itemCopy( &stack.Return, pValue ); + } + else + hb_errorRT_BASE( EG_ARG, 1123, NULL, "AADD" ); + } + else + /* QUESTION: Clipper catches this at compile time! */ + hb_errorRT_BASE( EG_ARGCOUNT, 3000, NULL, "AADD" ); } HARBOUR HB_ASIZE( void ) { PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); - if ( pArray ) - { - hb_arraySize( pArray, hb_parnl( 2 ) ); - hb_itemCopy( &stack.Return, pArray ); /* ASize() returns the array itself */ - } + if ( pArray && ISNUM( 2 ) ) + { + LONG lSize = hb_parnl( 2 ); + + hb_arraySize( pArray, MAX( lSize, 0 ) ); + + hb_itemCopy( &stack.Return, pArray ); /* ASize() returns the array itself */ + } else - hb_ret(); /* QUESTION: Should we raise an error here ? */ + hb_ret(); } HARBOUR HB_ATAIL( void ) @@ -685,7 +720,7 @@ HARBOUR HB_ATAIL( void ) if ( pArray ) hb_arrayLast( pArray, &stack.Return ); else - hb_ret(); /* QUESTION: Should we raise an error here ? */ + hb_ret(); } HARBOUR HB_AINS( void ) @@ -693,10 +728,12 @@ HARBOUR HB_AINS( void ) PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); if ( pArray ) - { + { + if ( ISNUM( 2 ) ) hb_arrayIns( pArray, hb_parnl( 2 ) ); - hb_itemCopy( &stack.Return, pArray ); /* AIns() returns the array itself */ - } + + hb_itemCopy( &stack.Return, pArray ); /* AIns() returns the array itself */ + } else hb_ret(); } @@ -706,14 +743,18 @@ HARBOUR HB_ADEL( void ) PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); if ( pArray ) - { + { + if ( ISNUM( 2 ) ) hb_arrayDel( pArray, hb_parnl( 2 ) ); - hb_itemCopy( &stack.Return, pArray ); /* ADel() returns the array itself */ - } + + hb_itemCopy( &stack.Return, pArray ); /* ADel() returns the array itself */ + } else hb_ret(); } +/* TOFIX: nCount parameter == zero is incompatible. */ + HARBOUR HB_AFILL( void ) { PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); @@ -727,6 +768,8 @@ HARBOUR HB_AFILL( void ) hb_ret(); } +/* TOFIX: nCount parameter == zero is incompatible. */ + HARBOUR HB_ASCAN( void ) { PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); @@ -737,6 +780,8 @@ HARBOUR HB_ASCAN( void ) hb_retnl( 0 ); } +/* TOFIX: nCount parameter == zero is incompatible. */ + HARBOUR HB_AEVAL( void ) { PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); @@ -751,6 +796,8 @@ HARBOUR HB_AEVAL( void ) hb_ret(); } +/* TOFIX: nCount parameter == zero is incompatible. */ + HARBOUR HB_ACOPY( void ) { PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY ); diff --git a/harbour/source/rtl/classes.c b/harbour/source/rtl/classes.c index 04e604a55c..140a27b9f1 100644 --- a/harbour/source/rtl/classes.c +++ b/harbour/source/rtl/classes.c @@ -28,18 +28,17 @@ * * Partial Copyright (C) 1999 Eddie Runia ( eddie@runia.com ) * partial copyright regarding the following functions : - * CLASSDEL - * CLASSMOD * :CLASSSEL() - * ISMESSAGE - * OCLONE - * OSEND - * SELECTSUPER - * __INSTSUPER - * __WCLSDATAS - * __WDATAS - * __WDATADEC - * __WDATAINC + * __clsDelMsg() + * __clsModMsg() + * __clsInstSuper() + * __cls_CntClsData() + * __cls_CntData() + * __cls_DecData() + * __cls_IncData() + * __objClone() + * __objHasMsg() + * __objSendMsg() */ #include "extend.h" @@ -47,13 +46,7 @@ #include "itemapi.h" #include "ctoharb.h" #include "init.h" - -#define MET_METHOD 0 -#define MET_DATA 1 -#define MET_CLASSDATA 2 -#define MET_INLINE 3 -#define MET_VIRTUAL 4 -#define MET_SUPER 5 +#include "hboo.ch" typedef struct { @@ -80,97 +73,105 @@ typedef struct #define BUCKET 4 #define HASH_KEY (BASE_METHODS / BUCKET) -PCLASS pClasses = 0; -WORD wClasses = 0; -PMETHOD pMethod = 0; -PHB_DYNS msgClassName = 0; -PHB_DYNS msgClassH = 0; -PHB_DYNS msgEval = 0; -PHB_DYNS msgClassSel = 0; +static PCLASS pClasses = 0; +static WORD wClasses = 0; +static PMETHOD pMethod = 0; +static PHB_DYNS msgClassName = 0; +static PHB_DYNS msgClassH = 0; +static PHB_DYNS msgEval = 0; +static PHB_DYNS msgClassSel = 0; /* All functions contained in classes.c */ - HARBOUR HB_CLASSADD( void ); - HARBOUR HB_CLASSCREATE( void ); - HARBOUR HB_CLASSDEL( void ); -static HARBOUR ClassH( void ); - HARBOUR HB_CLASSINSTANCE( void ); - HARBOUR HB_CLASSMOD( void ); -static HARBOUR ClassName( void ); - HARBOUR HB_CLASSNAME( void ); -static HARBOUR ClassSel( void ); -static void DictRealloc( PCLASS ); -static HARBOUR EvalInline( void ); - char * hb_GetClassName( PHB_ITEM pObject ); -static HARBOUR GetClassData( void ); -static HARBOUR GetData( void ); - PHB_FUNC hb_GetMethod( PHB_ITEM, PHB_SYMB ); - ULONG hb_isMessage( PHB_ITEM, char *); - HARBOUR HB_ISMESSAGE( void ); - HARBOUR HB_OCLONE( void ); - HARBOUR HB_OSEND( void ); - void ReleaseClass( PCLASS ); - void ReleaseClasses( void ); -static HARBOUR SelectSuper( void ); -static HARBOUR SetClassData( void ); -static HARBOUR SetData( void ); -static HARBOUR Virtual( void ); - HARBOUR HB___INSTSUPER( void ); - HARBOUR HB___WCLSDATAS(void); - HARBOUR HB___WDATAS( void ); - HARBOUR HB___WDATADEC( void ); - HARBOUR HB___WDATAINC( void ); +static HARBOUR __msgClsH( void ); +static HARBOUR __msgClsName( void ); +static HARBOUR __msgClsSel( void ); +static HARBOUR __msgSuper( void ); +static HARBOUR __msgEvalInline( void ); +static HARBOUR __msgVirtual( void ); +static HARBOUR __msgGetClsData( void ); +static HARBOUR __msgSetClsData( void ); +static HARBOUR __msgGetData( void ); +static HARBOUR __msgSetData( void ); + +static void hb_clsDictRealloc( PCLASS pClass ); +static void hb_clsRelease( PCLASS ); + void hb_clsReleaseAll( void ); + + char * hb_objGetClsName( PHB_ITEM pObject ); + PHB_FUNC hb_objGetMethod( PHB_ITEM, PHB_SYMB ); + ULONG hb_objHasMsg( PHB_ITEM pObject, char *szString ); + + HARBOUR HB___CLSNEW( void ); + HARBOUR HB___CLSINST( void ); + HARBOUR HB___CLSINSTSUPER( void ); + HARBOUR HB___CLSADDMSG( void ); + HARBOUR HB___CLSDELMSG( void ); + HARBOUR HB___CLSMODMSG( void ); + HARBOUR HB___CLS_CNTCLSDATA(void); + HARBOUR HB___CLS_CNTDATA( void ); + HARBOUR HB___CLS_DECDATA( void ); + HARBOUR HB___CLS_INCDATA( void ); + HARBOUR HB___OBJGETCLSNAME( void ); + HARBOUR HB___OBJCLONE( void ); + HARBOUR HB___OBJHASMSG( void ); + HARBOUR HB___OBJSENDMSG( void ); /* All function contained in matching objfunc.prg */ -HARBOUR HB_AODATA( void ); -HARBOUR HB_AOGET( void ); -HARBOUR HB_AOMETHOD( void ); -HARBOUR HB_AOSET( void ); -HARBOUR HB_ISDATA( void ); -HARBOUR HB_ISMETHOD( void ); -HARBOUR HB_OADDDATA( void ); -HARBOUR HB_OADDINLINE( void ); -HARBOUR HB_OADDMETHOD( void ); -HARBOUR HB_ODELDATA( void ); -HARBOUR HB_ODELINLINE( void ); -HARBOUR HB_ODELMETHOD( void ); -HARBOUR HB_OMODINLINE( void ); -HARBOUR HB_OMODMETHOD( void ); +extern HARBOUR HB___OBJGETMSGLIST( void ); +extern HARBOUR HB___OBJGETMETHODLIST( void ); +extern HARBOUR HB___OBJGETVALUELIST( void ); +extern HARBOUR HB___OBJSETVALUELIST( void ); +extern HARBOUR HB___OBJHASDATA( void ); +extern HARBOUR HB___OBJHASMETHOD( void ); +extern HARBOUR HB___OBJADDDATA( void ); +extern HARBOUR HB___OBJADDINLINE( void ); +extern HARBOUR HB___OBJADDMETHOD( void ); +extern HARBOUR HB___OBJDELDATA( void ); +extern HARBOUR HB___OBJDELINLINE( void ); +extern HARBOUR HB___OBJDELMETHOD( void ); +extern HARBOUR HB___OBJMODINLINE( void ); +extern HARBOUR HB___OBJMODMETHOD( void ); /* Exported symbols of both classes.c and objfunc.prg */ HB_INIT_SYMBOLS_BEGIN( Classes__InitSymbols ) -{ "AODATA" , FS_PUBLIC, HB_AODATA , 0 }, -{ "AOGET" , FS_PUBLIC, HB_AOGET , 0 }, -{ "AOMETHOD" , FS_PUBLIC, HB_AOMETHOD , 0 }, -{ "AOSET" , FS_PUBLIC, HB_AOSET , 0 }, -{ "CLASSADD" , FS_PUBLIC, HB_CLASSADD , 0 }, -{ "CLASSCREATE" , FS_PUBLIC, HB_CLASSCREATE , 0 }, -{ "CLASSDEL" , FS_PUBLIC, HB_CLASSDEL , 0 }, -{ "CLASSINSTANCE" , FS_PUBLIC, HB_CLASSINSTANCE , 0 }, -{ "CLASSMOD" , FS_PUBLIC, HB_CLASSMOD , 0 }, -{ "CLASSNAME" , FS_PUBLIC, HB_CLASSNAME , 0 }, -{ "ISDATA" , FS_PUBLIC, HB_ISDATA , 0 }, -{ "ISMESSAGE" , FS_PUBLIC, HB_ISMESSAGE , 0 }, -{ "ISMETHOD" , FS_PUBLIC, HB_ISMETHOD , 0 }, -{ "OADDDATA" , FS_PUBLIC, HB_OADDDATA , 0 }, -{ "OADDINLINE" , FS_PUBLIC, HB_OADDINLINE , 0 }, -{ "OADDMETHOD" , FS_PUBLIC, HB_OADDMETHOD , 0 }, -{ "OCLONE" , FS_PUBLIC, HB_OCLONE , 0 }, -{ "ODELDATA" , FS_PUBLIC, HB_ODELDATA , 0 }, -{ "ODELINLINE" , FS_PUBLIC, HB_ODELINLINE , 0 }, -{ "ODELMETHOD" , FS_PUBLIC, HB_ODELMETHOD , 0 }, -{ "OMODINLINE" , FS_PUBLIC, HB_OMODINLINE , 0 }, -{ "OMODMETHOD" , FS_PUBLIC, HB_OMODMETHOD , 0 }, -{ "OSEND" , FS_PUBLIC, HB_OSEND , 0 } +{ "__CLSNEW" , FS_PUBLIC, HB___CLSNEW , 0 }, +{ "__CLSINST" , FS_PUBLIC, HB___CLSINST , 0 }, +{ "__CLSINSTSUPER" , FS_PUBLIC, HB___CLSINSTSUPER , 0 }, +{ "__CLSADDMSG" , FS_PUBLIC, HB___CLSADDMSG , 0 }, +{ "__CLSDELMSG" , FS_PUBLIC, HB___CLSDELMSG , 0 }, +{ "__CLSMODMSG" , FS_PUBLIC, HB___CLSMODMSG , 0 }, +{ "__CLS_CNTCLSDATA" , FS_PUBLIC, HB___CLS_CNTCLSDATA , 0 }, +{ "__CLS_CNTDATA" , FS_PUBLIC, HB___CLS_CNTDATA , 0 }, +{ "__CLS_DECDATA" , FS_PUBLIC, HB___CLS_DECDATA , 0 }, +{ "__CLS_INCDATA" , FS_PUBLIC, HB___CLS_INCDATA , 0 }, +{ "__OBJGETCLSNAME" , FS_PUBLIC, HB___OBJGETCLSNAME , 0 }, +{ "__OBJCLONE" , FS_PUBLIC, HB___OBJCLONE , 0 }, +{ "__OBJHASMSG" , FS_PUBLIC, HB___OBJHASMSG , 0 }, +{ "__OBJSENDMSG" , FS_PUBLIC, HB___OBJSENDMSG , 0 }, +{ "__OBJGETMSGLIST" , FS_PUBLIC, HB___OBJGETMSGLIST , 0 }, +{ "__OBJGETMETHODLIST" , FS_PUBLIC, HB___OBJGETMETHODLIST , 0 }, +{ "__OBJGETVALUELIST" , FS_PUBLIC, HB___OBJGETVALUELIST , 0 }, +{ "__OBJSETVALUELIST" , FS_PUBLIC, HB___OBJSETVALUELIST , 0 }, +{ "__OBJHASDATA" , FS_PUBLIC, HB___OBJHASDATA , 0 }, +{ "__OBJHASMETHOD" , FS_PUBLIC, HB___OBJHASMETHOD , 0 }, +{ "__OBJADDDATA" , FS_PUBLIC, HB___OBJADDDATA , 0 }, +{ "__OBJADDINLINE" , FS_PUBLIC, HB___OBJADDINLINE , 0 }, +{ "__OBJADDMETHOD" , FS_PUBLIC, HB___OBJADDMETHOD , 0 }, +{ "__OBJDELDATA" , FS_PUBLIC, HB___OBJDELDATA , 0 }, +{ "__OBJDELINLINE" , FS_PUBLIC, HB___OBJDELINLINE , 0 }, +{ "__OBJDELMETHOD" , FS_PUBLIC, HB___OBJDELMETHOD , 0 }, +{ "__OBJMODINLINE" , FS_PUBLIC, HB___OBJMODINLINE , 0 }, +{ "__OBJMODMETHOD" , FS_PUBLIC, HB___OBJMODMETHOD , 0 } HB_INIT_SYMBOLS_END( Classes__InitSymbols ) #if ! defined(__GNUC__) #pragma startup Classes__InitSymbols #endif /* - * ClassAdd( , , , , [xInit] ) + * __clsAddMsg( , , , , [xInit] ) * * Add a message to the class. * @@ -184,7 +185,7 @@ HB_INIT_SYMBOLS_END( Classes__InitSymbols ) * see MET_* * Optional initializer for DATA */ -HARBOUR HB_CLASSADD(void) +HARBOUR HB___CLSADDMSG(void) { WORD wClass = hb_parnl( 1 ); WORD wType = hb_parni( 4 ); @@ -203,7 +204,7 @@ HARBOUR HB_CLASSADD(void) wMask = pClass->wHashKey * BUCKET; if( pClass->wMethods > ( pClass->wHashKey * BUCKET * 2/3 ) ) - DictRealloc( pClass ); + hb_clsDictRealloc( pClass ); /* Find either the existing message or an open spot for a new message */ @@ -227,10 +228,10 @@ HARBOUR HB_CLASSADD(void) case MET_DATA: pNewMeth->wData = hb_parnl( 3 ); if( pMessage->pSymbol->szName[ 0 ] == '_' ) - pNewMeth->pFunction = SetData; + pNewMeth->pFunction = __msgSetData; else { - pNewMeth->pFunction = GetData; + pNewMeth->pFunction = __msgGetData; if( pInit && !IS_NIL( pInit )) /* Initializer found */ { pNewMeth->pInitValue = hb_itemNew( NULL ); @@ -245,9 +246,9 @@ HARBOUR HB_CLASSADD(void) hb_arraySize( pClass->pClassDatas, hb_parnl( 3 ) ); if( pMessage->pSymbol->szName[ 0 ] == '_' ) - pNewMeth->pFunction = SetClassData; + pNewMeth->pFunction = __msgSetClsData; else - pNewMeth->pFunction = GetClassData; + pNewMeth->pFunction = __msgGetClsData; break; case MET_INLINE: @@ -255,20 +256,20 @@ HARBOUR HB_CLASSADD(void) hb_arraySize( pClass->pInlines, pNewMeth->wData ); hb_arraySet( pClass->pInlines, pNewMeth->wData, hb_param( 3, IT_BLOCK ) ); - pNewMeth->pFunction = EvalInline; + pNewMeth->pFunction = __msgEvalInline; break; case MET_VIRTUAL: - pNewMeth->pFunction = Virtual; + pNewMeth->pFunction = __msgVirtual; break; case MET_SUPER: pNewMeth->wData = hb_parnl( 3 ); - pNewMeth->pFunction = SelectSuper; + pNewMeth->pFunction = __msgSuper; break; default: - printf( "Invalid method type from ClassAdd\n" ); + printf( "Invalid method type from __clsAddMsg\n" ); exit( 1 ); break; } @@ -277,7 +278,7 @@ HARBOUR HB_CLASSADD(void) /* - * := ClassCreate( , , [hSuper] ) + * := __clsNew( , , [hSuper] ) * * Create a new class * @@ -285,7 +286,7 @@ HARBOUR HB_CLASSADD(void) * Number of DATAs in the class * Optional handle of superclass */ -HARBOUR HB_CLASSCREATE(void) +HARBOUR HB___CLSNEW(void) { WORD wSuper = hb_parni( 3 ); /* Super class present */ WORD wSize; @@ -337,14 +338,14 @@ HARBOUR HB_CLASSCREATE(void) /* - * ClassDel( , ) + * __clsDelMsg( , ) * * Delete message (only for INLINE and METHOD) * * Object * Message */ -HARBOUR HB_CLASSDEL(void) +HARBOUR HB___CLSDELMSG(void) { PHB_ITEM pString = hb_param( 2, IT_STRING ); PHB_SYMB pMessage = hb_dynsymGet( pString->item.asString.value )->pSymbol; @@ -377,7 +378,7 @@ HARBOUR HB_CLASSDEL(void) if( wAt != wLimit ) { /* Requested method found */ pFunc = pClass->pMethods[ wAt ].pFunction; - if( pFunc == EvalInline ) /* INLINE method deleted */ + if( pFunc == __msgEvalInline ) /* INLINE method deleted */ { hb_arrayDel( pClass->pInlines, pClass->pMethods[ wAt ].wData ); /* Delete INLINE block */ @@ -406,18 +407,18 @@ HARBOUR HB_CLASSDEL(void) * * Returns class handle of */ -static HARBOUR ClassH( void ) +static HARBOUR __msgClsH( void ) { hb_retni( ( stack.pBase + 1 )->item.asArray.value->wClass ); } /* - * := ClassInstance( ) + * := __clsInst( ) * * Create a new object from class definition */ -HARBOUR HB_CLASSINSTANCE(void) +HARBOUR HB___CLSINST(void) { WORD wClass = hb_parni( 1 ); WORD wAt, wLimit; @@ -441,11 +442,11 @@ HARBOUR HB_CLASSINSTANCE(void) } /* - * ClassMod( , , ) + * __clsModMsg( , , ) * * Modify message (only for INLINE and METHOD) */ -HARBOUR HB_CLASSMOD(void) +HARBOUR HB___CLSMODMSG(void) { PHB_ITEM pString = hb_param( 2, IT_STRING ); PHB_SYMB pMessage = hb_dynsymGet( pString->item.asString.value )->pSymbol; @@ -478,13 +479,13 @@ HARBOUR HB_CLASSMOD(void) if( wAt != wLimit ) { /* Requested method found */ pFunc = pClass->pMethods[ wAt ].pFunction; - if( pFunc == EvalInline ) /* INLINE method changed */ + if( pFunc == __msgEvalInline ) /* INLINE method changed */ hb_arraySet( pClass->pInlines, pClass->pMethods[ wAt ].wData, hb_param( 3, IT_BLOCK ) ); - else if( ( pFunc == SetData ) || ( pFunc == GetData ) ) + else if( ( pFunc == __msgSetData ) || ( pFunc == __msgGetData ) ) { /* Not allowed for DATA */ - /*hb_errPutDescription(pError, "CLASSMOD: Cannot modify a DATA item");*/ - hb_errorRT_BASE(EG_ARG, 3004, NULL, "CLASSMOD"); + /*hb_errPutDescription(pError, "__clsModMsg: Cannot modify a DATA item");*/ + hb_errorRT_BASE(EG_ARG, 3004, NULL, "__CLSMODMSG"); } else /* Modify METHOD */ pClass->pMethods[ wAt ].pFunction = ( PHB_FUNC ) hb_parnl( 3 ); @@ -498,7 +499,7 @@ HARBOUR HB_CLASSMOD(void) * * Return class name of . Can also be used for all types. */ -static HARBOUR ClassName( void ) +static HARBOUR __msgClsName( void ) { PHB_ITEM pItemRef; @@ -507,7 +508,7 @@ static HARBOUR ClassName( void ) else pItemRef = stack.pBase + 1; - hb_retc( hb_GetClassName( pItemRef ) ); + hb_retc( hb_objGetClsName( pItemRef ) ); } @@ -516,7 +517,7 @@ static HARBOUR ClassName( void ) * * Returns class name of */ -HARBOUR HB_CLASSNAME(void) +HARBOUR HB___OBJGETCLSNAME(void) { PHB_ITEM pObject = hb_param( 0, IT_OBJECT ); WORD wClass; @@ -542,7 +543,7 @@ HARBOUR HB_CLASSNAME(void) * * Returns all the messages in */ -static HARBOUR ClassSel(void) +static HARBOUR __msgClsSel(void) { WORD wClass = IS_ARRAY( stack.pBase + 1 ) ? ( stack.pBase + 1 )->item.asArray.value->wClass : 0; @@ -588,27 +589,27 @@ static HARBOUR ClassSel(void) /* - * DictRealloc( PCLASS ) + * hb_clsDictRealloc( PCLASS ) * * Realloc (widen) class */ -static void DictRealloc( PCLASS pClass ) +static void hb_clsDictRealloc( PCLASS pClass ) { /* TODO: Implement it for very large classes */ if( pClass ) { - printf( "classes.c DictRealloc not implemented yet\n" ); + printf( "classes.c hb_clsDictRealloc() not implemented yet\n" ); exit( 1 ); } } /* - * EvalInline() + * __msgEvalInline() * * Internal function executed for inline methods */ -static HARBOUR EvalInline( void ) +static HARBOUR __msgEvalInline( void ) { HB_ITEM block; WORD wClass = ( stack.pBase + 1 )->item.asArray.value->wClass; @@ -628,12 +629,12 @@ static HARBOUR EvalInline( void ) /* - * = hb_GetClassName( pObject ) + * = hb_objGetClsName( pObject ) * * Get the class name of an object * */ -char * hb_GetClassName( PHB_ITEM pObject ) +char * hb_objGetClsName( PHB_ITEM pObject ) { char * szClassName; @@ -688,11 +689,11 @@ char * hb_GetClassName( PHB_ITEM pObject ) } /* - * GetClassData() + * __msgGetClsData() * * Internal function to return a CLASSDATA */ -static HARBOUR GetClassData( void ) +static HARBOUR __msgGetClsData( void ) { WORD wClass = ( stack.pBase + 1 )->item.asArray.value->wClass; WORD wIndex = pMethod->wData; @@ -704,11 +705,11 @@ static HARBOUR GetClassData( void ) /* - * GetData() + * __msgGetData() * * Internal function to return a DATA */ -static HARBOUR GetData( void ) +static HARBOUR __msgGetData( void ) { PHB_ITEM pObject = stack.pBase + 1; WORD wIndex = pMethod->wData; @@ -721,11 +722,11 @@ static HARBOUR GetData( void ) /* - * = hb_GetMethod( , ) + * = hb_objGetMethod( , ) * * Internal function to the function pointer of a message of an object */ -PHB_FUNC hb_GetMethod( PHB_ITEM pObject, PHB_SYMB pMessage ) +PHB_FUNC hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage ) { WORD wAt, wLimit, wMask; WORD wClass; @@ -767,60 +768,60 @@ PHB_FUNC hb_GetMethod( PHB_ITEM pObject, PHB_SYMB pMessage ) } } if( pMsg == msgClassName ) - return ClassName; + return __msgClsName; else if( pMsg == msgClassH ) - return ClassH; + return __msgClsH; else if( pMsg == msgClassSel ) - return ClassSel; + return __msgClsSel; else if( pMsg == msgEval ) - return EvalInline; + return __msgEvalInline; return 0; } /* - * = hb_isMessage( , ) + * = hb_objHasMsg( , ) * * Check whether is an existing message for object. * * should be read as a boolean */ -ULONG hb_isMessage( PHB_ITEM pObject, char *szString ) +ULONG hb_objHasMsg( PHB_ITEM pObject, char *szString ) { PHB_SYMB pMessage = hb_dynsymGet( szString )->pSymbol; - return( (ULONG) hb_GetMethod( pObject, pMessage ) ); + return( (ULONG) hb_objGetMethod( pObject, pMessage ) ); } /* Get funcptr of message */ /* - * := IsMessage( , ) + * := __objHasMsg( , ) * * Is a valid message for the */ -HARBOUR HB_ISMESSAGE(void) +HARBOUR HB___OBJHASMSG(void) { PHB_ITEM pObject = hb_param( 1, IT_OBJECT ); PHB_ITEM pString = hb_param( 2, IT_STRING ); if( pObject && pString ) - hb_retl( hb_isMessage( pObject, pString->item.asString.value ) != 0 ); + hb_retl( hb_objHasMsg( pObject, pString->item.asString.value ) != 0 ); else { - hb_errorRT_BASE(EG_ARG, 3000, NULL, "ISMESSAGE"); + hb_errorRT_BASE(EG_ARG, 3000, NULL, "__OBJHASMSG"); } } /* - * := oClone( ) + * := __objClone( ) * * Clone an object. Note the similarity with aClone ;-) */ -HARBOUR HB_OCLONE( void ) +HARBOUR HB___OBJCLONE( void ) { PHB_ITEM pSrcObject = hb_param( 1, IT_OBJECT ); @@ -833,17 +834,17 @@ HARBOUR HB_OCLONE( void ) } else { - hb_errorRT_BASE(EG_ARG, 3001, NULL, "OCLONE"); + hb_errorRT_BASE(EG_ARG, 3001, NULL, "__OBJCLONE"); } } /* - * = oSend( , , + * = __objSendMsg( , , * * Send a message to an object */ -HARBOUR HB_OSEND(void) +HARBOUR HB___OBJSENDMSG(void) { PHB_ITEM pObject = hb_param( 1, IT_OBJECT ); PHB_ITEM pMessage = hb_param( 2, IT_STRING ); @@ -860,17 +861,17 @@ HARBOUR HB_OSEND(void) } else { - hb_errorRT_BASE(EG_ARG, 3000, NULL, "OSEND"); + hb_errorRT_BASE(EG_ARG, 3000, NULL, "__OBJSENDMSG"); } } /* - * ReleaseClass( ) + * hb_clsRelease( ) * * Release a class from memory */ -void ReleaseClass( PCLASS pClass ) +static void hb_clsRelease( PCLASS pClass ) { WORD wAt; WORD wLimit; @@ -891,16 +892,16 @@ void ReleaseClass( PCLASS pClass ) /* - * ReleaseClasses() + * hb_clsReleaseAll() * * Release all classes */ -void ReleaseClasses( void ) +void hb_clsReleaseAll( void ) { WORD w; for( w = 0; w < wClasses; w++ ) - ReleaseClass( pClasses + w ); + hb_clsRelease( pClasses + w ); if( pClasses ) hb_xfree( pClasses ); @@ -908,11 +909,11 @@ void ReleaseClasses( void ) /* - * SelectSuper() + * __msgSuper() * * Internal function to cast to a super method */ -static HARBOUR SelectSuper( void ) +static HARBOUR __msgSuper( void ) { PHB_ITEM pObject = stack.pBase + 1; PHB_ITEM pSuper = (PHB_ITEM) hb_xgrab( sizeof( HB_ITEM ) ); @@ -935,11 +936,11 @@ static HARBOUR SelectSuper( void ) /* - * SetClassData() + * __msgSetClsData() * * Internal function to set a CLASSDATA */ -static HARBOUR SetClassData( void ) +static HARBOUR __msgSetClsData( void ) { WORD wClass = ( stack.pBase + 1 )->item.asArray.value->wClass; PHB_ITEM pReturn = stack.pBase + 2; @@ -954,11 +955,11 @@ static HARBOUR SetClassData( void ) /* - * SetData() + * __msgSetData() * * Internal function to set a DATA */ -static HARBOUR SetData( void ) +static HARBOUR __msgSetData( void ) { PHB_ITEM pObject = stack.pBase + 1; PHB_ITEM pReturn = stack.pBase + 2; @@ -973,18 +974,18 @@ static HARBOUR SetData( void ) /* No comment :-) */ -static HARBOUR Virtual( void ) +static HARBOUR __msgVirtual( void ) { hb_ret(); } /* - * := hb__InstSuper( ) + * := __clsInstSuper( ) * * Instance super class and return class handle */ -HARBOUR HB___INSTSUPER( void ) +HARBOUR HB___CLSINSTSUPER( void ) { PHB_ITEM pString = hb_param( 1, IT_STRING ); PHB_DYNS pDynSym; @@ -1003,14 +1004,14 @@ HARBOUR HB___INSTSUPER( void ) if( !IS_OBJECT( &stack.Return ) ) { /* hb_errPutDescription(pError, "INSTSUPER : Super class does not return an object"); */ - hb_errorRT_BASE(EG_ARG, 3002, NULL, "__INSTSUPER"); + hb_errorRT_BASE(EG_ARG, 3002, NULL, "__CLSINSTSUPER"); } for( w = 0; !bFound && w < wClasses; w++ ) { /* Locate the entry */ if( !hb_stricmp( pString->item.asString.value, pClasses[ w ].szName ) ) { - hb_retni( w + 1 ); /* Entry + 1 = ClassH */ + hb_retni( w + 1 ); /* Entry + 1 = __msgClsH */ bFound = TRUE; } } @@ -1018,7 +1019,7 @@ HARBOUR HB___INSTSUPER( void ) else { /* hb_errPutDescription(pError, "INSTSUPER : Cannot find super class"); */ - hb_errorRT_BASE(EG_ARG, 3003, NULL, "__INSTSUPER"); + hb_errorRT_BASE(EG_ARG, 3003, NULL, "__CLSINSTSUPER"); } } if( !bFound ) @@ -1027,28 +1028,42 @@ HARBOUR HB___INSTSUPER( void ) /* - * = hb__wClsDatas( ) + * = __cls_CntClsData( ) * * Return number of class datas */ -HARBOUR HB___WCLSDATAS(void) +HARBOUR HB___CLS_CNTCLSDATA(void) { WORD wClass = hb_parnl( 1 ); - PCLASS pClass; if( wClass ) { - pClass = &pClasses[ wClass - 1 ]; + PCLASS pClass = &pClasses[ wClass - 1 ]; hb_retni( hb_arrayLen( pClass->pClassDatas ) ); } } /* - * = hb__wDataDec( ) + * = __cls_CntData( ) + * + * Return number of datas + */ +HARBOUR HB___CLS_CNTDATA(void) +{ + WORD wClass = hb_parnl( 1 ); + + if( wClass ) + { + hb_retni( pClasses[ wClass - 1 ].wDatas ); + } +} + +/* + * = __cls_DecData( ) * * Return number of datas and decrease */ -HARBOUR HB___WDATADEC(void) +HARBOUR HB___CLS_DECDATA(void) { WORD wClass = hb_parnl( 1 ); @@ -1058,11 +1073,11 @@ HARBOUR HB___WDATADEC(void) /* - * = hb__wDataInc( ) + * = __cls_IncData( ) * * Return number of datas and decrease */ -HARBOUR HB___WDATAINC(void) +HARBOUR HB___CLS_INCDATA(void) { WORD wClass = hb_parnl( 1 ); @@ -1070,17 +1085,3 @@ HARBOUR HB___WDATAINC(void) hb_retni( ++pClasses[ wClass - 1 ].wDatas ); } - -/* - * = hb__wDatas( ) - * - * Return number of datas - */ -HARBOUR HB___WDATAS(void) -{ - WORD wClass = hb_parnl( 1 ); - - if( wClass ) - hb_retni( pClasses[ wClass - 1 ].wDatas ); -} - diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index 6a38a42542..1a27aef27f 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -384,9 +384,9 @@ static WORD hb_errorRT_New return wRetVal; } -WORD hb_errorRT_BASE( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) +void hb_errorRT_BASE( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) { - return hb_errorRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + hb_errorRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); } WORD hb_errorRT_BASE_Ext1( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOsCode, USHORT uiFlags ) @@ -394,19 +394,19 @@ WORD hb_errorRT_BASE_Ext1( ULONG ulGenCode, ULONG ulSubCode, char * szDescriptio return hb_errorRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, uiOsCode, uiFlags ); } -WORD hb_errorRT_TERMINAL( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) +void hb_errorRT_TERMINAL( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) { - return hb_errorRT_New( ES_ERROR, HB_ERR_SS_TERMINAL, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + hb_errorRT_New( ES_ERROR, HB_ERR_SS_TERMINAL, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); } -WORD hb_errorRT_DBCMD( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) +void hb_errorRT_DBCMD( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) { - return hb_errorRT_New( ES_ERROR, HB_ERR_SS_DBCMD, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + hb_errorRT_New( ES_ERROR, HB_ERR_SS_DBCMD, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); } -WORD hb_errorRT_TOOLS( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) +void hb_errorRT_TOOLS( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) { - return hb_errorRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + hb_errorRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); } /* NOTES: Use as minimal calls from here, as possible. */ diff --git a/harbour/source/rtl/langapi.c b/harbour/source/rtl/langapi.c index 5d60a2cf7e..eeada655b8 100644 --- a/harbour/source/rtl/langapi.c +++ b/harbour/source/rtl/langapi.c @@ -131,6 +131,7 @@ static HB_LANG langEN = "Incorrect number of arguments", "array access", "array assign", + "array dimension", "not an array", "conditional" }, diff --git a/harbour/source/rtl/objfunc.prg b/harbour/source/rtl/objfunc.prg index 21aec7bad7..55eb6dc774 100644 --- a/harbour/source/rtl/objfunc.prg +++ b/harbour/source/rtl/objfunc.prg @@ -33,46 +33,39 @@ * their web site at http://www.gnu.org/). * * Partial Copyright Antonio Linares (alinares@fivetech.com) - * partial copyright regarding function : aoData + * partial copyright regarding function : __objGetMsgList */ -#define MET_METHOD 0 -#define MET_DATA 1 -#define MET_CLASSDATA 2 -#define MET_INLINE 3 -#define MET_VIRTUAL 4 - -#define DATA_SYMBOL 1 -#define DATA_VAL 2 +#include "hboo.ch" // -// := IsData( , ) +// := __objHasData( , ) // // Is the symbol present in the object as DATA ? // -function IsData( oObject, cSymbol ) +function __objHasData( oObject, cSymbol ) -return IsMessage( oObject, cSymbol ) .and. IsMessage( oObject, "_" + cSymbol ) +return __objHasMsg( oObject, cSymbol ) .and. __objHasMsg( oObject, "_" + cSymbol ) // -// := IsMethod( , ) +// := __objHasMethod( , ) // // Is the symbol present in the object as METHOD ? // -function IsMethod( oObject, cSymbol ) +function __objHasMethod( oObject, cSymbol ) -return IsMessage( oObject, cSymbol ) .and. !IsMessage( oObject, "_" + cSymbol ) +return __objHasMsg( oObject, cSymbol ) .and. !__objHasMsg( oObject, "_" + cSymbol ) // -// aOData( , [lDataMethod] ) +// __objGetMsgList( , [lDataMethod] ) // // Return an array containing the names of all the data items of oObject. // // lDataMethod = .T. (default) Return all DATAs // .F. Return all METHODs // -function aOData( oObject, lDataMethod ) +function __objGetMsgList( oObject, lDataMethod ) local aInfo := aSort( oObject:ClassSel() ) local aData := {} @@ -104,19 +97,19 @@ return aData // -// aData aOMethod( oObject ) +// aData __objGetMethodList( oObject ) // // Return an array containing the names of all the method of oObject. // -function aOMethod( oObject ) +function __objGetMethodList( oObject ) -return aOData( oObject, .F. ) +return __objGetMsgList( oObject, .F. ) // -// aOGet( , [] ) +// __objGetValueList( , [] ) // -// Basically the same as aOData except that it returns a 2D array +// Basically the same as __objGetMsgList except that it returns a 2D array // containing : // // [x][1] Symbol name @@ -124,9 +117,9 @@ return aOData( oObject, .F. ) // // aExcept is an optional list of DATA you do not want to collect // -function aOGet( oObject, aExcept ) +function __objGetValueList( oObject, aExcept ) - local aDataSymbol := aoData( oObject ) + local aDataSymbol := __objGetMsgList( oObject ) local nLen := Len( aDataSymbol ) local aData := {} local cSymbol @@ -139,160 +132,160 @@ function aOGet( oObject, aExcept ) for n := 1 to nLen cSymbol := aDataSymbol[ n ] if Empty( aScan( aExcept, cSymbol ) ) - aAdd( aData, { cSymbol, oSend( oObject, cSymbol ) } ) + aAdd( aData, { cSymbol, __objSendMsg( oObject, cSymbol ) } ) endif next n return aData // -// aOSet( , ) +// __objSetValueList( , ) // -// The reverse of aOGet. It puts an 2D array of DATA into an object. +// The reverse of __objGetValueList. +// It puts an 2D array of DATA into an object. // -function aOSet( oObject, aData ) +function __objSetValueList( oObject, aData ) aEval( aData, ; - {|aItem| oSend( oObject, "_"+aItem[DATA_SYMBOL], aItem[DATA_VAL] ) } ) + {|aItem| __objSendMsg( oObject, "_"+aItem[DATA_SYMBOL], aItem[DATA_VAL] ) } ) return oObject // -// := oAddMethod( , , ) +// := __objAddMethod( , , ) // // Add a method to an already existing class // -function oAddMethod( oObj, cSymbol, nFuncPtr ) +function __objAddMethod( oObj, cSymbol, nFuncPtr ) - if IsMessage( oObj, cSymbol ) - QOut( "OADDMETHOD: ", cSymbol, " already exists in class." ) + if __objHasMsg( oObj, cSymbol ) + QOut( "__objAddMethod: ", cSymbol, " already exists in class." ) elseif ValType( nFuncPtr ) != "N" - QOut( "OADDMETHOD: Argument type error " ) + QOut( "__objAddMethod: Argument type error " ) elseif ValType( oObj ) != "O" - QOut( "OADDMETHOD: Argument type error " ) + QOut( "__objAddMethod: Argument type error " ) else - ClassAdd( oObj:ClassH, cSymbol, nFuncPtr, MET_METHOD ) + __clsAddMsg( oObj:ClassH, cSymbol, nFuncPtr, MET_METHOD ) endif return oObj // -// := oAddInline( , , ) +// := __objAddInline( , , ) // // Add an INLINE to an already existing class // -function oAddInline( oObj, cSymbol, bInline ) +function __objAddInline( oObj, cSymbol, bInline ) - if IsMessage( oObj, cSymbol ) - QOut( "OADDINLINE: ", cSymbol, " already exists in class." ) + if __objHasMsg( oObj, cSymbol ) + QOut( "__objAddInline: ", cSymbol, " already exists in class." ) elseif ValType( bInline ) != "B" - QOut( "OADDINLINE: Argument type error " ) + QOut( "__objAddInline: Argument type error " ) elseif ValType( oObj ) != "O" - QOut( "OADDINLINE: Argument type error " ) + QOut( "__objAddInline: Argument type error " ) else - ClassAdd( oObj:ClassH, cSymbol, bInline, MET_INLINE ) + __clsAddMsg( oObj:ClassH, cSymbol, bInline, MET_INLINE ) endif return oObj // -// := oAddData( , ) +// := __objAddData( , ) // // Add a DATA to an already existing class // -function oAddData( oObj, cSymbol ) +function __objAddData( oObj, cSymbol ) local nSeq - if IsMessage( oObj, cSymbol ) .or. IsMessage( oObj, "_" + cSymbol ) - QOut( "OADDDATA: ", cSymbol, " already exists in class." ) + if __objHasMsg( oObj, cSymbol ) .or. __objHasMsg( oObj, "_" + cSymbol ) + QOut( "__objAddData: ", cSymbol, " already exists in class." ) elseif ValType( oObj ) != "O" - QOut( "OADDDATA: Argument type error " ) + QOut( "__objAddData: Argument type error " ) else - nSeq := __wDataInc( oObj:ClassH ) // Allocate new Seq# - ClassAdd( oObj:ClassH, cSymbol, nSeq, MET_DATA ) - ClassAdd( oObj:ClassH, "_" + cSymbol, nSeq, MET_DATA ) + nSeq := __cls_IncData( oObj:ClassH ) // Allocate new Seq# + __clsAddMsg( oObj:ClassH, cSymbol, nSeq, MET_DATA ) + __clsAddMsg( oObj:ClassH, "_" + cSymbol, nSeq, MET_DATA ) endif return oObj // -// := oModMethod( , , ) +// := __objModMethod( , , ) // // Modify a method to an already existing class // -function oModMethod( oObj, cSymbol, nFuncPtr ) +function __objModMethod( oObj, cSymbol, nFuncPtr ) - if !IsMethod( oObj, cSymbol ) - QOut( "OMODMETHOD: ", cSymbol, " does not exist in class." ) + if !__objHasMethod( oObj, cSymbol ) + QOut( "__objModMethod: ", cSymbol, " does not exist in class." ) elseif ValType( nFuncPtr ) != "N" - QOut( "OMODMETHOD: Argument type error " ) + QOut( "__objModMethod: Argument type error " ) elseif ValType( oObj ) != "O" - QOut( "OMODMETHOD: Argument type error " ) + QOut( "__objModMethod: Argument type error " ) else - ClassMod( oObj:ClassH, cSymbol, nFuncPtr ) + __clsModMsg( oObj:ClassH, cSymbol, nFuncPtr ) endif return oObj // -// := oModInline( , , ) +// := __objModInline( , , ) // // Modify an INLINE to an already existing class // -function oModInline( oObj, cSymbol, bInline ) +function __objModInline( oObj, cSymbol, bInline ) - if !IsMethod( oObj, cSymbol ) - QOut( "OMODINLINE: ", cSymbol, " does not exist in class." ) + if !__objHasMethod( oObj, cSymbol ) + QOut( "__objModInline: ", cSymbol, " does not exist in class." ) elseif ValType( bInline ) != "B" - QOut( "OMODINLINE: Argument type error " ) + QOut( "__objModInline: Argument type error " ) elseif ValType( oObj ) != "O" - QOut( "OMODINLINE: Argument type error " ) + QOut( "__objModInline: Argument type error " ) else - ClassMod( oObj:ClassH, cSymbol, bInline ) + __clsModMsg( oObj:ClassH, cSymbol, bInline ) endif return oObj // -// := oDelMethod( , ) +// := __objDelMethod( , ) // // Delete a method from an already existing class // -function oDelMethod( oObj, cSymbol ) +function __objDelMethod( oObj, cSymbol ) - if !IsMethod( oObj, cSymbol ) - QOut( "ODELMETHOD: ", cSymbol, " does not exist in class." ) + if !__objHasMethod( oObj, cSymbol ) + QOut( "__objDelMethod: ", cSymbol, " does not exist in class." ) elseif ValType( oObj ) != "O" - QOut( "ODELMETHOD: Argument type error " ) + QOut( "__objDelMethod: Argument type error " ) else - ClassDel( oObj:ClassH, cSymbol ) + __clsDelMsg( oObj:ClassH, cSymbol ) endif return oObj -function oDelInline( oObj, cSymbol ) -return oDelMethod( oObj, cSymbol ) // Same story +function __objDelInline( oObj, cSymbol ) +return __objDelMethod( oObj, cSymbol ) // Same story // -// := oDelData( , ) +// := __objDelData( , ) // // Delete a DATA from an already existing class // -function oDelData( oObj, cSymbol ) +function __objDelData( oObj, cSymbol ) local nSeq - if !IsData( oObj, cSymbol ) - QOut( "ODELDATA: ", cSymbol, " does not exist in class." ) + if !__objHasData( oObj, cSymbol ) + QOut( "__objDelData: ", cSymbol, " does not exist in class." ) elseif ValType( oObj ) != "O" - QOut( "ODELDATA: Argument type error " ) + QOut( "__objDelData: Argument type error " ) else - ClassDel( oObj:ClassH, cSymbol, ) - ClassDel( oObj:ClassH, "_" + cSymbol ) - nSeq := __wDataDec( oObj:ClassH ) // Decrease wData + __clsDelMsg( oObj:ClassH, cSymbol, ) + __clsDelMsg( oObj:ClassH, "_" + cSymbol ) + nSeq := __cls_DecData( oObj:ClassH ) // Decrease wData endif return oObj - diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index a7cdada733..0435fbb0e6 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -31,15 +31,7 @@ * Support for default DATA values */ -#define MET_METHOD 0 -#define MET_DATA 1 -#define MET_CLASSDATA 2 -#define MET_INLINE 3 -#define MET_VIRTUAL 4 -#define MET_SUPER 5 - -#define DAT_SYMBOL 1 -#define DAT_INITVAL 2 +#include "hboo.ch" //----------------------------------------------------------------------------// @@ -48,36 +40,36 @@ function TClass() static hClass := 0 if hClass == 0 - hClass = ClassCreate( "TCLASS", 8 ) + hClass = __clsNew( "TCLASS", 8 ) - ClassAdd( hClass, "New", @New(), MET_METHOD ) - ClassAdd( hClass, "Create", @Create(), MET_METHOD ) - ClassAdd( hClass, "AddData", @AddData(), MET_METHOD ) - ClassAdd( hClass, "AddClassData", @AddClassData(), MET_METHOD ) - ClassAdd( hClass, "AddInline", @AddInline(), MET_METHOD ) - ClassAdd( hClass, "AddMethod", @AddMethod(), MET_METHOD ) - ClassAdd( hClass, "AddVirtual", @AddVirtual(), MET_METHOD ) - ClassAdd( hClass, "Instance", @Instance(), MET_METHOD ) + __clsAddMsg( hClass, "New", @New(), MET_METHOD ) + __clsAddMsg( hClass, "Create", @Create(), MET_METHOD ) + __clsAddMsg( hClass, "AddData", @AddData(), MET_METHOD ) + __clsAddMsg( hClass, "AddClassData", @AddClassData(), MET_METHOD ) + __clsAddMsg( hClass, "AddInline", @AddInline(), MET_METHOD ) + __clsAddMsg( hClass, "AddMethod", @AddMethod(), MET_METHOD ) + __clsAddMsg( hClass, "AddVirtual", @AddVirtual(), MET_METHOD ) + __clsAddMsg( hClass, "Instance", @Instance(), MET_METHOD ) - ClassAdd( hClass, "hClass", 1, MET_DATA ) - ClassAdd( hClass, "_hClass", 1, MET_DATA ) - ClassAdd( hClass, "cName", 2, MET_DATA ) - ClassAdd( hClass, "_cName", 2, MET_DATA ) - ClassAdd( hClass, "aDatas", 3, MET_DATA ) - ClassAdd( hClass, "_aDatas", 3, MET_DATA ) - ClassAdd( hClass, "aMethods", 4, MET_DATA ) - ClassAdd( hClass, "_aMethods", 4, MET_DATA ) - ClassAdd( hClass, "aClsDatas", 5, MET_DATA ) - ClassAdd( hClass, "_aClsDatas", 5, MET_DATA ) - ClassAdd( hClass, "aInlines", 6, MET_DATA ) - ClassAdd( hClass, "_aInlines", 6, MET_DATA ) - ClassAdd( hClass, "aVirtuals", 7, MET_DATA ) - ClassAdd( hClass, "_aVirtuals", 7, MET_DATA ) - ClassAdd( hClass, "cSuper", 8, MET_DATA ) - ClassAdd( hClass, "_cSuper", 8, MET_DATA ) + __clsAddMsg( hClass, "hClass", 1, MET_DATA ) + __clsAddMsg( hClass, "_hClass", 1, MET_DATA ) + __clsAddMsg( hClass, "cName", 2, MET_DATA ) + __clsAddMsg( hClass, "_cName", 2, MET_DATA ) + __clsAddMsg( hClass, "aDatas", 3, MET_DATA ) + __clsAddMsg( hClass, "_aDatas", 3, MET_DATA ) + __clsAddMsg( hClass, "aMethods", 4, MET_DATA ) + __clsAddMsg( hClass, "_aMethods", 4, MET_DATA ) + __clsAddMsg( hClass, "aClsDatas", 5, MET_DATA ) + __clsAddMsg( hClass, "_aClsDatas", 5, MET_DATA ) + __clsAddMsg( hClass, "aInlines", 6, MET_DATA ) + __clsAddMsg( hClass, "_aInlines", 6, MET_DATA ) + __clsAddMsg( hClass, "aVirtuals", 7, MET_DATA ) + __clsAddMsg( hClass, "_aVirtuals", 7, MET_DATA ) + __clsAddMsg( hClass, "cSuper", 8, MET_DATA ) + __clsAddMsg( hClass, "_cSuper", 8, MET_DATA ) endif -return ClassInstance( hClass ) +return __clsInst( hClass ) //----------------------------------------------------------------------------// @@ -112,48 +104,48 @@ static function Create() local ahSuper := {} if ::cSuper == NIL - hClass := ClassCreate( ::cName, nLenDatas ) + hClass := __clsNew( ::cName, nLenDatas ) else // Single inheritance - hSuper := __InstSuper( Upper( ::cSuper ) ) - hClass := ClassCreate( ::cName, nLenDatas, hSuper ) + hSuper := __clsInstSuper( Upper( ::cSuper ) ) + hClass := __clsNew( ::cName, nLenDatas, hSuper ) // Add class casts - ClassAdd( hClass, Upper( ::cSuper ), hSuper, MET_SUPER ) - ClassAdd( hClass, "__SUPER", hSuper, MET_SUPER ) + __clsAddMsg( hClass, Upper( ::cSuper ), hSuper, MET_SUPER ) + __clsAddMsg( hClass, "__SUPER", hSuper, MET_SUPER ) - nDataBegin := __WDatas( hSuper ) // Get offset for new DATAs - nClassBegin := __WClsDatas( hSuper ) // Get offset for new ClassData + nDataBegin := __cls_CntData( hSuper ) // Get offset for new DATAs + nClassBegin := __cls_CntClsData( hSuper ) // Get offset for new ClassData endif ::hClass = hClass for n = 1 to nLenDatas - ClassAdd( hClass, ::aDatas[ n ][ DAT_SYMBOL ], n + nDataBegin, MET_DATA, ; - ::aDatas[ n ][ DAT_INITVAL ] ) - ClassAdd( hClass, "_" + ::aDatas[ n ][ DAT_SYMBOL ], n + nDataBegin, MET_DATA ) + __clsAddMsg( hClass, ::aDatas[ n ][ DATA_SYMBOL ], n + nDataBegin, MET_DATA, ; + ::aDatas[ n ][ DATA_VAL ] ) + __clsAddMsg( hClass, "_" + ::aDatas[ n ][ DATA_SYMBOL ], n + nDataBegin, MET_DATA ) next nLen = Len( ::aMethods ) for n = 1 to nLen - ClassAdd( hClass, ::aMethods[ n ][ 1 ], ::aMethods[ n ][ 2 ], MET_METHOD ) + __clsAddMsg( hClass, ::aMethods[ n ][ 1 ], ::aMethods[ n ][ 2 ], MET_METHOD ) next nLen = Len( ::aClsDatas ) for n = 1 to nLen - ClassAdd( hClass, ::aClsDatas[ n ], n + nClassBegin, MET_CLASSDATA ) - ClassAdd( hClass, "_" + ::aClsDatas[ n ], n + nClassBegin, MET_CLASSDATA ) + __clsAddMsg( hClass, ::aClsDatas[ n ], n + nClassBegin, MET_CLASSDATA ) + __clsAddMsg( hClass, "_" + ::aClsDatas[ n ], n + nClassBegin, MET_CLASSDATA ) next nLen = Len( ::aInlines ) for n = 1 to nLen - ClassAdd( hClass, ::aInlines[ n ][ 1 ], ::aInlines[ n ][ 2 ],; + __clsAddMsg( hClass, ::aInlines[ n ][ 1 ], ::aInlines[ n ][ 2 ],; MET_INLINE ) next -// ClassAdd( hClass, Upper( ::cName ), {|self|self}, MET_INLINE ) // Useful? +// __clsAddMsg( hClass, Upper( ::cName ), {|self|self}, MET_INLINE ) // Useful? nLen = Len( ::aVirtuals ) for n = 1 to nLen - ClassAdd( hClass, ::aVirtuals[ n ], n, MET_VIRTUAL ) + __clsAddMsg( hClass, ::aVirtuals[ n ], n, MET_VIRTUAL ) next return nil @@ -164,7 +156,7 @@ static function Instance() local Self := QSelf() -return ClassInstance( ::hClass ) +return __clsInst( ::hClass ) //----------------------------------------------------------------------------// diff --git a/harbour/source/rtl/transfrm.c b/harbour/source/rtl/transfrm.c index 71ef4d30f1..17c2389a84 100644 --- a/harbour/source/rtl/transfrm.c +++ b/harbour/source/rtl/transfrm.c @@ -87,13 +87,7 @@ HB_INIT_SYMBOLS_END( Transfrm__InitSymbols ) #define DF_YMD 2 #define DF_EOT 3 /* End of table for Century */ -/* Multiplication factors for different formats. */ - -long lFactDay [] = { 10000, 100, 1, 1000000, 10000, 1 }; -long lFactMonth[] = { 100, 10000, 100, 10000, 1000000, 100 }; -long lFactYear [] = { 1, 1, 10000, 1, 1, 10000 }; - -char *szBritish[] = { "DD/MM/YY", "DD/MM/YYYY" }; /* For @E */ +static char *szBritish[] = { "DD/MM/YY", "DD/MM/YYYY" }; /* For @E */ /* PictFunc -> Analyze function flags and return binary flags bits @@ -101,9 +95,9 @@ char *szBritish[] = { "DD/MM/YY", "DD/MM/YYYY" }; /* For @E */ szPict : Pointer to the picture lPicLen : Pointer to the length. Changed during execution. */ -int PictFunc( char **szPict, long *lPicLen ) +static int PictFunc( char **szPict, long *lPicLen ) { - int bDone = FALSE; + BOOL bDone = FALSE; int iPicFlags = 0; char *szPic = *szPict; @@ -165,8 +159,8 @@ int PictFunc( char **szPict, long *lPicLen ) iOrigWidth : Original width iOrigDec : Original decimals */ -char *NumPicture( char *szPic, long lPic, int iPicFlags, double dValue, - long *lRetSize, int iOrigWidth, int iOrigDec ) +static char *NumPicture( char *szPic, long lPic, int iPicFlags, double dValue, + long *lRetSize, int iOrigWidth, int iOrigDec ) { int iWidth; /* Width of string */ int iDecimals; /* Number of decimals */ @@ -179,8 +173,8 @@ char *NumPicture( char *szPic, long lPic, int iPicFlags, double dValue, PHB_ITEM pItem; - BYTE bFound = FALSE; - BYTE bEmpty; /* Suppress empty string */ + BOOL bFound = FALSE; + BOOL bEmpty; /* Suppress empty string */ double dPush; @@ -352,7 +346,7 @@ char *NumPicture( char *szPic, long lPic, int iPicFlags, double dValue, else { printf( "\nNUMPICTURE: STR does not return string" ); - _exit(1); + exit(1); } return(szRet); } @@ -365,7 +359,7 @@ char *NumPicture( char *szPic, long lPic, int iPicFlags, double dValue, szResult : Buffer of at least size 11 to hold formatted date lRetSize : The size of the returned string is passed here ! */ -char *DatePicture( char * szDate, int iPicFlags, char * szResult, long *lRetSize ) +static char *DatePicture( char * szDate, int iPicFlags, char * szResult, long *lRetSize ) { char * szDateFormat; @@ -400,7 +394,7 @@ HARBOUR HB_TRANSFORM( void ) int iPicFlags = 0; /* Function flags */ int n; - BYTE bDone = FALSE; + BOOL bDone = FALSE; if( lPic ) { diff --git a/harbour/source/tools/stringp.prg b/harbour/source/tools/stringp.prg index cc1f6562d8..4fdfeb7001 100644 --- a/harbour/source/tools/stringp.prg +++ b/harbour/source/tools/stringp.prg @@ -31,8 +31,7 @@ * their web site at http://www.gnu.org/). */ -#define DATA_SYMBOL 1 -#define DATA_VAL 2 +#include "hboo.ch" /* $Doc$ * $FuncName$ Default( , ) @@ -123,7 +122,7 @@ function ToChar( xTxt, cSeparator, lDebug ) case cValTxt=="O" // Object if lDebug cOut := xTxt:ClassName() + "(#" + ToChar( xTxt:ClassH() ) + "):{" - aData := aoGet( xTxt ) + aData := __objGetValueList( xTxt ) nLen := Len( aData ) for n := 1 to nLen // For each item : Recurse ! cOut += aData[n][DATA_SYMBOL] + ":" + ; diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 7160839a4e..8026c266bd 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -46,7 +46,6 @@ extern void hb_consoleInitialize( void ); extern void hb_consoleRelease( void ); -extern void ReleaseClasses( void ); /* releases all defined classes */ extern void InitSymbolTable( void ); /* initialization of runtime support symbols */ typedef struct _SYMBOLS @@ -181,7 +180,7 @@ int main( int argc, char * argv[] ) hb_itemClear( &stack.Return ); hb_arrayRelease( &aStatics ); hb_itemClear( &errorBlock ); - ReleaseClasses(); + hb_clsReleaseAll(); hb_vmReleaseLocalSymbols(); /* releases the local modules linked list */ hb_dynsymRelease(); /* releases the dynamic symbol table */ hb_consoleRelease(); /* releases Console */ @@ -849,12 +848,12 @@ void hb_vmDo( WORD wParams ) if( pSym == &( symEval ) && IS_BLOCK( pSelf ) ) pFunc = pSym->pFunPtr; /* __EVAL method = function */ else - pFunc = hb_GetMethod( pSelf, pSym ); + pFunc = hb_objGetMethod( pSelf, pSym ); if( ! pFunc ) { printf( "error: message %s not implemented for class %s in line %i\n", - pSym->szName, hb_GetClassName( pSelf ), wLineNo ); + pSym->szName, hb_objGetClsName( pSelf ), wLineNo ); exit( 1 ); } pFunc(); @@ -988,7 +987,7 @@ void hb_vmEqual( BOOL bExact ) else if( IS_NUMERIC( pItem1 ) && IS_NUMERIC( pItem2 ) ) hb_vmPushLogical( hb_vmPopDouble(&wDec) == hb_vmPopDouble(&wDec) ); - else if( IS_OBJECT( pItem1 ) && hb_isMessage( pItem1, "==" ) ) + else if( IS_OBJECT( pItem1 ) && hb_objHasMsg( pItem1, "==" ) ) hb_vmOperatorCall( pItem1, pItem2, "==" ); else if( pItem1->type != pItem2->type ) @@ -1116,7 +1115,7 @@ void hb_vmGreater( void ) } else if( IS_OBJECT( stack.pPos - 2 ) && - hb_isMessage( stack.pPos - 2, ">" ) ) + hb_objHasMsg( stack.pPos - 2, ">" ) ) hb_vmOperatorCall( stack.pPos - 2, stack.pPos - 1, ">" ); else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) @@ -1161,7 +1160,7 @@ void hb_vmGreaterEqual( void ) } else if( IS_OBJECT( stack.pPos - 2 ) && - hb_isMessage( stack.pPos - 2, ">=" ) ) + hb_objHasMsg( stack.pPos - 2, ">=" ) ) hb_vmOperatorCall( stack.pPos - 2, stack.pPos - 1, ">=" ); else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) @@ -1248,7 +1247,7 @@ void hb_vmLess( void ) } else if( IS_OBJECT( stack.pPos - 2 ) && - hb_isMessage( stack.pPos - 2, "<" ) ) + hb_objHasMsg( stack.pPos - 2, "<" ) ) hb_vmOperatorCall( stack.pPos - 2, stack.pPos - 1, "<" ); else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) @@ -1293,7 +1292,7 @@ void hb_vmLessEqual( void ) } else if( IS_OBJECT( stack.pPos - 2 ) && - hb_isMessage( stack.pPos - 2, "<=" ) ) + hb_objHasMsg( stack.pPos - 2, "<=" ) ) hb_vmOperatorCall( stack.pPos - 2, stack.pPos - 1, "<=" ); else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) @@ -1374,7 +1373,7 @@ void hb_vmNotEqual( void ) else if( IS_LOGICAL( pItem1 ) && IS_LOGICAL( pItem2 ) ) hb_vmPushLogical( hb_vmPopLogical() != hb_vmPopLogical() ); - else if( IS_OBJECT( pItem1 ) && hb_isMessage( pItem1, "!=" ) ) + else if( IS_OBJECT( pItem1 ) && hb_objHasMsg( pItem1, "!=" ) ) hb_vmOperatorCall( pItem1, pItem2, "!=" ); else if( pItem1->type != pItem2->type ) @@ -1438,7 +1437,7 @@ void hb_vmMinus( void ) hb_stackPop(); return; } - else if( IS_OBJECT( stack.pPos - 2 ) && hb_isMessage( stack.pPos - 2, "-" ) ) + else if( IS_OBJECT( stack.pPos - 2 ) && hb_objHasMsg( stack.pPos - 2, "-" ) ) hb_vmOperatorCall( stack.pPos - 2, stack.pPos - 1, "-" ); else hb_errorRT_BASE(EG_ARG, 1082, NULL, "-"); @@ -1546,7 +1545,7 @@ void hb_vmPlus( void ) hb_vmPushDate( lDate1 + dNumber2 ); } - else if( IS_OBJECT( pItem1 ) && hb_isMessage( pItem2, "+" ) ) + else if( IS_OBJECT( pItem1 ) && hb_objHasMsg( pItem2, "+" ) ) hb_vmOperatorCall( pItem1, pItem2, "+" ); else diff --git a/harbour/tests/working/debugtst.prg b/harbour/tests/working/debugtst.prg index 584f7d64ab..ff27b694b3 100644 --- a/harbour/tests/working/debugtst.prg +++ b/harbour/tests/working/debugtst.prg @@ -31,15 +31,15 @@ function Main() QOut( "What is in oForm ? " ) Debug( oForm:Transfer() ) - QOut( "Does transfer exists ? ", IsMessage( oForm, "Transfer" ) ) - QOut( "Is transfer DATA ? ", IsData ( oForm, "Transfer" ) ) - QOut( "Is transfer METHOD ? ", IsMethod ( oForm, "Transfer" ) ) - QOut( "Does nLeft exists ? ", IsMessage( oForm, "nLeft" ) ) - QOut( "Is nLeft DATA ? ", IsData ( oForm, "nLeft" ) ) - QOut( "Is nLeft METHOD ? ", IsMethod ( oForm, "nLeft" ) ) - QOut( "Does unknown exists ? ", IsMessage( oForm, "Unknown" ) ) - QOut( "Is unknown DATA ? ", IsData ( oForm, "Unknown" ) ) - QOut( "Is unknown METHOD ? ", IsMethod ( oForm, "Unknown" ) ) + QOut( "Does transfer exists ? ", __objHasMsg ( oForm, "Transfer" ) ) + QOut( "Is transfer DATA ? ", __objHasData ( oForm, "Transfer" ) ) + QOut( "Is transfer METHOD ? ", __objHasMethod( oForm, "Transfer" ) ) + QOut( "Does nLeft exists ? ", __objHasMsg ( oForm, "nLeft" ) ) + QOut( "Is nLeft DATA ? ", __objHasData ( oForm, "nLeft" ) ) + QOut( "Is nLeft METHOD ? ", __objHasMethod( oForm, "nLeft" ) ) + QOut( "Does unknown exists ? ", __objHasMsg ( oForm, "Unknown" ) ) + QOut( "Is unknown DATA ? ", __objHasData ( oForm, "Unknown" ) ) + QOut( "Is unknown METHOD ? ", __objHasMethod( oForm, "Unknown" ) ) QOut( "Set nLeft to 50 and nRight to 100" ) oForm:Transfer( {"nLeft", 50}, {"nRight", 100} ) @@ -186,7 +186,7 @@ return nil // one class to another // // If is not present, the current object will be returned as an array -// for description see aoSet / aoGet. +// for description see __objSetValueList / __objGetValueList. // // The method aExcept() is called to determine the DATA which should not // be returned. Eg. hWnd ( do not copy this DATA from external source ) @@ -195,11 +195,11 @@ return nil // // oTarget:Transfer( oSource ) // -// If we do not want 'cName' duplicated we have to use aoGet : +// If we do not want 'cName' duplicated we have to use __objGetValueList : // // aNewExcept := aClone( oSource:aExcept() ) // aAdd( aNewExcept, "cName" ) /* Add cName to exception list */ -// oTarget:Transfer( aoGet( oSource, aNewExcept ) ) +// oTarget:Transfer( __objGetValueList( oSource, aNewExcept ) ) // /* Get DATA from oSource with new exceptions */ // /* Transfer DATA to oTarget */ // @@ -233,7 +233,7 @@ static function Transfer( x1,x2,x3,x4,x5,x6,x7,x8,x9,x10 /* etc */ ) local n if nLen == 0 - xRet := aOGet( self, ::aExcept() ) + xRet := __objGetValueList( self, ::aExcept() ) else for n := 1 to nLen @@ -241,9 +241,9 @@ static function Transfer( x1,x2,x3,x4,x5,x6,x7,x8,x9,x10 /* etc */ ) if ValType( xData ) == "A" if ValType( xData[1] ) == "A" // 2D array passed - xRet := aOSet( self, xData ) + xRet := __objSetValueList( self, xData ) else // 1D array passed - xRet := aOSet( self, {xData} ) + xRet := __objSetValueList( self, {xData} ) endif elseif ValType( xData ) == "O" // Object passed diff --git a/harbour/tests/working/dynobj.prg b/harbour/tests/working/dynobj.prg index b105d21375..4e620fb1b5 100644 --- a/harbour/tests/working/dynobj.prg +++ b/harbour/tests/working/dynobj.prg @@ -14,8 +14,8 @@ // // Placed in the public domain // -#define DATA_SYMBOL 1 -#define DATA_VAL 2 + +#include "hboo.ch" function Main() @@ -23,27 +23,27 @@ function Main() local nSeq QOut( "What methods are in the class :" ) - Debug( aoMethod( oForm ) ) + Debug( __objGetMethodList( oForm ) ) /* Let's add an inline at run-time. Should already be possible */ QOut( "Let's add inline 'CalcArea' at run-time to an already instanced class" ) - oAddInline( oForm, "CalcArea", ; + __objAddInline( oForm, "CalcArea", ; {|self| ( ::nRight - ::nLeft ) * ( ::nBottom - ::nTop ) } ) QOut( "What methods are in the class :" ) - Debug( aoMethod( oForm ) ) + Debug( __objGetMethodList( oForm ) ) QOut( "What is the Form area ?" ) QOut( oForm:CalcArea() ) QOut( "Let's add method 'Smile' at run-time to an already instanced class" ) - oAddMethod( oForm, "Smile", @Smile() ) + __objAddMethod( oForm, "Smile", @Smile() ) QOut( "What methods are in the class :" ) - Debug( aoMethod( oForm ) ) + Debug( __objGetMethodList( oForm ) ) QOut( "Smile please " ) oForm:Smile() @@ -55,7 +55,7 @@ function Main() QOut( "Let's add an additional data item" ) - oAddData( oForm, "cHelp" ) + __objAddData( oForm, "cHelp" ) oForm:cHelp := "This is a real tricky test" @@ -66,33 +66,33 @@ function Main() QOut( "Let's attach a bigger smile" ) - oModMethod( oForm, "Smile", @BigSmile() ) + __objModMethod( oForm, "Smile", @BigSmile() ) QOut( "Let's smile" ) oForm:Smile() QOut( "And CalcArea() will now give a result in square inches" ) - oModInline( oForm, "CalcArea", ; + __objModInline( oForm, "CalcArea", ; {|self| ( ::nRight - ::nLeft ) * ( ::nBottom - ::nTop ) / (2.54*2.54) } ) QOut( "What is the Form area ?" ) QOut( oForm:CalcArea() ) QOut( "What methods are in the class :" ) - Debug( aoMethod( oForm ) ) + Debug( __objGetMethodList( oForm ) ) QOut( "Delete CalcArea" ) - oDelInline( oForm, "CalcArea" ) + __objDelInline( oForm, "CalcArea" ) QOut( "What methods are in the class :" ) - Debug( aoMethod( oForm ) ) + Debug( __objGetMethodList( oForm ) ) QOut( "Delete Smile" ) - oDelMethod( oForm, "Smile" ) + __objDelMethod( oForm, "Smile" ) QOut( "What methods are in the class :" ) - Debug( aoMethod( oForm ) ) + Debug( __objGetMethodList( oForm ) ) Pause() @@ -101,7 +101,7 @@ function Main() QOut( "Let's delete cHelp" ) - oDelData( oForm, "cHelp" ) + __objDelData( oForm, "cHelp" ) QOut( "Data items after" ) Debug( oForm ) diff --git a/harbour/tests/working/inherit.prg b/harbour/tests/working/inherit.prg index 9401cbcaf2..9c56fc6802 100644 --- a/harbour/tests/working/inherit.prg +++ b/harbour/tests/working/inherit.prg @@ -31,11 +31,11 @@ function Main() oTo := TTextFile():New( "hello.out", "W" ) QOut( "What's in oFrom" ) - Debug( { oFrom, aoMethod( oFrom ) } ) + Debug( { oFrom, __objGetMethodList( oFrom ) } ) QOut() QOut( "What's in oFrom:TEmpty" ) - Debug( { oFrom:TEmpty, aoMethod( oFrom:TEmpty ) } ) + Debug( { oFrom:TEmpty, __objGetMethodList( oFrom:TEmpty ) } ) QOut() QOut( "Let's call Run() from TEmpty : " ) @@ -91,7 +91,7 @@ function TOnTop() if oOnTop == NIL oOnTop := TClass():New( "TOnTop", "TTextFile" ) - oOnTop:AddInline( "Say", {|self, cArg| QOut( oSend(self, cArg) ) } ) + oOnTop:AddInline( "Say", {|self, cArg| QOut( __objSendMsg(self, cArg) ) } ) oOnTop:Create() endif return oOnTop:Instance() diff --git a/harbour/tests/working/objects.prg b/harbour/tests/working/objects.prg index 1565ccc6c3..09ed1c3ae7 100644 --- a/harbour/tests/working/objects.prg +++ b/harbour/tests/working/objects.prg @@ -5,11 +5,7 @@ // 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 +#include "hboo.ch" function Main() @@ -35,17 +31,17 @@ 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 ) + hClass = __clsNew( "TANY", 3 ) // cClassName, nDatas + __clsAddMsg( hClass, "cName", 1, MET_DATA ) // retrieve data + __clsAddMsg( hClass, "_cName", 1, MET_DATA ) // assign data. Note the '_' + __clsAddMsg( hClass, "New", @New(), MET_METHOD ) + __clsAddMsg( hClass, "Test", @Test(), MET_METHOD ) + __clsAddMsg( 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 +return __clsInst( hClass ) // creates an object of this class static function New() diff --git a/harbour/tests/working/overload.prg b/harbour/tests/working/overload.prg index 125638fd04..99e6514c52 100644 --- a/harbour/tests/working/overload.prg +++ b/harbour/tests/working/overload.prg @@ -2,11 +2,7 @@ // $Id$ // -#define MET_METHOD 0 -#define MET_DATA 1 -#define MET_CLASSDATA 2 -#define MET_INLINE 3 -#define MET_VIRTUAL 4 +#include "hboo.ch" // // DynObj diff --git a/harbour/tests/working/strip.prg b/harbour/tests/working/strip.prg index 9a8243a8a4..b45853206c 100644 --- a/harbour/tests/working/strip.prg +++ b/harbour/tests/working/strip.prg @@ -36,10 +36,10 @@ function Main( cFrom, cTo ) cTo := Default( cTo, "strip.out" ) oFrom := TTextFile() -// Debug( aoMethod( oFrom ) ) +// Debug( __objGetMethodList( oFrom ) ) oFrom:New( cFrom, "R" ) oTo := TTextFile() -// Debug( aoMethod( oTo ) ) +// Debug( __objGetMethodList( oTo ) ) oTo:New( cTo , "W" ) do while !oFrom:EoF()