diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 63b2f92dc0..04db0fe798 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,22 @@ The license applies to all entries newer than 2009-04-28. */ +2012-10-12 15:06 UTC+0200 Viktor Szakats (harbour syenar.net) + * src/rdd/usrrdd/rdds/arrayrdd.prg + ! fixed negative index on array + + + contrib/xhb/tests/decode.prg + * contrib/xhb/decode.prg + * moved test code to separate file + ! fixed test code to run + % optimized an internal function + + * contrib/hbgd/gdbarcod.prg + * use local constant instead of literals + + * contrib/xhb/cstruct.prg + * formatting + 2012-10-12 15:05 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * harbour/package/harbour.spec ! reenbaled ldconfig in post install/uninstall harbour-li*.rpm scripts diff --git a/harbour/contrib/hbgd/gdbarcod.prg b/harbour/contrib/hbgd/gdbarcod.prg index 5969704b72..452efb5eea 100644 --- a/harbour/contrib/hbgd/gdbarcod.prg +++ b/harbour/contrib/hbgd/gdbarcod.prg @@ -543,7 +543,7 @@ METHOD Draw128( cText, cModeCode ) CLASS TCode IF lTypeCodeC IF Len( ::TEXT ) == n - cconc += ::aCode[ 101 ] + cconc += ::aCode[ CODEB ] nvalchar := Asc( cchar ) - 31 ELSE nvalchar := Val( SubStr( ::text, n, 2 ) ) + 1 @@ -553,7 +553,7 @@ METHOD Draw128( cText, cModeCode ) CLASS TCode ELSEIF lTypeCodeA IF cchar > "_" - cconc += ::aCode[ 101 ] + cconc += ::aCode[ CODEB ] nvalchar := Asc( cchar ) - 31 ELSEIF cchar <= " " nvalchar := Asc( cchar ) + 64 diff --git a/harbour/contrib/xhb/cstruct.prg b/harbour/contrib/xhb/cstruct.prg index b374290066..29d855be26 100644 --- a/harbour/contrib/xhb/cstruct.prg +++ b/harbour/contrib/xhb/cstruct.prg @@ -242,7 +242,7 @@ PROCEDURE HB_CStructureCSyntax( cStructure, aDefinitions, cTag, cSynonList, nAli AAdd( aDefinitions, SubStr( cElem, nAt + 1 ) ) ENDIF - aDefinitions[nIndex] := StrTran( Left( cElem, nAt ), " " ) + aDefinitions[ nIndex ] := StrTran( Left( cElem, nAt ), " " ) ELSEIF ( nAt := At( "-", cElem ) ) > 1 IF nIndex < Len( aDefinitions ) hb_AIns( aDefinitions, nIndex + 1, SubStr( cElem, nAt ), .T. ) @@ -250,7 +250,7 @@ PROCEDURE HB_CStructureCSyntax( cStructure, aDefinitions, cTag, cSynonList, nAli AAdd( aDefinitions, SubStr( cElem, nAt ) ) ENDIF - aDefinitions[nIndex] := RTrim( Left( cElem, nAt - 1 ) ) + aDefinitions[ nIndex ] := RTrim( Left( cElem, nAt - 1 ) ) ENDIF nIndex++ diff --git a/harbour/contrib/xhb/decode.prg b/harbour/contrib/xhb/decode.prg index 9416aa2155..255983b590 100644 --- a/harbour/contrib/xhb/decode.prg +++ b/harbour/contrib/xhb/decode.prg @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * Decode function + * hb_Decode() function * * Copyright 2006 Francesco Saverio Giudice * www - http://harbour-project.org @@ -51,35 +51,6 @@ * */ -/* -PROCEDURE Main() - LOCAL aArray - - ? "DECODE FUNCTION TESTS" - - // Single, return empty value - ? Decode( 10 ) - // A list - ? Decode( 3, 1, "A", 2, "B", 3, "C" ) - // A list with default - ? Decode( 4, 1, "A", 2, "B", 3, "C", "X" ) - // Using an array as list of values to check - ? Decode( 2, { 1, "A", 2, "B", 3, "C" } ) - // Using an array with default as list of values to check - ? Decode( 2, { 1, "A", 2, "B", 3, "C", "X" } ) - // Using an hash as list - ? Decode( 2, { 1 => "A", 2 => "B", 3 => "C" } ) - - // Returning a codeblock - ? cStr( Decode( 2, 1, {|| 1 }, 2, {|| 2 }, 3, {|| 3 } ) ) - - // Checking an array - aArray := { 1 } - ? Decode( aArray, aArray, "A", { 2 }, "B", { 3 }, "C" ) - - RETURN -*/ - /****************** * Function .......: hb_Decode( , [ ]> ) ---> * Author .........: Francesco Saverio Giudice @@ -88,13 +59,14 @@ PROCEDURE Main() * * Decode a value from a list. *******************/ -FUNCTION HB_Decode(...) + +FUNCTION HB_Decode( ... ) LOCAL aParams, nParams, xDefault LOCAL xVal, cKey, xRet LOCAL aValues, aResults, n, i, nPos, nLen - aParams := hb_aParams() + aParams := hb_AParams() nParams := PCount() xDefault := NIL @@ -108,7 +80,7 @@ FUNCTION HB_Decode(...) // if I have a odd number of members, last is default IF ( nParams % 2 != 0 ) - xDefault := aTail( aParams ) + xDefault := ATail( aParams ) // Resize again deleting last hb_ADel( aParams, nParams, .T. ) nParams := Len( aParams ) @@ -117,8 +89,8 @@ FUNCTION HB_Decode(...) // Ok because I have no other value than default, I will check if it is a complex value // like an array or an hash, so I can get it to decode values IF xDefault != NIL .AND. ; - ( HB_ISARRAY( xDefault ) .OR. ; - HB_ISHASH( xDefault ) ) + ( HB_ISARRAY( xDefault ) .OR. ; + HB_ISHASH( xDefault ) ) // If it is an array I will restart this function creating a linear call IF HB_ISARRAY( xDefault ) .AND. Len( xDefault ) > 0 @@ -147,7 +119,7 @@ FUNCTION HB_Decode(...) aParams[ n++ ] := xDefault[ i ][ 2 ] NEXT - aAdd( aParams, xDefault[ nLen ] ) + AAdd( aParams, xDefault[ nLen ] ) ELSE @@ -169,15 +141,15 @@ FUNCTION HB_Decode(...) ENDIF - // If it is an hash, translate it in an array + // If it is an hash, translate it in an array ELSEIF HB_ISHASH( xDefault ) aParams := Array( Len( xDefault ) * 2 ) i := 1 FOR EACH cKey IN xDefault:Keys - aParams[ i++ ] := cKey - aParams[ i++ ] := xDefault[ cKey ] + aParams[ i++ ] := cKey + aParams[ i++ ] := xDefault[ cKey ] NEXT ENDIF @@ -206,7 +178,7 @@ FUNCTION HB_Decode(...) // Check if value exists (valtype of values MUST be same of xVal, // otherwise I will get a runtime error) // TODO: Have I to check also between different valtypes, jumping different ? - nPos := aScan( aValues, {| e | e == xVal } ) + nPos := AScan( aValues, {| e | e == xVal } ) IF nPos == 0 // Not Found, returning default xRet := xDefault // it could be also nil because not present @@ -225,50 +197,34 @@ FUNCTION HB_Decode(...) RETURN xRet -FUNCTION HB_DecodeOrEmpty(...) - LOCAL aParams := hb_aParams() +FUNCTION HB_DecodeOrEmpty( ... ) + + LOCAL aParams := hb_AParams() LOCAL xVal := hb_ExecFromArray( @hb_decode(), aParams ) + RETURN iif( xVal == NIL, EmptyValue( aParams[ 1 ] ), xVal ) STATIC FUNCTION EmptyValue( xVal ) - LOCAL xRet - LOCAL cType := ValType( xVal ) - SWITCH cType + SWITCH ValType( xVal ) CASE "C" // Char CASE "M" // Memo - xRet := "" - EXIT + RETURN "" CASE "D" // Date - xRet := hb_SToD() - EXIT + RETURN hb_SToD() CASE "L" // Logical - xRet := .F. - EXIT + RETURN .F. CASE "N" // Number - xRet := 0 - EXIT + RETURN 0 CASE "B" // code block - xRet := {|| NIL } - EXIT + RETURN {|| NIL } CASE "A" // array - xRet := {} - EXIT + RETURN {} CASE "H" // hash - xRet := { => } - EXIT + RETURN { => } CASE "U" // undefined - xRet := NIL - EXIT CASE "O" // Object - xRet := NIL // Or better another value ? - EXIT - - OTHERWISE - // Create a runtime error for new datatypes - xRet := "" - IF xRet == 0 // BANG! - ENDIF + RETURN NIL // Or better another value ? ENDSWITCH - RETURN xRet + RETURN ( "" == 0 ) // BANG! Create a runtime error for new datatypes diff --git a/harbour/contrib/xhb/tests/decode.prg b/harbour/contrib/xhb/tests/decode.prg new file mode 100644 index 0000000000..a2dc1d84de --- /dev/null +++ b/harbour/contrib/xhb/tests/decode.prg @@ -0,0 +1,80 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * hb_Decode() function test + * + * Copyright 2006 Francesco Saverio Giudice + * www - http://harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#require "xhb" + +PROCEDURE Main() + LOCAL aArray + + ? "HB_DECODE() FUNCTION TESTS" + + // Single, return empty value + ? hb_Decode( 10 ) + // A list + ? hb_Decode( 3, 1, "A", 2, "B", 3, "C" ) + // A list with default + ? hb_Decode( 4, 1, "A", 2, "B", 3, "C", "X" ) + // Using an array as list of values to check + ? hb_Decode( 2, { 1, "A", 2, "B", 3, "C" } ) + // Using an array with default as list of values to check + ? hb_Decode( 2, { 1, "A", 2, "B", 3, "C", "X" } ) + // Using an hash as list + ? hb_Decode( 2, { 1 => "A", 2 => "B", 3 => "C" } ) + + // Returning a codeblock + ? hb_CStr( hb_Decode( 2, 1, {|| 1 }, 2, {|| 2 }, 3, {|| 3 } ) ) + + // Checking an array + aArray := { 1 } + ? hb_Decode( aArray, aArray, "A", { 2 }, "B", { 3 }, "C" ) + + RETURN diff --git a/harbour/src/rdd/usrrdd/rdds/arrayrdd.prg b/harbour/src/rdd/usrrdd/rdds/arrayrdd.prg index ea644d6ec9..4d39c0f397 100644 --- a/harbour/src/rdd/usrrdd/rdds/arrayrdd.prg +++ b/harbour/src/rdd/usrrdd/rdds/arrayrdd.prg @@ -462,7 +462,7 @@ STATIC FUNCTION AR_PUTVALUE( nWA, nField, xValue ) HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, nField = %2$d, xValue = %3$s", nWA, nField, hb_ValToExp( xValue ) ) ) IF nField > 0 .AND. nField <= Len( aStruct ) .AND. ; - iif( ValType( xValue ) == "C" .AND. aStruct[ nField ][ DBS_TYPE ] == "M", .T., ValType( xValue ) == aStruct[ nField ][ DBS_TYPE ] ) + iif( HB_ISSTRING( xValue ) .AND. aStruct[ nField ][ DBS_TYPE ] == "M", .T., ValType( xValue ) == aStruct[ nField ][ DBS_TYPE ] ) xVal := PutValue( xValue, aStruct[ nField ][ DBS_TYPE ], aStruct[ nField ][ DBS_LEN ], aStruct[ nField ][ DBS_DEC ] ) @@ -1213,7 +1213,7 @@ STATIC FUNCTION AR_ORDCREATE( nWA, aOrderCreate ) nIndex := AScan( aIndexes, {| x | x[ INDEX_TAG ] == cIndex } ) IF nIndex > 0 ADel( aIndexes, nIndex ) - aIndexes[ -1 ] := aIndex + aIndexes[ Len( aIndexes ) ] := aIndex ELSE AAdd( aIndexes, aIndex ) ENDIF