From 00c09ce91f23c83788a9567d1edd8966ffb48818 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Wed, 8 Dec 2010 20:54:55 +0000 Subject: [PATCH] 2010-12-08 21:53 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * src/debug/debugger.prg * contrib/hbodbc/tests/odbccall.prg * contrib/hbblat/tests/blattest.prg * contrib/hbgd/gd.prg * contrib/hbtip/tests/tipmail.prg * examples/rddado/adordd.prg * examples/httpsrv/cgifunc.prg * Eliminated using WITH OBJECT. % Some optimizations, little fixes. * tests/omacro.prg * Formatting. --- harbour/ChangeLog | 14 +++ harbour/contrib/hbblat/tests/blattest.prg | 57 ++++++------ harbour/contrib/hbgd/gd.prg | 100 ++++++++++---------- harbour/contrib/hbodbc/tests/odbccall.prg | 32 +++---- harbour/contrib/hbtip/tests/tipmail.prg | 43 ++++----- harbour/examples/httpsrv/cgifunc.prg | 6 +- harbour/examples/rddado/adordd.prg | 106 ++++++++++------------ harbour/src/debug/debugger.prg | 31 ++++--- harbour/tests/omacro.prg | 31 ++++--- 9 files changed, 211 insertions(+), 209 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 85e881fd49..43e6fb01ae 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,20 @@ The license applies to all entries newer than 2009-04-28. */ +2010-12-08 21:53 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * src/debug/debugger.prg + * contrib/hbodbc/tests/odbccall.prg + * contrib/hbblat/tests/blattest.prg + * contrib/hbgd/gd.prg + * contrib/hbtip/tests/tipmail.prg + * examples/rddado/adordd.prg + * examples/httpsrv/cgifunc.prg + * Eliminated using WITH OBJECT. + % Some optimizations, little fixes. + + * tests/omacro.prg + * Formatting. + 2010-12-08 12:20 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/src/compiler/complex.c ! fixed condition used in some seldom places to convert expressions diff --git a/harbour/contrib/hbblat/tests/blattest.prg b/harbour/contrib/hbblat/tests/blattest.prg index c1bdc6871d..7173d47ccc 100644 --- a/harbour/contrib/hbblat/tests/blattest.prg +++ b/harbour/contrib/hbblat/tests/blattest.prg @@ -69,39 +69,36 @@ PROCEDURE Main() ? ? "HBBlat test" - WITH OBJECT oBlat - :cFrom := ADDRESS_FROM - :cTo := ADDRESS_TO - //:cUserAUTH := "myaccount@mydomain.org" - //:cPasswordAUTH := "mypassword" - //:cHostname := "mail.anydomain.com" - //:cCC := ADDRESS_CC - //:cCCFile := "f_cc.txt" - //:cBCC := "info@fsgiudice.com" - //:cBCCFile := "f_bcc.txt" - //:cBodyFile := "c.bat" - :cBody := e"Body part\n\rEnd Body" - :cServerSMTP := SERVER_SMTP - :cSubject := "Test from Blat" - //:lSuppressSubject := TRUE - //:cSubjectFile := "f_subjct.txt" - //:lToUndiscloseRecipients := TRUE - :cPostScriptumFile := "f_ps.txt" - :lRequestDisposition := TRUE // does not work ??? - :lRequestReturnReceipt := TRUE + oBlat:cFrom := ADDRESS_FROM + oBlat:cTo := ADDRESS_TO + // oBlat:cUserAUTH := "myaccount@mydomain.org" + // oBlat:cPasswordAUTH := "mypassword" + // oBlat:cHostname := "mail.anydomain.com" + // oBlat:cCC := ADDRESS_CC + // oBlat:cCCFile := "f_cc.txt" + // oBlat:cBCC := "info@fsgiudice.com" + // oBlat:cBCCFile := "f_bcc.txt" + // oBlat:cBodyFile := "c.bat" + oBlat:cBody := e"Body part\n\rEnd Body" + oBlat:cServerSMTP := SERVER_SMTP + oBlat:cSubject := "Test from Blat" + // oBlat:lSuppressSubject := .T. + // oBlat:cSubjectFile := "f_subjct.txt" + // oBlat:lToUndiscloseRecipients := .T. + oBlat:cPostScriptumFile := "f_ps.txt" + oBlat:lRequestDisposition := .T. // does not work ??? + oBlat:lRequestReturnReceipt := .T. - :cAttachTextFiles := "f_subjct.txt" - :aAttachTextFiles := { "f_ps.txt", "blattest.prg", "blatcmd.prg" } - :cAttachListTextFile := "f_listtx.txt" + oBlat:cAttachTextFiles := "f_subjct.txt" + oBlat:aAttachTextFiles := { "f_ps.txt", "blattest.prg", "blatcmd.prg" } + oBlat:cAttachListTextFile := "f_listtx.txt" - :cLogFile := "log.txt" - :lLogTimestamp := TRUE - :lDebug := TRUE - :lLogOverwrite := TRUE + oBlat:cLogFile := "log.txt" + oBlat:lLogTimestamp := .T. + oBlat:lDebug := .T. + oBlat:lLogOverwrite := .T. - //:lSuperDebug := TRUE // This display internal checking - - END + // oBlat:lSuperDebug := .T. // This display internal checking ? "Checking options ..." //oBlat:Check() diff --git a/harbour/contrib/hbgd/gd.prg b/harbour/contrib/hbgd/gd.prg index 8f508fec6a..7956df76e2 100644 --- a/harbour/contrib/hbgd/gd.prg +++ b/harbour/contrib/hbgd/gd.prg @@ -87,7 +87,8 @@ FUNCTION gdImageFTWidth( fontname, ptsize, angle ) FUNCTION gdImageFTHeight( fontname, ptsize, angle ) LOCAL nWidth := 0 LOCAL cErr - LOCAL aRect := Array(8) + LOCAL aRect := Array( 8 ) + DEFAULT fontname TO "Arial" DEFAULT ptsize TO 8 DEFAULT angle TO 0 @@ -185,68 +186,75 @@ FUNCTION gdImageToString( oImage ) LOCAL cString IF ISOBJECT( oImage ) .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) ) - WITH OBJECT oImage - IF :cType != NIL - DO CASE - CASE :cType == "jpeg" - cString := :ToStringJpeg() - CASE :cType == "gif" - cString := :ToStringGif() - CASE :cType == "png" - cString := :ToStringPng() - ENDCASE - ENDIF - ENDWITH + IF oImage:cType != NIL + SWITCH oImage:cType + CASE "jpeg" + cString := oImage:ToStringJpeg() + EXIT + CASE "gif" + cString := oImage:ToStringGif() + EXIT + CASE "png" + cString := oImage:ToStringPng() + EXIT + ENDSWITCH + ENDIF ENDIF RETURN cString PROCEDURE gdImageToFile( oImage, cFile ) LOCAL cString, cExt - DEFAULT cFile TO "image" + IF ! ISCHARACTER( cFile ) + cFile := "image" + ENDIF IF ISOBJECT( oImage ) .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) ) - WITH OBJECT oImage - IF :cType != NIL - DO CASE - CASE :cType == "jpeg" - cString := :ToStringJpeg() - cExt := ".jpg" - CASE :cType == "gif" - cString := :ToStringGif() - cExt := ".gif" - CASE :cType == "png" - cString := :ToStringPng() - cExt := ".png" - OTHERWISE - cExt := "" - ENDCASE - IF cString != NIL - hb_MemoWrit( cFile + cExt, cString ) - ENDIF + IF oImage:cType != NIL + SWITCH oImage:cType + CASE "jpeg" + cString := oImage:ToStringJpeg() + cExt := ".jpg" + EXIT + CASE "gif" + cString := oImage:ToStringGif() + cExt := ".gif" + EXIT + CASE "png" + cString := oImage:ToStringPng() + cExt := ".png" + EXIT + OTHERWISE + cExt := "" + ENDSWITCH + IF cString != NIL + hb_MemoWrit( cFile + cExt, cString ) ENDIF - ENDWITH + ENDIF ENDIF RETURN PROCEDURE gdImageToHandle( oImage, nHandle ) - DEFAULT nHandle TO 1 + IF ! ISNUMBER( nHandle ) + nHandle := 1 + ENDIF IF ISOBJECT( oImage ) .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) ) - WITH OBJECT oImage - IF :cType != NIL - DO CASE - CASE :cType == "jpeg" - :OutputJpeg( nHandle ) - CASE :cType == "gif" - :OutputGif( nHandle ) - CASE :cType == "png" - :OutputPng( nHandle ) - ENDCASE - ENDIF - ENDWITH + IF oImage:cType != NIL + SWITCH oImage:cType + CASE "jpeg" + oImage:OutputJpeg( nHandle ) + EXIT + CASE "gif" + oImage:OutputGif( nHandle ) + EXIT + CASE "png" + oImage:OutputPng( nHandle ) + EXIT + ENDSWITCH + ENDIF ENDIF RETURN diff --git a/harbour/contrib/hbodbc/tests/odbccall.prg b/harbour/contrib/hbodbc/tests/odbccall.prg index 0e1aa8768d..b29d551c40 100644 --- a/harbour/contrib/hbodbc/tests/odbccall.prg +++ b/harbour/contrib/hbodbc/tests/odbccall.prg @@ -13,24 +13,20 @@ PROCEDURE Main() dsFunctions := TODBC():New( cConStr ) - WITH OBJECT dsFunctions - - :SetSQL( "SELECT * FROM test" ) - :Open() - ? :FieldByName( "First" ):Value - ? :Skip() - ? :FieldByName( "First" ):Value - ? :GoTo( 1 ) - ? :FieldByName( "First" ):Value - ? :Prior() - ? :FieldByName( "First" ):Value - ? :First() - ? :FieldByName( "First" ):Value - ? :Last() - ? :FieldByName( "First" ):Value - ? :Close() - - ENDWITH + dsFunctions:SetSQL( "SELECT * FROM test" ) + dsFunctions:Open() + ? dsFunctions:FieldByName( "First" ):Value + ? dsFunctions:Skip() + ? dsFunctions:FieldByName( "First" ):Value + ? dsFunctions:GoTo( 1 ) + ? dsFunctions:FieldByName( "First" ):Value + ? dsFunctions:Prior() + ? dsFunctions:FieldByName( "First" ):Value + ? dsFunctions:First() + ? dsFunctions:FieldByName( "First" ):Value + ? dsFunctions:Last() + ? dsFunctions:FieldByName( "First" ):Value + ? dsFunctions:Close() dsFunctions:Destroy() diff --git a/harbour/contrib/hbtip/tests/tipmail.prg b/harbour/contrib/hbtip/tests/tipmail.prg index 95642b82c1..4534ab8583 100644 --- a/harbour/contrib/hbtip/tests/tipmail.prg +++ b/harbour/contrib/hbtip/tests/tipmail.prg @@ -29,30 +29,27 @@ PROCEDURE MAIN( cFileName ) ? "Malformed mail. Dumping up to where parsed" ENDIF - WITH OBJECT oMail - ? "-------------============== HEADERS =================--------------" - FOR i := 1 TO Len( :hHeaders ) - ? hb_HKeyAt( :hHeaders, i ), ":", hb_HValueAt( :hHeaders, i ) - NEXT + ? "-------------============== HEADERS =================--------------" + FOR i := 1 TO Len( oMail:hHeaders ) + ? hb_HKeyAt( oMail:hHeaders, i ), ":", hb_HValueAt( oMail:hHeaders, i ) + NEXT + ? + + ? "-------------============== RECEIVED =================--------------" + FOR EACH cData IN oMail:aReceived + ? cData + NEXT + ? + + ? "-------------============== BODY =================--------------" + ? oMail:GetBody() + ? + + DO WHILE oMail:GetAttachment() != NIL + ? "-------------============== ATTACHMENT =================--------------" + ? oMail:NextAttachment():GetBody() ? - - ? "-------------============== RECEIVED =================--------------" - FOR EACH cData IN :aReceived - ? cData - NEXT - ? - - ? "-------------============== BODY =================--------------" - ? :GetBody() - ? - - DO WHILE :GetAttachment() != NIL - ? "-------------============== ATTACHMENT =================--------------" - ? :NextAttachment():GetBody() - ? - ENDDO - - END + ENDDO ? "DONE" ? diff --git a/harbour/examples/httpsrv/cgifunc.prg b/harbour/examples/httpsrv/cgifunc.prg index 4c66ccf804..dc9f870edc 100644 --- a/harbour/examples/httpsrv/cgifunc.prg +++ b/harbour/examples/httpsrv/cgifunc.prg @@ -753,10 +753,8 @@ FUNCTION uhttpd_SplitFileName( cFile ) cSep := hb_ps() - WITH OBJECT hFile - :FULLPATH := IIF( !Empty( :PATH ), IIF( !( Right( :PATH, Len( cSep ) ) == cSep ), :PATH + cSep, :PATH ), "" ) - :UNC := :FULLPATH + :FULLNAME - END + hFile:FULLPATH := IIF( !Empty( hFile:PATH ), IIF( !( Right( hFile:PATH, Len( cSep ) ) == cSep ), hFile:PATH + cSep, hFile:PATH ), "" ) + hFile:UNC := hFile:FULLPATH + hFile:FULLNAME RETURN hFile diff --git a/harbour/examples/rddado/adordd.prg b/harbour/examples/rddado/adordd.prg index 80ed3fd1ef..a2e4034602 100644 --- a/harbour/examples/rddado/adordd.prg +++ b/harbour/examples/rddado/adordd.prg @@ -441,69 +441,59 @@ STATIC FUNCTION ADO_CLOSE( nWA ) STATIC FUNCTION ADO_GETVALUE( nWA, nField, xValue ) LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL rs := USRRDD_AREADATA( nWA )[ WA_RECORDSET ] - WITH OBJECT USRRDD_AREADATA( nWA )[ WA_RECORDSET ] - IF aWAData[ WA_EOF ] .OR. :EOF .OR. :BOF - xValue := NIL - IF ADO_GETFIELDTYPE( :Fields( nField - 1 ):Type ) == HB_FT_STRING - xValue := Space( :Fields( nField - 1 ):DefinedSize ) + IF aWAData[ WA_EOF ] .OR. rs:EOF .OR. rs:BOF + xValue := NIL + IF ADO_GETFIELDTYPE( rs:Fields( nField - 1 ):Type ) == HB_FT_STRING + xValue := Space( rs:Fields( nField - 1 ):DefinedSize ) + ENDIF + ELSE + xValue := rs:Fields( nField - 1 ):Value + + IF ADO_GETFIELDTYPE( rs:Fields( nField - 1 ):Type ) == HB_FT_STRING + IF ValType( xValue ) == "U" + xValue := Space( rs:Fields( nField - 1 ):DefinedSize ) + ELSE + xValue := PadR( xValue, rs:Fields( nField - 1 ):DefinedSize ) ENDIF - ELSE - xValue := :Fields( nField - 1 ):Value - - IF ADO_GETFIELDTYPE( :Fields( nField - 1 ):Type ) == HB_FT_STRING - IF ValType( xValue ) == "U" - xValue := Space( :Fields( nField - 1 ):DefinedSize ) - ELSE - xValue := PadR( xValue, :Fields( nField - 1 ):DefinedSize ) - ENDIF - ELSEIF ADO_GETFIELDTYPE( :Fields( nField - 1 ):Type ) == HB_FT_DATE - /* Null values */ - IF ValType( xValue ) == "U" - xValue := hb_SToD() - ENDIF -#ifdef HB_FT_DATETIME - ELSEIF ADO_GETFIELDTYPE( :Fields( nField - 1 ):Type ) == HB_FT_DATETIME - /* Null values */ - IF ValType( xValue ) == "U" - xValue := hb_SToD() - ENDIF -#endif - ELSEIF ADO_GETFIELDTYPE( :Fields( nField - 1 ):Type ) == HB_FT_TIMESTAMP - /* Null values */ - IF ValType( xValue ) == "U" - xValue := hb_SToD() - ENDIF + ELSEIF ADO_GETFIELDTYPE( rs:Fields( nField - 1 ):Type ) == HB_FT_DATE + /* Null values */ + IF ValType( xValue ) == "U" + xValue := hb_SToD() + ENDIF + ELSEIF ADO_GETFIELDTYPE( rs:Fields( nField - 1 ):Type ) == HB_FT_TIMESTAMP + /* Null values */ + IF ValType( xValue ) == "U" + xValue := hb_SToD() ENDIF ENDIF - END WITH + ENDIF RETURN HB_SUCCESS STATIC FUNCTION ADO_GOTO( nWA, nRecord ) LOCAL nRecNo + LOCAL rs := USRRDD_AREADATA( nWA )[ WA_RECORDSET ] - WITH OBJECT USRRDD_AREADATA( nWA )[ WA_RECORDSET ] - IF :RecordCount > 0 - :MoveFirst() - :Move( nRecord - 1, 0 ) - ENDIF - ADO_RECID( nWA, @nRecNo ) - END WITH + IF rs:RecordCount > 0 + rs:MoveFirst() + rs:Move( nRecord - 1, 0 ) + ENDIF + ADO_RECID( nWA, @nRecNo ) RETURN iif( nRecord == nRecNo, HB_SUCCESS, HB_FAILURE ) STATIC FUNCTION ADO_GOTOID( nWA, nRecord ) LOCAL nRecNo + LOCAL rs := USRRDD_AREADATA( nWA )[ WA_RECORDSET ] - WITH OBJECT USRRDD_AREADATA( nWA )[ WA_RECORDSET ] - IF :RecordCount > 0 - :MoveFirst() - :Move( nRecord - 1, 0 ) - ENDIF - ADO_RECID( nWA, @nRecNo ) - END WITH + IF rs:RecordCount > 0 + rs:MoveFirst() + rs:Move( nRecord - 1, 0 ) + ENDIF + ADO_RECID( nWA, @nRecNo ) RETURN iif( nRecord == nRecNo, HB_SUCCESS, HB_FAILURE ) @@ -895,21 +885,19 @@ STATIC FUNCTION ADO_ORDLSTFOCUS( nWA, aOrderInfo ) LOCAL aWAData := USRRDD_AREADATA( nWA ) LOCAL oRecordSet := aWAData[ WA_RECORDSET ] - WITH OBJECT oRecordSet - ADO_RECID( nWA, @nRecNo ) + ADO_RECID( nWA, @nRecNo ) - :Close() - IF aOrderInfo[ UR_ORI_TAG ] == 0 - :Open( "SELECT * FROM " + s_aTableNames[ nWA ] , HB_QWith(), adOpenDynamic, adLockPessimistic ) - ELSE - //:Open( "SELECT * FROM " + ::oTabla:cTabla + ' ORDER BY ' + ::OrdKey( uTag ) , QWith(), adOpenDynamic, adLockPessimistic, adCmdUnspecified ) - :Open( "SELECT * FROM " + s_aTableNames[ nWA ], HB_QWith(), adOpenDynamic, adLockPessimistic ) - ENDIF - aOrderInfo[ UR_ORI_RESULT ] := aOrderInfo[ UR_ORI_TAG ] + oRecordSet:Close() + IF aOrderInfo[ UR_ORI_TAG ] == 0 + oRecordSet:Open( "SELECT * FROM " + s_aTableNames[ nWA ] , HB_QWith(), adOpenDynamic, adLockPessimistic ) + ELSE + // oRecordSet:Open( "SELECT * FROM " + ::oTabla:cTabla + ' ORDER BY ' + ::OrdKey( uTag ) , QWith(), adOpenDynamic, adLockPessimistic, adCmdUnspecified ) + oRecordSet:Open( "SELECT * FROM " + s_aTableNames[ nWA ], HB_QWith(), adOpenDynamic, adLockPessimistic ) + ENDIF + aOrderInfo[ UR_ORI_RESULT ] := aOrderInfo[ UR_ORI_TAG ] - ADO_GOTOP( nWA ) - ADO_GOTO( nWA, nRecNo ) - END WITH + ADO_GOTOP( nWA ) + ADO_GOTO( nWA, nRecNo ) */ RETURN HB_SUCCESS diff --git a/harbour/src/debug/debugger.prg b/harbour/src/debug/debugger.prg index 8c39d0b365..5cb27a6485 100644 --- a/harbour/src/debug/debugger.prg +++ b/harbour/src/debug/debugger.prg @@ -815,6 +815,7 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger LOCAL cParam1 := "" LOCAL cResult LOCAL lValid + LOCAL oWindow LOCAL n cCommand := AllTrim( cCommand ) @@ -1024,24 +1025,24 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger DO CASE CASE starts( "MOVE", cParam ) - WITH OBJECT ::aWindows[ ::nCurrentWindow ] - n := At( " ", cParam1 ) - IF n > 0 - n := Val( SubStr( cParam1, n ) ) - ENDIF - :Resize( Val( cParam1 ), n, ; - :nBottom + Val( cParam1 ) - :nTop, :nRight + n - :nLeft ) - ENDWITH + oWindow := ::aWindows[ ::nCurrentWindow ] + n := At( " ", cParam1 ) + IF n > 0 + n := Val( SubStr( cParam1, n ) ) + ENDIF + oWindow:Resize( Val( cParam1 ), n, ; + oWindow:nBottom + Val( cParam1 ) - oWindow:nTop, ; + oWindow:nRight + n - oWindow:nLeft ) CASE starts( "NEXT", cParam ) ::NextWindow() CASE starts( "SIZE", cParam ) - WITH OBJECT ::aWindows[ ::nCurrentWindow ] - n := At( " ", cParam1 ) - IF Val( cParam1 ) >= 2 .AND. n > 0 .AND. Val( SubStr( cParam1, n ) ) > 0 - :Resize( :nTop, :nLeft, Val( cParam1 ) - 1 + :nTop, ; - Val( SubStr( cParam1, n ) ) - 1 + :nLeft ) - ENDIF - ENDWITH + n := At( " ", cParam1 ) + IF Val( cParam1 ) >= 2 .AND. n > 0 .AND. Val( SubStr( cParam1, n ) ) > 0 + oWindow := ::aWindows[ ::nCurrentWindow ] + oWindow:Resize( oWindow:nTop, oWindow:nLeft, ; + Val( cParam1 ) - 1 + oWindow:nTop, ; + Val( SubStr( cParam1, n ) ) - 1 + oWindow:nLeft ) + ENDIF ENDCASE CASE starts( "WP", cCommand ) diff --git a/harbour/tests/omacro.prg b/harbour/tests/omacro.prg index 0e81bfa94e..90bb8b6b46 100644 --- a/harbour/tests/omacro.prg +++ b/harbour/tests/omacro.prg @@ -1,12 +1,15 @@ /* * $Id$ - * + */ + +/* * This file tests support for passing object methods and vars * using macro syntax */ + PROCEDURE MAIN() -LOCAL obj:=ErrorNew() -MEMVAR send1, send2 + LOCAL obj:=ErrorNew() + MEMVAR send1, send2 PRIVATE send1:="_description" PRIVATE send2:="_tries" @@ -17,32 +20,32 @@ MEMVAR send1, send2 obj:tries += 1 obj:tries++ ++obj:tries - + WITH OBJECT obj :tries += 1 :tries++ ++:tries - + /* Notice that for post/pre increment decrement operators and - for assigments (:=,+=,-=,*=,/=) the macro have to + for assigments (:=,+=,-=,*=,/=) the macro have to start from the underscore symbol '_' - + To access the object variable using macro the '_' should be omitted -*/ - :&send2 +=1 +*/ + :&send2 +=1 :&send2++ ++:&send2 ++:&(send2) - + :&( send2 ) := :&( SUBSTR(send2,2) ) +1 - + :&send1 +=' description' :&(send1) += ' of ' - END - + ENDWITH + obj:&( "_"+ SUBSTR(send1,2) ) += "Error object" ? send1, "=", obj:&( SUBSTR(send1,2) ) ? send2, "=", obj:tries -RETURN \ No newline at end of file + RETURN