diff --git a/harbour/ChangeLog b/harbour/ChangeLog index a42e08b0bd..a11362b5ef 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,93 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-10-03 17:04 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + + harbour/tests/oleenum.prg + + added Enrico example and test code for enumerators and OLE objects + + * harbour/contrib/Makefile + * enabled hbole, ado_rdd, hybodbc in most of Windows builds + + * harbour/contrib/ole2/win32ole.prg + * harbour/contrib/ole2/w32ole.c + * synced with recent Ron's modifications in xHarbour + I'd like to ask Windows users to make tests with above + oleenum.prg and example sent by Luis + + * harbour/source/rtl/gttrm/gttrm.c + * disable ACS mode before sending BEL on Linux compatibile terminals + - some of them may try to display chr(7) instead of generating + sound when ACSC is enabled + + * harbour/source/vm/proc.c + + added support for character parameter in PROCFILE() - now it can + accept | | as first parameter + + * harbour/source/vm/dynsym.c + * added support for detecting not cleanly overloaded by linker .prg + functions. + In such case hb_dynsymNew() checks if linker updated function + addresses and if yes then remove unnecessary HB_FS_LOCAL flag. + In such case works GCC (but not MinGW and DJGPP), OpwenWatcom + for Linux, DOS, Windows (and probably for OS2), POCC, XCC (with + /FORCE:MULTIPLE linker switch) and some other linkers I haven't + tested. + Otherwise (two different functions with the same name linked and + each accessible from different symbol, f.e. BCC32, MinGW, DJGPP) + it accept multiple HB_FS_LOCAL for dynamically loaded modules + (.hrb, .dll, .so, .dyn, ...) if HVM also accepted it (for future + KEEP_LOCAL_FUNC HB_LIBLOAD()/__HBRLOAD() parameter). + For statically linked modules it overloads one of the functions when + HB_OVERLOAD_MULTIPLE_FUNC macro is set (now by default to make tests + with different linkers). I left detail description in source code of + hb_dynsymNew() in source/vm/dynsym.c. + I hope it will also help Ron in recent xHarbour modifications - AFAIK + it's sth what he tires to do. + Anyhow please remember that that dirty overloading any symbols by + linker is very bad idea and in such case you have big chance that + wrong binaries will be created so the most preferable choice is + eliminating such situations and not using linker switches like + -Wl,--allow-multiple-definition or /FORCE:MULTIPLE + + + harbour/tests/multifnc + + harbour/tests/multifnc/t0.prg + + harbour/tests/multifnc/t1.prg + + harbour/tests/multifnc/t2.prg + + harbour/tests/multifnc/Makefile + + added test code for results of dirty overloaded functions. + With recent modifications expected results are: + main t0.prg t0.prg + alert t1.prg t1.prg [ALERT] + p0 t0.prg t0.prg P0:t0.prg P0:t0.prg OK + p1 t0.prg t0.prg P1:t0.prg P1:t0.prg OK + p2 t1.prg t1.prg P2:t1.prg P2:t1.prg OK + p3 t0.prg t0.prg P3:t0.prg P3:t0.prg OK + p4 t1.prg t1.prg P4:t1.prg P4:t1.prg OK + p5 t2.prg t2.prg P5:t2.prg P5:t2.prg OK + === + main2 t1.prg t1.prg + alert t1.prg t1.prg [ALERT] + p0 t0.prg t0.prg P0:t0.prg P0:t0.prg OK + p1 t0.prg t0.prg P1:t0.prg P1:t0.prg OK + p2 t1.prg t1.prg P2:t1.prg P2:t1.prg OK + p3 t0.prg t0.prg P3:t0.prg P3:t0.prg OK + p4 t1.prg t1.prg P4:t1.prg P4:t1.prg OK + p5 t2.prg t2.prg P5:t2.prg P5:t2.prg OK + === + main3 t2.prg t2.prg + alert t1.prg t1.prg [ALERT] + p0 t0.prg t0.prg P0:t0.prg P0:t0.prg OK + p1 t0.prg t0.prg P1:t0.prg P1:t0.prg OK + p2 t1.prg t1.prg P2:t1.prg P2:t1.prg OK + p3 t0.prg t0.prg P3:t0.prg P3:t0.prg OK + p4 t1.prg t1.prg P4:t1.prg P4:t1.prg OK + p5 t2.prg t2.prg P5:t2.prg P5:t2.prg OK + + I've tested only few compilers: GCC/G++ (Linux) MinGW (WINE-W32), + DJGPP (DOSEMU), OpenWatcom (Linux, WINE-W32, DOSEMU), XCC/POCC + (WINE-W32) and I'm interesting in results from other compiler/ + platforms, f.e. from M[V]SC. + 2007-10-02 14:58 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/contrib/ole2/win32ole.prg ! fixed typo in __enumStart() - enum parameter has to be passed diff --git a/harbour/contrib/Makefile b/harbour/contrib/Makefile index aa858ea475..41faa8591c 100644 --- a/harbour/contrib/Makefile +++ b/harbour/contrib/Makefile @@ -28,15 +28,7 @@ ifeq ($(HB_ARCHITECTURE),w32) DIRS +=\ rdd_ads \ -ifeq ($(HB_COMPILER),msvc) - -DIRS +=\ - odbc \ - -else -ifeq ($(HB_COMPILER),rsxnt) - -else +ifneq ($(HB_COMPILER),rsxnt) DIRS +=\ ole2 \ @@ -44,7 +36,6 @@ DIRS +=\ adordd \ endif -endif else ifeq ($(HB_COMPILER),icc) @@ -72,7 +63,6 @@ endif ifneq ($(HB_ARCHITECTURE),dos) DIRS += tip -#DIRS += xhb endif include $(ROOT)config/dir.cf diff --git a/harbour/contrib/ole2/w32ole.c b/harbour/contrib/ole2/w32ole.c index c4b977adc9..77a585dac2 100644 --- a/harbour/contrib/ole2/w32ole.c +++ b/harbour/contrib/ole2/w32ole.c @@ -89,6 +89,8 @@ #define HB_LONG_LONG_OFF #endif +static void RetValue( void ); + static HRESULT s_nOleError; static HB_ITEM OleAuto; @@ -185,7 +187,6 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) // ----------------------------------------------------------------------- static EXCEPINFO excep; - static BSTR bstrMessage; static DISPID lPropPut = DISPID_PROPERTYPUT; static UINT uArgErr; @@ -193,7 +194,7 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) static PHB_ITEM SafeArrayToArray( SAFEARRAY *parray, UINT iDim, long* rgIndices, VARTYPE vt ); //---------------------------------------------------------------------------// - HB_EXPORT BSTR hb_oleAnsiToSysString( LPSTR cString ) + HB_EXPORT BSTR hb_oleAnsiToSysString( const char * cString ) { int nConvertedLen = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, NULL, 0 ); @@ -690,14 +691,14 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) } //---------------------------------------------------------------------------// - static PHB_ITEM * GetParams( DISPPARAMS *pDispParams ) + static PHB_ITEM * GetParams( DISPPARAMS *pDispParams, int nOffset ) { VARIANTARG * pArgs = NULL; int n, nArgs, nArg; //BOOL bByRef; PHB_ITEM *aPrgParams = NULL; - nArgs = hb_pcount(); + nArgs = hb_pcount() - nOffset; if( nArgs > 0 ) { @@ -712,7 +713,7 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) nArg = nArgs - n; VariantInit( &( pArgs[ n ] ) ); - aPrgParams[ n ] = hb_stackItemFromBase( nArg ); + aPrgParams[ n ] = hb_stackItemFromBase( nArg + nOffset ); //TraceLog( NULL, "N: %i Arg: %i Type: %i %i ByRef: %i\n", n, nArg, pParam->type, aPrgParams[ n ]->type, bByRef ); @@ -959,7 +960,7 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) //printf( " Sub: %i\n", i ); pSubArray = SafeArrayToArray( parray, iDim - 1, rgIndices, vt ); - hb_arraySet( pArray, i - iFrom + 1, pSubArray ); + hb_arraySetForward( pArray, i - iFrom + 1, pSubArray ); hb_itemRelease( pSubArray ); } } @@ -1558,7 +1559,7 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) SysFreeString( bstrClassID ); - // TraceLog( NULL, "Result: %p\n", s_nOleError ); + //TraceLog( NULL, "Result: %p\n", s_nOleError ); if( hb_pcount() == 2 ) { @@ -1578,9 +1579,9 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) if( SUCCEEDED( s_nOleError ) ) { - // TraceLog( NULL, "Class: %i\n", ClassID ); + //TraceLog( NULL, "Class: %i\n", ClassID ); s_nOleError = CoCreateInstance( (REFCLSID) &ClassID, NULL, CLSCTX_SERVER, (REFIID) riid, &pDisp ); - // TraceLog( NULL, "Result: %p\n", s_nOleError ); + //TraceLog( NULL, "Result: %p\n", s_nOleError ); } hb_retnl( ( LONG ) pDisp ); @@ -1676,6 +1677,9 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) //---------------------------------------------------------------------------// static HRESULT OleSetProperty( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams ) { + pDispParams->rgdispidNamedArgs = &lPropPut; + pDispParams->cNamedArgs = 1; + // 1 Based!!! if( ( ISBYREF( 1 ) ) || ISARRAY( 1 ) ) { @@ -1709,6 +1713,9 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) &excep, &uArgErr ); + pDispParams->rgdispidNamedArgs = NULL; + pDispParams->cNamedArgs = 0; + return s_nOleError; } @@ -1851,10 +1858,7 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) VariantClear( &RetVal ); - aPrgParams = GetParams( &DispParams ); - - DispParams.rgdispidNamedArgs = &lPropPut; - DispParams.cNamedArgs = 1; + aPrgParams = GetParams( &DispParams, 0 ); OleSetProperty( pDisp, DISPID_VALUE, &DispParams ); //TraceLog( NULL, "SetDefault: %p\n", s_nOleError ); @@ -1930,39 +1934,34 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) } //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO_ONERROR ) + static HRESULT OleGetID( IDispatch *pDisp, const char *szName, DISPID *pDispID, BOOL *pbSetFirst ) { - IDispatch *pDisp; - DISPID DispID; - DISPPARAMS DispParams; - BOOL bSetFirst = FALSE; + BSTR bstrMessage; - //TraceLog( NULL, "Class: '%s' Message: '%s', Params: %i Arg1: %i\n", hb_objGetClsName( hb_stackSelfItem() ), hb_itemGetSymbol( hb_stackBaseItem() )->szName, hb_pcount(), hb_parinfo(1) ); - - hb_vmPushSymbol( s_pSym_hObj->pSymbol ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - OleGetID : + if( pbSetFirst ) + { + *pbSetFirst = FALSE; + } /* - if( strcmp( hb_itemGetSymbol( hb_stackBaseItem() )->szName, "OLEVALUE" ) == 0 || strcmp( hb_itemGetSymbol( hb_stackBaseItem() )->szName, "_OLEVALUE" ) == 0 ) + if( strcmp( szName, "OLEVALUE" ) == 0 || strcmp( szName, "_OLEVALUE" ) == 0 ) { DispID = DISPID_VALUE; s_nOleError = S_OK; } - else*/ if( hb_itemGetSymbol( hb_stackBaseItem() )->szName[0] == '_' && hb_itemGetSymbol( hb_stackBaseItem() )->szName[1] && hb_pcount() >= 1 ) + else*/ if( szName[0] == '_' && szName[1] && hb_pcount() >= 1 ) { - bstrMessage = hb_oleAnsiToSysString( ( LPSTR ) hb_itemGetSymbol( hb_stackBaseItem() )->szName + 1 ); - s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, (REFIID) &IID_NULL, (wchar_t **) &bstrMessage, 1, LOCALE_SYSTEM_DEFAULT, &DispID ); + bstrMessage = hb_oleAnsiToSysString( szName + 1 ); + s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, (REFIID) &IID_NULL, (wchar_t **) &bstrMessage, 1, LOCALE_SYSTEM_DEFAULT, pDispID ); SysFreeString( bstrMessage ); //TraceLog( NULL, "1. ID of: '%s' -> %i Result: %p\n", hb_itemGetSymbol( hb_stackBaseItem() )->szName + 1, DispID, s_nOleError ); if( SUCCEEDED( s_nOleError ) ) { - bSetFirst = TRUE; + if( pbSetFirst ) + { + *pbSetFirst = TRUE; + } } } else @@ -1973,75 +1972,159 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) if( FAILED( s_nOleError ) ) { // Try again without removing the assign prefix (_). - bstrMessage = hb_oleAnsiToSysString( ( LPSTR ) hb_itemGetSymbol( hb_stackBaseItem() )->szName ); - s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, (REFIID) &IID_NULL, (wchar_t **) &bstrMessage, 1, 0, &DispID ); + bstrMessage = hb_oleAnsiToSysString( szName ); + s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, (REFIID) &IID_NULL, (wchar_t **) &bstrMessage, 1, 0, pDispID ); SysFreeString( bstrMessage ); - //TraceLog( NULL, "2. ID of: '%s' -> %i Result: %p\n", hb_itemGetSymbol( hb_stackBaseItem() )->szName, DispID, s_nOleError ); + //TraceLog( NULL, "2. ID of: '%s' -> %i Result: %p\n", szName, *pDispID, s_nOleError ); } - if( SUCCEEDED( s_nOleError ) ) - { - PHB_ITEM *aPrgParams = GetParams( &DispParams ); + return s_nOleError; + } + //---------------------------------------------------------------------------// + HB_FUNC( TOLEAUTO_INVOKE ) + { + IDispatch *pDisp; + char *szName = hb_parc(1); + DISPID DispID; + DISPPARAMS DispParams; + + hb_vmPushSymbol( s_pSym_hObj->pSymbol ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + + pDisp = ( IDispatch * ) hb_parnl( -1 ); + + if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) + { + PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); + + if( SUCCEEDED( OleInvoke( pDisp, DispID, &DispParams ) ) ) + { + RetValue(); + } + + FreeParams( &DispParams, aPrgParams ); + } + } + + //---------------------------------------------------------------------------// + HB_FUNC( TOLEAUTO_SET ) + { + IDispatch *pDisp; + char *szName = hb_parc(1); + DISPID DispID; + DISPPARAMS DispParams; + + hb_vmPushSymbol( s_pSym_hObj->pSymbol ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + pDisp = ( IDispatch * ) hb_parnl( -1 ); + + if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) + { + PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); + + if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) + { + RetValue(); + } + + FreeParams( &DispParams, aPrgParams ); + } + } + + //---------------------------------------------------------------------------// + HB_FUNC( TOLEAUTO_GET ) + { + IDispatch *pDisp; + char *szName = hb_parc(1); + DISPID DispID; + DISPPARAMS DispParams; + + hb_vmPushSymbol( s_pSym_hObj->pSymbol ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + pDisp = ( IDispatch * ) hb_parnl( -1 ); + + if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) + { + PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); + + if( SUCCEEDED( OleGetProperty( pDisp, DispID, &DispParams ) ) ) + { + RetValue(); + } + + FreeParams( &DispParams, aPrgParams ); + } + } + + //---------------------------------------------------------------------------// + HB_FUNC( TOLEAUTO_ONERROR ) + { + IDispatch *pDisp; + DISPID DispID; + DISPPARAMS DispParams; + BOOL bSetFirst = FALSE, bTryDefault = TRUE; + PHB_ITEM *aPrgParams = GetParams( &DispParams, 0 ); + + //TraceLog( NULL, "Class: '%s' Message: '%s', Params: %i Arg1: %i\n", hb_objGetClsName( hb_stackSelfItem() ), hb_itemGetSymbol( hb_stackBaseItem() )->szName, hb_pcount(), hb_parinfo(1) ); + + hb_vmPushSymbol( s_pSym_hObj->pSymbol ); + hb_vmPush( hb_stackSelfItem() ); + hb_vmSend( 0 ); + pDisp = ( IDispatch * ) hb_parnl( -1 ); + + OleGetID : + + if( SUCCEEDED( OleGetID( pDisp, hb_itemGetSymbol( hb_stackBaseItem() )->szName, &DispID, &bSetFirst ) ) ) + { VariantClear( &RetVal ); if( bSetFirst ) { - DispParams.rgdispidNamedArgs = &lPropPut; - DispParams.cNamedArgs = 1; - - OleSetProperty( pDisp, DispID, &DispParams ); - //TraceLog( NULL, "OleSetProperty %i\n", s_nOleError ); - - if( SUCCEEDED( s_nOleError ) ) + if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) { hb_itemReturn( hb_stackItemFromBase( 1 ) ); } - else - { - DispParams.rgdispidNamedArgs = NULL; - DispParams.cNamedArgs = 0; - } + + //TraceLog( NULL, "FIRST OleSetProperty %i\n", s_nOleError ); + } + else + { + s_nOleError = E_PENDING; } - if( bSetFirst == FALSE || FAILED( s_nOleError ) ) + if( FAILED( s_nOleError ) ) { - OleInvoke( pDisp, DispID, &DispParams ); + if( SUCCEEDED( OleInvoke( pDisp, DispID, &DispParams ) ) ) + { + RetValue(); + } + //TraceLog( NULL, "OleInvoke %i\n", s_nOleError ); + } - if( SUCCEEDED( s_nOleError ) ) + if( FAILED( s_nOleError ) ) + { + if( SUCCEEDED( OleGetProperty( pDisp, DispID, &DispParams ) ) ) { RetValue(); } - } - // Collections are properties that do require arguments! - if( FAILED( s_nOleError ) /* && hb_pcount() == 0 */ ) - { - OleGetProperty( pDisp, DispID, &DispParams ); //TraceLog( NULL, "OleGetProperty(%i) %i\n", DispParams.cArgs, s_nOleError ); - - if( SUCCEEDED( s_nOleError ) ) - { - RetValue(); - } } - if( FAILED( s_nOleError ) && hb_pcount() >= 1 ) + if( FAILED( s_nOleError ) && bSetFirst == FALSE && hb_pcount() >= 1 ) { - DispParams.rgdispidNamedArgs = &lPropPut; - DispParams.cNamedArgs = 1; - - OleSetProperty( pDisp, DispID, &DispParams ); - //TraceLog( NULL, "OleSetProperty %i\n", s_nOleError ); - - if( SUCCEEDED( s_nOleError ) ) + if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) { hb_itemReturn( hb_stackItemFromBase( 1 ) ); } - } - FreeParams( &DispParams, aPrgParams ); + //TraceLog( NULL, "OleSetProperty %i\n", s_nOleError ); + } } if( SUCCEEDED( s_nOleError ) ) @@ -2087,14 +2170,27 @@ static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) else { // Try to apply the requested message to the DEFAULT Method of the object if any. - if( SUCCEEDED( ( s_nOleError = OleGetValue( pDisp ) ) ) ) + if( bTryDefault ) { - //TraceLog( NULL, "Try using DISPID_VALUE\n" ); - pDisp = OleVal.n1.n2.n3.pdispVal; - goto OleGetID; + if( SUCCEEDED( ( /* s_nOleError = */ OleGetValue( pDisp ) ) ) ) + { + bTryDefault = FALSE; + + //TraceLog( NULL, "Try using DISPID_VALUE\n" ); + pDisp = OleVal.n1.n2.n3.pdispVal; + goto OleGetID; + } } //TraceLog( NULL, "Invoke Failed!\n" ); OleThrowError(); } + + FreeParams( &DispParams, aPrgParams ); + + // We are responsible to release the Default Interface which we retrieved + if( bTryDefault == FALSE && pDisp ) + { + pDisp->lpVtbl->Release( pDisp ); + } } diff --git a/harbour/contrib/ole2/win32ole.prg b/harbour/contrib/ole2/win32ole.prg index 995b15bb16..dd31c87673 100644 --- a/harbour/contrib/ole2/win32ole.prg +++ b/harbour/contrib/ole2/win32ole.prg @@ -165,8 +165,13 @@ CLASS TOleAuto METHOD GetActiveObject( cClass ) CONSTRUCTOR METHOD Invoke() - MESSAGE Set METHOD Invoke() - MESSAGE Get METHOD Invoke() + MESSAGE CallMethod METHOD Invoke() + + METHOD Set() + MESSAGE SetProperty METHOD Set() + + METHOD Get() + MESSAGE GetProperty METHOD Get() METHOD OleValue() METHOD _OleValue( xSetValue ) @@ -336,11 +341,6 @@ METHOD GetActiveObject( cClass ) CLASS TOleAuto RETURN Self -//-------------------------------------------------------------------- -METHOD Invoke( cMethod, ... ) CLASS TOleAuto - -RETURN HB_ExecFromArray( Self, cMethod, { ... } ) - //-------------------------------------------------------------------- METHOD OleCollection( xIndex, xValue ) CLASS TOleAuto @@ -580,7 +580,7 @@ METHOD OleValueEqual( xArg ) CLASS TOleAuto oErr:CanSubstitute := .T. oErr:Description := "argument error" oErr:GenCode := EG_ARG - oErr:Operation := '%' + oErr:Operation := '=' oErr:Severity := ES_ERROR oErr:SubCode := 1085 oErr:SubSystem := "BASE" @@ -605,7 +605,7 @@ METHOD OleValueExactEqual( xArg ) CLASS TOleAuto oErr:CanSubstitute := .T. oErr:Description := "argument error" oErr:GenCode := EG_ARG - oErr:Operation := '%' + oErr:Operation := '==' oErr:Severity := ES_ERROR oErr:SubCode := 1085 oErr:SubSystem := "BASE" @@ -630,7 +630,7 @@ METHOD OleValueNotEqual( xArg ) CLASS TOleAuto oErr:CanSubstitute := .T. oErr:Description := "argument error" oErr:GenCode := EG_ARG - oErr:Operation := '%' + oErr:Operation := '!=' oErr:Severity := ES_ERROR oErr:SubCode := 1085 oErr:SubSystem := "BASE" diff --git a/harbour/source/rtl/gttrm/gttrm.c b/harbour/source/rtl/gttrm/gttrm.c index 5de33b83f7..e573cf1d89 100644 --- a/harbour/source/rtl/gttrm/gttrm.c +++ b/harbour/source/rtl/gttrm/gttrm.c @@ -1482,6 +1482,11 @@ static void hb_gt_trm_LinuxTone( double dFrequency, double dDuration ) HB_TRACE(HB_TR_DEBUG, ("hb_gt_trm_LinuxTone(%lf, %lf)", dFrequency, dDuration)); + if( s_termState.iACSC ) + { + hb_gt_trm_termOut( ( BYTE * ) "\033[10m", 5 ); + s_termState.iACSC = 0; + } snprintf( escseq, sizeof( escseq ), "\033[10;%d]\033[11;%d]\007", ( int ) dFrequency, ( int ) ( dDuration * 1000.0 / 18.2 ) ); hb_gt_trm_termOut( ( BYTE * ) escseq, strlen( escseq ) ); diff --git a/harbour/source/vm/dynsym.c b/harbour/source/vm/dynsym.c index 4f3186b0e8..54e5c7f5e3 100644 --- a/harbour/source/vm/dynsym.c +++ b/harbour/source/vm/dynsym.c @@ -120,6 +120,86 @@ HB_EXPORT PHB_DYNS hb_dynsymNew( PHB_SYMB pSymbol ) /* creates a new dynamic if( pDynSym ) /* If name exists */ { + if( ( pDynSym->pSymbol->scope.value & + pSymbol->scope.value & HB_FS_LOCAL ) != 0 && + pDynSym->pSymbol != pSymbol ) + { + /* Someone is using linker which allows to create binaries + * with multiple function definitions. It's a big chance that + * wrong binaries are created in such case, f.e both functions + * linked and not all references updated. Anyhow now we will + * have to guess which symbol is the real local one [druzus] + */ + /* Let's check if linker updated function address so both symbols + * refer to the same function + */ + if( pDynSym->pSymbol->value.pFunPtr == pSymbol->value.pFunPtr ) + { + /* The addresses have been updated, f.e. in such case works GCC + * in Linux (but not MinGW and DJGPP) if user will allow to create + * binaries with multiple symbols by + * -Wl,--allow-multiple-definition + * when whole module cannot be cleanly replaced. + * OpenWatcom for Linux, DOS and Windows (I haven't testes OS2 + * version), POCC and XCC (with /FORCE:MULTIPLE) also update + * addresses in such case. + * + * We are guessing that symbols are registered in reverted order + * so we remove the HB_FS_LOCAL flag from previously registered + * symbol but some linkers may use different order so it does + * not have to be true in all cases + */ + pDynSym->pSymbol->scope.value &= ~HB_FS_LOCAL; + } + else + { + /* We have multiple symbol with the same name which refer + * to different public functions inside this single binary + * Let's check if this symbol is loaded from dynamic library + * (.so, .dll, .dyn, ...) or .hrb file + */ + if( pSymbol->scope.value & HB_FS_PCODEFUNC ) + { + /* It's dynamic module so we are guessing that HVM + * intentionally not updated function address allowing + * multiple functions, f.e. programmer asked about keeping + * local references using HB_LIBLOAD()/__HBRLOAD() parameter. + * In such case update pDynSym address in the new symbol but + * do not register it as the main one + */ + pSymbol->pDynSym = pDynSym; /* place a pointer to DynSym */ + return pDynSym; /* Return pointer to DynSym */ + } + /* The multiple symbols comes from single binaries - we have to + * decide what to do with them. We can leave it as is or we can + * try to overload one symbol so both will point to the same + * function. For .prg code such overloading will work but not + * for C code which makes sth like: HB_FUNC_EXEC( funcname ) + * In such case we cannot do anything - we cannot even detect + * such situation. In some cases even linker cannot detect it + * because C compiler can make autoinlining or some bindings + * which are not visible for linker + */ + /* Let's try to overload one of the functions. Simple: + * pDynSym->pSymbol->value.pFunPtr = pSymbol->value.pFunPtr; + * is not good idea because it's possible that this symbol will + * be overloaded yet another time after preprocessing rest of + * symbols so we will use HB_FS_DEFERRED flag which is updated + * dynamically in hb_vmSend()/hb_vmDo() functions + */ +#define HB_OVERLOAD_MULTIPLE_FUNC + +#if defined( HB_OVERLOAD_MULTIPLE_FUNC ) +#if defined( __GNUC__ ) && !defined( __DJGPP__ ) + pDynSym->pSymbol->scope.value &= ~HB_FS_LOCAL; + pDynSym->pSymbol->scope.value |= HB_FS_DEFERRED; +#else + pSymbol->scope.value &= ~HB_FS_LOCAL; + pSymbol->scope.value |= HB_FS_DEFERRED; +#endif +#endif + } + } if( ( !pDynSym->pSymbol->value.pFunPtr && pSymbol->value.pFunPtr ) || ( pSymbol->scope.value & HB_FS_LOCAL ) != 0 ) { diff --git a/harbour/source/vm/proc.c b/harbour/source/vm/proc.c index 8a1f784ac2..c29c21e9e7 100644 --- a/harbour/source/vm/proc.c +++ b/harbour/source/vm/proc.c @@ -114,6 +114,13 @@ HB_FUNC( PROCFILE ) { pSym = hb_itemGetSymbol( hb_param( 1, HB_IT_SYMBOL ) ); } + else if( ISCHAR( 1 ) ) + { + PHB_DYNS pDynSym = hb_dynsymFindName( hb_parc( 1 ) ); + + if( pDynSym ) + pSym = pDynSym->pSymbol; + } else { long lOffset = hb_stackBaseProcOffset( hb_parni( 1 ) + 1 ); diff --git a/harbour/tests/multifnc/Makefile b/harbour/tests/multifnc/Makefile new file mode 100644 index 0000000000..d5c5aaab5a --- /dev/null +++ b/harbour/tests/multifnc/Makefile @@ -0,0 +1,55 @@ +# +# $Id$ +# + +ifeq ($(HB_COMPILER),gcc) +L_USR += -Wl,--allow-multiple-definition +else +ifeq ($(HB_COMPILER),gpp) +L_USR += -Wl,--allow-multiple-definition +else +ifeq ($(HB_COMPILER),djgpp) +L_USR += -Wl,--allow-multiple-definition +else +ifeq ($(HB_COMPILER),mingw32) +L_USR += -Wl,--allow-multiple-definition +else +ifeq ($(HB_COMPILER),xcc) +L_USR += /FORCE:MULTIPLE +else +ifeq ($(HB_COMPILER),pocc) +L_USR += /FORCE:MULTIPLE +endif +endif +endif +endif +endif +endif + +ifeq ($(HB_MAIN),) +HB_MAIN = std +endif + +ROOT = ../../ + +PRG_SOURCES=\ + t0.prg \ + t1.prg \ + t2.prg \ + +PRG_MAIN=t0.prg + +LIBS=\ + debug \ + vm \ + rtl \ + lang \ + codepage \ + rdd \ + rtl \ + vm \ + macro \ + pp \ + common \ + +include $(TOP)$(ROOT)config/bin.cf diff --git a/harbour/tests/multifnc/t0.prg b/harbour/tests/multifnc/t0.prg new file mode 100644 index 0000000000..c33124d614 --- /dev/null +++ b/harbour/tests/multifnc/t0.prg @@ -0,0 +1,23 @@ +proc main() +__NONOALERT() +? "main", procfile("main"), procfile(@main()) +? "alert", procfile("alert"), procfile(@alert()), alert() +? "p0", procfile("p0"), procfile(@p0()), (@p0()):exec(), p0(), t("p0",@p0(),p0(),"t0.prg") +? "p1", procfile("p1"), procfile(@p1()), (@p1()):exec(), p1(), t("p1",@p1(),p1(),"t0.prg") +? "p2", procfile("p2"), procfile(@p2()), (@p2()):exec(), p2(), t("p2",@p2(),p2(),"t1.prg") +? "p3", procfile("p3"), procfile(@p3()), (@p3()):exec(), p3(), t("p3",@p3(),p3(),"t0.prg") +? "p4", procfile("p4"), procfile(@p4()), (@p4()):exec(), p4(), t("p4",@p4(),p4(),"t1.prg") +? "p5", procfile("p5"), procfile(@p5()), (@p5()):exec(), p5(), t("p5",@p5(),p5(),"t2.prg") +? "===" +main2() + +func t(cFunc,sFunc,cResult,cModule) +if &(cFunc+"()")==cResult .and. sFunc:exec()==cResult .and. ; + upper(cModule)==upper(right(cResult,len(cModule))) + return "OK" +endif +return "ERR" + +func p0(); return "P0:t0.prg" +func p1(); return "P1:t0.prg" +func p3(); return "P3:t0.prg" diff --git a/harbour/tests/multifnc/t1.prg b/harbour/tests/multifnc/t1.prg new file mode 100644 index 0000000000..60b0956209 --- /dev/null +++ b/harbour/tests/multifnc/t1.prg @@ -0,0 +1,20 @@ +proc main2() +? "main2", procfile("main2"), procfile(@main2()) +? "alert", procfile("alert"), procfile(@alert()), alert() +? "p0", procfile("p0"), procfile(@p0()), (@p0()):exec(), p0(), t("p0",@p0(),p0(),"t0.prg") +? "p1", procfile("p1"), procfile(@p1()), (@p1()):exec(), p1(), t("p1",@p1(),p1(),"t0.prg") +? "p2", procfile("p2"), procfile(@p2()), (@p2()):exec(), p2(), t("p2",@p2(),p2(),"t1.prg") +? "p3", procfile("p3"), procfile(@p3()), (@p3()):exec(), p3(), t("p3",@p3(),p3(),"t0.prg") +? "p4", procfile("p4"), procfile(@p4()), (@p4()):exec(), p4(), t("p4",@p4(),p4(),"t1.prg") +? "p5", procfile("p5"), procfile(@p5()), (@p5()):exec(), p5(), t("p5",@p5(),p5(),"t2.prg") +? "===" +main3() +return + +func p1(); return "P1:t1.prg" +func p2(); return "P2:t1.prg" +func p3(); return "P3:t1.prg" +func p4(); return "P4:t1.prg" + +func alert() +return "[ALERT]" diff --git a/harbour/tests/multifnc/t2.prg b/harbour/tests/multifnc/t2.prg new file mode 100644 index 0000000000..0a79998fdb --- /dev/null +++ b/harbour/tests/multifnc/t2.prg @@ -0,0 +1,14 @@ +proc main3() +? "main3", procfile("main3"), procfile(@main3()) +? "alert", procfile("alert"), procfile(@alert()), alert() +? "p0", procfile("p0"), procfile(@p0()), (@p0()):exec(), p0(), t("p0",@p0(),p0(),"t0.prg") +? "p1", procfile("p1"), procfile(@p1()), (@p1()):exec(), p1(), t("p1",@p1(),p1(),"t0.prg") +? "p2", procfile("p2"), procfile(@p2()), (@p2()):exec(), p2(), t("p2",@p2(),p2(),"t1.prg") +? "p3", procfile("p3"), procfile(@p3()), (@p3()):exec(), p3(), t("p3",@p3(),p3(),"t0.prg") +? "p4", procfile("p4"), procfile(@p4()), (@p4()):exec(), p4(), t("p4",@p4(),p4(),"t1.prg") +? "p5", procfile("p5"), procfile(@p5()), (@p5()):exec(), p5(), t("p5",@p5(),p5(),"t2.prg") +return + +func p2(); return "P2:t2.prg" +func p3(); return "P3:t2.prg" +func p5(); return "P5:t2.prg" diff --git a/harbour/tests/oleenum.prg b/harbour/tests/oleenum.prg new file mode 100644 index 0000000000..3fe8776f8a --- /dev/null +++ b/harbour/tests/oleenum.prg @@ -0,0 +1,24 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * demonstration code for FOR EACH used for OLE objects + * this code needs HBOLE library + * + * Copyright 2007 Enrico Maria Giordano e.m.giordano at emagsoftware.it + * www - http://www.harbour-project.org + * + */ + +FUNCTION MAIN() + LOCAL oExcel := CREATEOBJECT( "Excel.Application" ) + LOCAL oWorkBook := oExcel:WorkBooks:Add() + LOCAL oWorkSheet + + FOR EACH oWorkSheet IN oWorkBook:WorkSheets + ? oWorkSheet:Name + NEXT + oExcel:Quit() +RETURN NIL