HB_Decode() function Bugs

[nageswaragunupudi]

HB_DeCode(...) function has the same functionality of Oracle PL/SQL's Decode(...) function and even more. This is a quite useful function but, unfortunately, this function is quite buggy. Interestingly, both Harbour and xHarbour versions have the same bugs.

This is the documentation of HB_Decode(...) function:

Code: Select all  Expand view

HB_Decode( <xInitVal>, <xCase1>, <xRet1> , ;
                      [<xCaseN>, <xRetN>], ;
                      [<xDefault>]         ) --> xReturn

or

HB_Decode( <xInitVal>, <hHash>, [<xDefault>] ) --> xReturn
 

But even the sample given in the documentations fails and results in runtime error:

Code: Select all  Expand view

#include 'fivewin.ch'

PROCEDURE Main
      LOCAL nChoice, hHash := {=>}


      hHash := { 0 =>  "Yesterday", ;
                 1 =>  "Today"    , ;
                 2 =>  "Tomorrow"   }

      nChoice := 0
      ? HB_Decode( nChoice, hHash, "Never" )  // result: Yesterday

      nChoice := 3
      ? HB_Decode( nChoice, hHash, "Never" )  // result: Never

   RETURN
 

Error:

Code: Select all  Expand view

Application
===========
   Path and name: C:\tests\fwh905\Bin\dcodtest.Exe (32 bits)
   Size: 1,541,632 bytes
   Time from start: 0 hours 0 mins 0 secs
   Error occurred at: 09/22/10, 10:57:34
   Error description: Error BASE/1070  Argument error: ==
   Args:
     [   1] = H   {=>}
     [   2] = N   0

Stack Calls
===========
   Called from: source\rtl\decode.prg => (b)HB_DECODE(214)
   Called from:  => ASCAN(0)
   Called from: source\rtl\decode.prg => HB_DECODE(214)
   Called from: Source\dcodtest.prg => MAIN(13)
 

[nageswaragunupudi]

Another example using hash:

Code: Select all  Expand view

#include 'fivewin.ch'

PROCEDURE Main
      LOCAL nChoice, hHash := {=>}


      hHash := { 0 =>  "Yesterday", ;
                 'NOW' =>  "Today"    , ;
                 2 =>  "Tomorrow"   }

      nChoice := 0
      ? HB_Decode( nChoice, hHash )  // --> yesterday  // succeeds

      nChoice := 'NOW'
      ? HB_Decode( nChoice, hHash )  // runtime error


   RETURN
 

[nageswaragunupudi]

Another example, with different datatypes in the search list.

Code: Select all  Expand view

#include 'fivewin.ch'

PROCEDURE Main

   local xVal := 'ONE'

   ? HB_Decode( xVal, 1, 'NUMBER', 'ONE', 'CHARACTER', 'NONE' ) // runtime error

   RETURN
 

[nageswaragunupudi]

It also fails when the return values are arrays:

Code: Select all  Expand view

#include 'fivewin.ch'

PROCEDURE Main

   local xVal := 'RED'
   local xRet

   xRet := HB_Decode( xVal, 'BLACK', { CLR_BLACK, CLR_WHITE }, 'RED', { CLR_RED, CLR_WHITE} , { CLR_BLUE,CLR_WHITE} )
   msginfo( valtype( xret ) )

   RETURN
 

[nageswaragunupudi]

Here is a suggested replacement till (x)Harbour teams fix the bugs.

Code: Select all  Expand view

function my_decode(...)

   local xDefault, xVal, xRet, n
   local aSearch  := HB_aParams()
   local nLen     := Len( aSearch )

   if nLen == 1 .and. ValType( aSearch[ 1 ] ) == 'A' .and. Len( aSearch[ 1 ] ) > 0
      aSearch     := aSearch[ 1 ]
      nLen        := Len( aSearch[ 1 ] )
   endif

   if nLen > 1

      xVal     := aSearch[ 1 ]
      aSearch  := ADel( aSearch, 1, .t. )
      nLen--

      if nLen <= 2
         if ValType( aSearch[ 1 ] ) $ 'AH'
            if nLen == 2
               xDefault := aSearch[ 2 ]
            endif
            aSearch     := aSearch[ 1 ]
            nLen        := Len( aSearch )
         elseif nLen == 1
            xDefault    := aSearch[ 1 ]
            nLen        := 0
         endif
      else
         if nLen % 2 == 1
            xDefault    := aSearch[ nLen ]
            nLen--
         endif
      endif
      if ValType( aSearch ) == 'H'
         if HHasKey( aSearch, xVal )
            xRet     := aSearch[ xVal ]
         endif
      elseif nLen > 1
         nLen--
         for n := 1 to nLen step 2
            if ValType( xVal ) == ValType( aSearch[ n ] ) .and. ;
                  aSearch[ n ] == xVal

               xRet     := aSearch[ n + 1 ]
               exit
            endif
         next n
      endif
   endif

return IfNil( xRet, xDefault )