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

2012-10-12 15:06 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* 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
This commit is contained in:
Viktor Szakats
2012-10-12 13:11:11 +00:00
parent 78ea6a4c10
commit 59c120f623
6 changed files with 128 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
harbour/ChangeLog
View File

@@ -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

4
harbour/contrib/hbgd/gdbarcod.prg
View File

@@ -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

4
harbour/contrib/xhb/cstruct.prg
View File

@@ -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++

96
harbour/contrib/xhb/decode.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Decode function
* hb_Decode() function
*
* Copyright 2006 Francesco Saverio Giudice <info / at / fsgiudice / dot / com>
* 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( <var>, [ <case1,ret1 [,...,caseN,retN] ] [, <def> ]> ) ---> <xRet>
* 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

80
harbour/contrib/xhb/tests/decode.prg Normal file
View File

@@ -0,0 +1,80 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* hb_Decode() function test
*
* Copyright 2006 Francesco Saverio Giudice <info / at / fsgiudice / dot / com>
* 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

4
harbour/src/rdd/usrrdd/rdds/arrayrdd.prg
View File

@@ -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