Found an issue in SpiderBasic ? Please report it here !
kingwolf71
 
Posts: 21
Joined: Wed May 01, 2019 10:14 am

Possible SB bug

by kingwolf71 Sun May 03, 2020 8:07 pm

This code works fine in PureBasic
But

Code: Select all
   ;- SB BUG
   ;- the following lines are ignored
   ForEach mapIndexMap()\llIndex()
      iIndex + 1
      *p = mapIndexMap()\llIndex()
      Debug "["  +  RSet( Str(iIndex), 3 )  +  "] sText="  +  LSet( *p\sText, 21 )  +  " ["  +  Str( *p\iNum )  +  "] --> "  +  StrD( *p\dTest, 2 )
   Next


This part gets ignored in SB on the second call (afterthe deletions)
There are no errors thrown



Code: Select all
; =======================================================================
; Index Maker for Maps V3.1
; -------------------------
;
; Have you ever wanted to browse your Maps in some form of order?
; Now you can!
; IndexMap can create indexes for your Maps and you supply the sorting function (don't worry its easy!)
; Multiple indexes (as many as you like) can be added to the same Map; its important you use the same group when having mu
; group when having multiple indexes on same Map; and use DIFFERENT groups for different Maps
;
; Share and use freely
;
; Code adapted by KingLestat
; Original code author: An older version of me + scrounging
; Mar/2018
; Updated Nov/2019
;
; May/2020
; Rewrite
;
; - Discovered that my FastDel was only a FastBug!
; - Without groups, when deleting an element it would remain in other indexes
; - New FastDel which actually work (uses a hefty amount of RAM)
; - Uses maps and linked lists (Arrays, Bye Bye!)
;
; =======================================================================

DeclareModule IndexMap
   
    Prototype           CompareFN( *e1, *e2 )
   
    Declare             ndxmapCreateIndex( IndexName.s, GroupName.s, fnCompare.CompareFN, SplitSize = 0, FastDel = 0 )
    Declare             ndxmapAdd( *p )
    Declare             ndxmapDelete( GroupName.s, *p )

    EnableExplicit

   ; ======================================================================================================
   ;- Public Constants
   ; ======================================================================================================
   CompilerIf Not Defined( PB_Compiler_Unicode, #PB_Constant )
      #PB_Compiler_Unicode       = #True
      #PB_Compiler_Thread        = #True
      #SB_Compiler_SpiderBasic   = 230
   CompilerEndIf

   Enumeration
      #NDXMAP_RESET        = 0
      #NDXMAP_FIRST        = 1
      #NDXMAP_LAST         = 2
      #NDXMAP_PREV         = 3
      #NDXMAP_NEXT         = 4
      #NDXMAP_SIZE         = 5
      #NDXMAP_SETSPLIT     = 6
   EndEnumeration
   
   #NDXMAP_STANDARD        = 16033
   #NDXMAP_MEDIUM          = 34157
   #NDXMAP_LARGE           = 68891
   #NDXMAP_SMALL           = 757
   #NDXMAP_MINSPLIT        = 40
   
   CompilerIf Not Defined( NDX_PRIME, #PB_Constant )
      #NDX_PRIME           = #NDXMAP_SMALL
   CompilerEndIf

; ======================================================================================================
;- Public Structures
; ======================================================================================================

   Structure stIndexDetails
      Name.s
      Group.s
      SplitSize.l
      nCount.l
      fnCompare.CompareFN
      ; relative position pointers to make insertion sort faster
      *first
      *last
      List *llMid()
      List *llIndex()
   EndStructure
   
   ; Cost of doing business with fast deletions
   Structure stDelete
      nCount.l
      nFastDel.l
      SplitSize.l
      *last
      Map   *mapDel(#NDX_PRIME)
      List  *llDelete()
      List  *pMid()
   EndStructure

; ======================================================================================================
;- Public Macros
; ======================================================================================================
   
   Macro                ndxmapChangeIndex( indexname )
      FindMapElement( mapIndexMap(), indexname )
   EndMacro
   
   Macro                ndxmapChange( newpos, value )
      Select newpos
         Case #NDXMAP_RESET
            ResetList( mapIndexMap()\llIndex() )
           
         Case #NDXMAP_FIRST
            FirstElement( mapIndexMap()\llIndex() )
            value = mapIndexMap()\llIndex()
           
         Case #NDXMAP_LAST
            LastElement( mapIndexMap()\llIndex() )
            value = mapIndexMap()\llIndex()
           
         Case #NDXMAP_NEXT
            NextElement( mapIndexMap()\llIndex() )
            value = mapIndexMap()\llIndex()
           
         Case #NDXMAP_PREV
            PreviousElement( mapIndexMap()\llIndex() )
            value = mapIndexMap()\llIndex()
         
         Case #NDXMAP_SIZE   
            ListSize( mapIndexMap()\llIndex() )
            value = mapIndexMap()\llIndex()
           
         Case #NDX_SETSPLIT
            mapInsexMap()\SplitSize = value
           
      EndSelect
   EndMacro
   
   ; =====================================================================================
   ;- Public Globals
   ; =====================================================================================
     
   Global NewMap        mapIndexMap.stIndexDetails(127)
   Global NewMap        mapGroups.stDelete(63)
     
EndDeclareModule

Module IndexMap
   
   ; =====================================================================================
   ;- Private Macros
   ; =====================================================================================
   
   Macro                _intLoopForPosition()
      i = 1
     
      While NextElement( mapIndexMap()\llIndex() )
                 
         If Not (i % mapIndexMap()\SplitSize)
            AddElement( mapIndexMap()\llMid() )
            mapIndexMap()\llMid() = @mapIndexMap()\llIndex()
         EndIf
         
         If mapIndexMap()\fnCompare( *p, mapIndexMap()\llIndex() ) <= 0
            InsertElement( mapIndexMap()\llIndex() )
            mapIndexMap()\llIndex() = *p
            Break
         EndIf
         
         i + 1
      Wend
   EndMacro
   
   Macro                _intAddDelElement(modifier)
      If mapGroups()\nCount < mapIndexMap()\nCount
         CompilerIf modifier
            mapGroups()\last = AddElement( mapGroups()\llDelete() )
         CompilerElse
            InsertElement( mapGroups()\llDelete() )
         CompilerEndIf
         mapGroups()\llDelete() = *p
         mapGroups()\nCount + 1
         
         If Not (mapGroups()\nCount % mapGroups()\SplitSize)
            AddElement( mapGroups()\pMid() )
            mapGroups()\pMid() = @mapGroups()\llDelete()
         EndIf
      EndIf
     
      AddMapElement( mapGroups()\mapDel(), mapIndexMap()\name + "|" + Str( *p ), #PB_Map_NoElementCheck )
      mapGroups()\mapDel() = @mapIndexMap()\llIndex()
   EndMacro
   
   Macro                _intDeleteIndexes()
      ForEach mapIndexMap()
         If mapIndexMap()\Group = group
            If FindMapElement( mapGroups()\mapDel(), mapIndexMap()\Name + "|" + Str(*p) )
               ChangeCurrentElement( mapIndexMap()\llIndex(), mapGroups()\mapDel() )
               DeleteElement( mapIndexMap()\llIndex() )
               
               ;Debug ">> DEL NDX " + MapIndexMap()\name
               flag + 1
            EndIf
         EndIf
      Next
     
      DeleteElement( mapGroups()\llDelete() )
   EndMacro
   
   ; =====================================================================================
   ;- Module Functions
   ; =====================================================================================
   ; IndexName - A unique name to identify index
   ; GroupName - Used in deletion; when creating multiple indexes for same map, all keys for all indexes are deleted
   ; fnCompare - A Procedure which takes 2 elements of the types you want to keep sorted
   ; SpliSize  - This keeps a pointer every [SplitSize] elements to make searching faster ( 1 << Search << (DataSet / SplitSize + ~ ) + SplitSize + 1 )
   ; FastDel   - This allows for fast deletions; useful withg large datasets (at a cost of extra overhead when adding + memort consumption )

   Procedure            ndxmapCreateIndex( IndexName.s, GroupName.s, fnCompare.CompareFN, SplitSize = 0, FastDel = 0 )
      Protected         szGroup.s = LCase( GroupName )
     
      If FindMapElement( mapIndexMap(), IndexName )
         ProcedureReturn -1
      EndIf
     
      If SplitSize <= 0  : SplitSize = 2147483646 : EndIf
      If SplitSize < #NDXMAP_MINSPLIT  : SplitSize = #NDXMAP_MINSPLIT : EndIf
      If FastDel < 0     : FastDel   = 0  : EndIf
     
      AddMapElement( mapIndexMap(), IndexName )
      With mapIndexMap()
         \fnCompare     = fnCompare
         \Name          = IndexName
         \Group         = szGroup
         \SplitSize     = SplitSize
      EndWith

      If Not FindMapElement( mapGroups(), szGroup )
         AddMapElement( mapGroups(), szGroup, #PB_Map_NoElementCheck )
         mapGroups()\nFastDel    = FastDel
         mapGroups()\SplitSize   = SplitSize
      ElseIf FastDel
         mapGroups()\nFastDel = FastDel
         
         If SplitSize > mapGroups()\SplitSize
            mapGroups()\SplitSize = SplitSize
         EndIf
      EndIf
     
      AddMapElement( mapGroups()\mapDel(),IndexName , #PB_Map_NoElementCheck )

   EndProcedure
   
   Procedure            ndxmapAdd( *p )
      Protected         Mid, Size, i
      Protected         res, flag
      Protected         *ptr
     
      ;Debug "[" + MapKey( mapIndexMap() ) + "]"
      size = ListSize( mapIndexMap()\llIndex() )
     
      If Not size
         mapIndexMap()\first = AddElement( mapIndexMap()\llIndex() )
         mapIndexMap()\llIndex() = *p
      ElseIf size = 1
         ChangeCurrentElement( mapIndexMap()\llIndex(), mapIndexMap()\first )
         res = mapIndexMap()\fnCompare( *p, mapIndexMap()\llIndex() )
         
         If res < 0
            mapIndexMap()\last      = mapIndexMap()\first
            mapIndexMap()\first     = InsertElement( mapIndexMap()\llIndex() )
            mapIndexMap()\llIndex() = *p
         Else
            mapIndexMap()\last      = AddElement( mapIndexMap()\llIndex() )
            mapIndexMap()\llIndex() = *p
         EndIf
      Else
         ChangeCurrentElement( mapIndexMap()\llIndex(), mapIndexMap()\first )
         res = mapIndexMap()\fnCompare( *p, mapIndexMap()\llIndex() )
         
         If res <= 0
            mapIndexMap()\first     = InsertElement( mapIndexMap()\llIndex() )
            mapIndexMap()\llIndex() = *p
         Else
            ChangeCurrentElement( mapIndexMap()\llIndex(), mapIndexMap()\last )
            res = mapIndexMap()\fnCompare( *p, mapIndexMap()\llIndex() )
         
            If res >= 0
               mapIndexMap()\last      = AddElement( mapIndexMap()\llIndex() )
               mapIndexMap()\llIndex() = *p
            ElseIf ListSize( mapIndexMap()\llMid() ) > 0    ; This is the clever bit
               *ptr = mapIndexMap()\first                   ; We check our new entry against the checkpoint so we only brute force search in the correct block
               flag = 0
               
               ForEach mapIndexMap()\llMid()
                  ChangeCurrentElement( mapIndexMap()\llIndex(), mapIndexMap()\llMid() )
                  res = mapIndexMap()\fnCompare( *p, mapIndexMap()\llIndex() )
                 
                  If res <= 0
                     Repeat
                        PreviousElement( mapIndexMap()\llIndex() )
                        res = mapIndexMap()\fnCompare( *p, mapIndexMap()\llIndex() )
                       
                        If res >= 0
                           AddElement( mapIndexMap()\llIndex() )
                           mapIndexMap()\llIndex() = *p
                           flag = 1
                           Break
                        EndIf

                     Until mapIndexMap()\llIndex() = *ptr
                  EndIf
                 
                  If flag : Break : EndIf
                  *ptr = mapIndexMap()\llMid()
               Next
               
               If Not flag
                  _intLoopForPosition()
               EndIf
            Else
               ChangeCurrentElement( mapIndexMap()\llIndex(), mapIndexMap()\first )
               _intLoopForPosition()
            EndIf
         EndIf
      EndIf
     
      mapIndexMap()\nCount + 1
     
      If FindMapElement( mapGroups(), mapIndexMap()\Group )
         If mapGroups()\nFastDel
            If FindMapElement( mapGroups()\mapDel(), mapIndexMap()\Name )
               If Not mapGroups()\nCount
                  _intAddDelElement(1)
                  AddElement( mapGroups()\pMid() )
                  mapGroups()\pMid() = @mapGroups()\llDelete()
               Else
                  ChangeCurrentElement( mapGroups()\llDelete(), mapGroups()\last )
                  flag = 0
                 
                  If *p > mapGroups()\llDelete()
                     While NextElement( mapGroups()\llDelete() )
                        If *p <= mapGroups()\llDelete()
                           _intAddDelElement(0)
                           flag = 1
                           Break
                        EndIf
                     Wend
                     
                     If Not flag
                        _intAddDelElement(1)
                     EndIf
                  Else
                     While PreviousElement( mapGroups()\llDelete() )
                        If *p >= mapGroups()\llDelete()
                           _intAddDelElement(1)
                           flag = 1
                           Break
                        EndIf
                     Wend
                     
                     If Not flag
                        _intAddDelElement(0)
                     EndIf
                  EndIf
               EndIf
           
            EndIf
            ;Debug "#Check: " + Str(ListSize(mapIndexMap()\llIndex())) + " , " + Str(ListSize(mapGroups()\llDelete()))
         EndIf
      EndIf
   EndProcedure
   
   Procedure            ndxmapDelete( group.s, *p )
      Protected         *ptr, flag

      group = LCase(group)
     
      If FindMapElement( mapGroups(), group )
         If mapGroups()\nFastDel
            flag = 0
           
            ForEach mapGroups()\pMid()
               ChangeCurrentElement( mapGroups()\llDelete(), mapGroups()\pMid() )
         
               If *p = mapGroups()\llDelete()
                  _intDeleteIndexes()
                  Break
               ElseIf *p < mapGroups()\pMid()
                  ChangeCurrentElement( mapGroups()\llDelete(), mapGroups()\pMid() )
                 
                  Repeat
                     If PreviousElement( mapGroups()\llDelete() )
                        If *p = mapGroups()\llDelete()
                           _intDeleteIndexes()
                           Break
                        EndIf
                     Else
                        Break
                     EndIf
                  Until mapGroups()\llDelete() = *ptr
               EndIf
               
               If flag : Break : EndIf
               *ptr = mapGroups()\pMid()
            Next
         
            If Not flag
               ;Debug "-- Checkpoints --"
           
               While NextElement( mapGroups()\llDelete() )
                  If *p = mapGroups()\llDelete()
                     _intDeleteIndexes()
                     Break
                  EndIf
               Wend
               
               If Not flag
                  ;Debug "-- Checkpoints 2 --"
               
                  ForEach mapGroups()\llDelete()
                     If *p = mapGroups()\llDelete()
                     _intDeleteIndexes()
                     Break
                  EndIf
                  Next
               EndIf
            EndIf
         Else
            ;No FatsDel? Brute force search for all indexes...boring!
            ForEach mapIndexMap()
               If mapIndexMap()\Group = group
                  ForEach mapIndexMap()\llIndex()
                     If *p = mapIndexMap()\llIndex()
                        DeleteElement( mapIndexMap()\llIndex() )
                        Break
                     EndIf
                  Next
               EndIf
            Next
         EndIf
      Else
         ProcedureReturn -1
      EndIf

   EndProcedure
   
   ; ======================================================================================================
   ;- Internal Functions
   ; ======================================================================================================

EndModule

; ======================================================================================================
;- End Index Module
; ======================================================================================================

CompilerIf #PB_Compiler_IsMainFile

   CompilerIf #PB_Compiler_Debugger = #False
      MessageRequester( "Error",  "Switch Debugger on to see the demo.", #PB_MessageRequester_Error )
      End
   CompilerEndIf

; -----------------------
; Test Code
; -----------------------

#MaxSize = 20

UseModule   IndexMap

Structure stTest
   sText.s
   iNum.q
   dTest.d
EndStructure

;Global            gszBuild.s     = "0123456789"
Global            gszBuild.s     = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Global            gLimit

RandomSeed(1971)


Macro             ListData( indexname, extra )

   Debug "==[ " + indexname + extra + " ]===================================="
   ndxmapChangeIndex( indexname )
   iIndex = 0
   
   ;- SB BUG
   ;- the following lines are ignored
   ForEach mapIndexMap()\llIndex()
      iIndex + 1
      *p = mapIndexMap()\llIndex()
      Debug "["  +  RSet( Str(iIndex), 3 )  +  "] sText="  +  LSet( *p\sText, 21 )  +  " ["  +  Str( *p\iNum )  +  "] --> "  +  StrD( *p\dTest, 2 )
   Next
   
   Debug "Size: " + Str( ListSize( mapIndexMap()\llIndex() ) )
   
EndMacro

Procedure.s       CreateRandomData( Size )

  Protected       i, j
  Protected       code.s
 
  For i = 1 To Size
    j = Random ( gLimit ) + 1
    code + Mid ( gszBuild, j, 1 )
  Next i
 
  ProcedureReturn code
 
EndProcedure     

Procedure         CompareDouble( *p1.stTest, *p2.stTest )
     
   If *p1\dTest < *p2\dTest
      ProcedureReturn -1
   ElseIf *p1\dTest > *p2\dTest
      ProcedureReturn 1
   EndIf   
   
   ProcedureReturn 0
EndProcedure

Procedure         CompareString( *p1.stTest, *p2.stTest )
   
   s1.s = LCase( *p1\sText )
   s2.s = LCase( *p2\sText )
   
   If s1 < s2
      ProcedureReturn -1
   ElseIf s1 > s2
      ProcedureReturn 1
   EndIf   
   
   ProcedureReturn 0
EndProcedure

   Global NewMap mapTest.stTest(#MaxSize)
   
   Define *ptr, *p.stTest,  iIndex.i, sTookString.s
   Define i, j, szText.s

   gLimit = Len( gszBuild )
   ndxmapCreateIndex( "DoubleFull", "test", @CompareDouble(), 13, 1 )
   ndxmapCreateIndex( "String", "test", @CompareString(), 12, 1 )
   ndxmapCreateIndex( "Alternate", "test", @CompareString() )  ; Only 50% of the dataset used
   
   Debug "==[As Created]===================================="
   
   For iIndex  =  0 To #MaxSize - 1
      *ptr  =  AddMapElement( mapTest(), "Key-"  +  Str(iIndex + 1) )
     
      j = Random(20, 6)
      sztext = LSet( CreateRandomData( j ), 20 )
      mapTest()\sText   = szText
      mapTest()\iNum    =  Random( 9999999, 100 )
      mapTest()\dTest   = Random(10000, 10)  /  Random(1000, 100)   
     
      Debug "["  +  Str(iIndex)  +  "] Text="  +  LSet( mapTest()\sText, 21 )  +  " ["  +  Str( mapTest()\iNum )  +  "] --> "  +  StrD( mapTest()\dTest, 2 )
     
      ndxmapChangeIndex( "DoubleFull" )
      ndxmapAdd( *ptr )
     
      ndxmapChangeIndex( "String" )
      ndxmapAdd( *ptr )
     
      If Mod( iIndex + 1, 2 )
         ndxmapChangeIndex( "Alternate" )
         ndxmapAdd( *ptr )
      EndIf
   Next
   
   
   ListData( "DoubleFull", "" )
   ListData( "String", "" )
   ListData( "Alternate", "" )
 
   Debug "==[Deleting some entries]===================================="
 
   iIndex = 1
   j = 0
   
   ForEach mapTest()
      If Mod( iIndex, Random(7,4) ) = 0
         j + 1
         ndxmapDelete( "test", @mapTest() )
         
         Debug "DEL->" + RSet( Str( iIndex ), 2  ) + "  " + LSet( mapTest()\sText, 21 )  +  StrD( mapTest()\dTest, 2 )
         DeleteMapElement( mapTest() )
      EndIf   
      iIndex + 1
   Next
   
   Debug ""
   Debug "Total deleted: " + Str(j)
   Debug ""
   
   ListData( "Alternate", " (Deleted)" )
   ListData( "DoubleFull", " (Deleted)" )
   ListData( "String", " (Deleted)" )
   
CompilerEndIf
Fred
Site Admin
 
Posts: 1298
Joined: Mon Feb 24, 2014 10:51 am

Re: Possible SB bug

by Fred Mon May 18, 2020 7:28 am

Moved for investigation
Return to Bugs Reports

Who is online

Users browsing this forum: No registered users and 3 guests