PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

[PB 4.02] Xor

https://www.purebasic.fr/french/viewtopic.php?t=6176

Page 1 sur 1

[PB 4.02] Xor

Publié : dim. 31/déc./2006 12:23
par Dr. Dri
Dans la fonction GetTreeGadgetString (je sais ca fait beaucoup de code) si on décomente le petit bout de code avec le Xor le programme fait un invalid memory access.

En m'aidant du debugger j'ai pu voir que la variable 'Item' est remise à zéro et donc on a une boucle infinie qui augmente la taille de la chaîne 'String' jusqu'à pu possible.

Code : Tout sélectionner

EnableExplicit

Structure Node
  Element.s
  nNodes.l
  *Superior.Node
  *Siblings.Node
  *Children.Node
EndStructure

Structure Tree
  *Current.Node
EndStructure

Procedure.l NewTree()
  ProcedureReturn AllocateMemory( SizeOf(Tree) )
EndProcedure

Procedure.l IsEmpty(*Tree.Tree)
  ProcedureReturn (Not *Tree\Current)
EndProcedure

Procedure.l IsRoot(*Tree.Tree)
  Protected *Root.Node
 
  *Root = *Tree\Current
 
  If *Root And *Root\Superior
    *Root = #Null
  EndIf
 
  ProcedureReturn *Root
EndProcedure

Procedure.l GetRoot(*Tree.Tree)
  Protected *Root.Node
 
  *Root = *Tree\Current
 
  If *Root
    While *Root\Superior
      *Root = *Root\Superior
    Wend
  EndIf
 
  ProcedureReturn *Root
EndProcedure

Procedure.l AddNode(*Tree.Tree)
  Protected *Node.Node
 
  *Node = AllocateMemory( SizeOf(Node) )
 
  If *Tree\Current
    *Tree\Current\nNodes  + 1
   
    If *Tree\Current\Children
      *Tree\Current = *Tree\Current\Children
      While *Tree\Current\Siblings
        *Tree\Current = *Tree\Current\Siblings
      Wend
      *Tree\Current\Siblings = *Node
      *Tree\Current = *Tree\Current\Superior
    Else
      *Tree\Current\Children = *Node
    EndIf
  EndIf
 
  If *Node
    *Node\Superior  = *Tree\Current
    *Tree\Current = *Node
  EndIf
 
  ProcedureReturn *Node
EndProcedure

Procedure.l InsertNode(*Tree.Tree)
  Protected *Node.Node
 
  *Node = AllocateMemory( SizeOf(Node) )
 
  If *Tree\Current
    *Tree\Current\nNodes  + 1
   
    If *Tree\Current\Children
      *Tree = *Tree\Current\Children
      *Node\Siblings = *Tree\Current
      *Tree\Current = *Tree\Current\Superior
      *Tree\Current\Children = *Node
    Else
      *Tree\Current\Children = *Node
    EndIf
  EndIf
 
  If *Node
    *Node\Superior  = *Tree\Current
    *Tree\Current = *Node
  EndIf
 
  ProcedureReturn *Node
EndProcedure

Procedure.l FreeNode(*Node.Node)
  Protected Free.l = #True, *Temp.Node
 
  If *Node
    Free  & FreeNode(*Node\Children)
    *Temp = *Node
    *Node = *Node\Siblings
    Free  & FreeMemory(*Temp)
   
    While *Node
      Free  & FreeNode(*Node\Children)
      *Temp = *Node
      *Node = *Node\Siblings
      Free  & FreeMemory(*Temp)
    Wend
  EndIf
 
  ProcedureReturn Free
EndProcedure

Procedure.l ClearTree(*Tree.Tree)
  ProcedureReturn FreeNode( GetRoot(*Tree) )
EndProcedure

Procedure.l FreeTree(*Tree.Tree)
  ProcedureReturn FreeNode( GetRoot(*Tree) ) & FreeMemory(*Tree)
EndProcedure

;-------------------------------------------------------------------------------

Procedure.l IsTreeString(String.s)
  Protected Valid.l
 
  If Left(String, 1) = "{" And Right(String, 1) = "}"
    If CountString(String, "{") = CountString(String, "}")
      If Not FindString(String, "{}", 1) ;pas d'élément vide
        Valid = #True
      EndIf
    EndIf
  EndIf
 
  ProcedureReturn Valid
EndProcedure

Procedure.l ParseTreeString(*Tree.Tree, String.s)
  Protected c.s, i.l = 1
 
  If IsTreeString(String)
    While i < Len(String)
      c = Mid(String, i, 1)
     
      Select c
        Case "{"
          AddNode(*Tree)
        Case "}"
          *Tree\Current = *Tree\Current\Superior
        Default
          *Tree\Current\Element + c
      EndSelect
     
      i + 1
    Wend
  EndIf
 
  ProcedureReturn *Tree
EndProcedure

Procedure.l GetNodeValue(*Node.Node)
  Protected Value.l
 
  If *Node
    Select Asc(*Node\Element)
      Case '('
        Value = GetNodeValue(*Node\Children)
      Case '+'
        If *Node\Children\Siblings
          Value = GetNodeValue(*Node\Children\Siblings) + GetNodeValue(*Node\Children)
        Else
          Value = GetNodeValue(*Node\Children)
        EndIf
      Case '-'
        If *Node\Children\Siblings
          Value = GetNodeValue(*Node\Children) - GetNodeValue(*Node\Children\Siblings)
        Else
          Value = - GetNodeValue(*Node\Children)
        EndIf
      Case '*'
        Value = GetNodeValue(*Node\Children) * GetNodeValue(*Node\Children\Siblings)
      Case '/'
        Value = GetNodeValue(*Node\Children) / GetNodeValue(*Node\Children\Siblings)
      Default
        Value = Val(*Node\Element)
    EndSelect
  EndIf
 
  ProcedureReturn Value
EndProcedure

Procedure.l GetTreeValue(*Tree.Tree)
  ProcedureReturn GetNodeValue( GetRoot(*Tree) )
EndProcedure

Procedure.s GetNodeString(*Node.Node)
  Protected String.s
 
  If *Node
    If *Node\Element = "("
      String = "(" + GetNodeString(*Node\Children) + ")"
    Else
      If *Node\Children And *Node\Children\Siblings
        String = GetNodeString(*Node\Children)
        String + *Node\Element
        String + GetNodeString(*Node\Children\Siblings)
      Else
        String + *Node\Element
        String + GetNodeString(*Node\Children)
      EndIf
    EndIf
  EndIf
 
  ProcedureReturn String
EndProcedure

Procedure.s GetTreeString(*Tree.Tree)
  ProcedureReturn GetNodeString( GetRoot(*Tree) )
EndProcedure

Define Expression.l, TreeString.s

TreeString = "{+{3}{({*{5}{*{({-{/{*{*{({-{12}}}{6}}{8}}{4}}{/{/{*{/{4}{2}}{6}}{3}}{2}}}}{7}}}}}"

Expression = NewTree()

ParseTreeString(Expression, TreeString)

;-------------------------------------------------------------------------------

Procedure.l AddTreeGadgetNode(Gadget.l, *Node.Node, Depth.l)
 
  If *Node
    AddGadgetItem(Gadget, #PB_Default, *Node\Element, #Null, Depth)
    AddTreeGadgetNode(Gadget, *Node\Children, Depth + 1)
   
    *Node = *Node\Siblings
   
    While *Node
      AddGadgetItem(Gadget, #PB_Default, *Node\Element, #Null, Depth)
      AddTreeGadgetNode(Gadget, *Node\Children, Depth + 1)
      *Node = *Node\Siblings
    Wend
  EndIf
 
EndProcedure

Procedure.l SetTreeGadgetTree(Gadget.l, *Tree.Tree)
  ClearGadgetItemList(Gadget)
  AddTreeGadgetNode(Gadget, GetRoot(*Tree), 0)
EndProcedure

Procedure.s GetTreeGadgetString(Gadget.l)
  Protected String.s, Count.l
  Protected Item.l, Level.l, NextLevel.l
  
  Count = CountGadgetItems(Gadget)
  
  If Count
    String = ""
    
    While Item < Count
      NextLevel = GetGadgetItemAttribute(Gadget, Item+1, #PB_Tree_SubLevel)
      
;       If Level = 0 XOr Item = 0
;         ;L'arbre a plusieurs racines !
;         String = ""
;         Break
;       EndIf
      
      String + "{" + GetGadgetItemText(Gadget, Item, #PB_Default)
      
      While Level >= NextLevel
        String + "}"
        Level - 1
      Wend
      
      Level = NextLevel
      Item + 1
    Wend
  EndIf
  
  ProcedureReturn String
EndProcedure

;-------------------------------------------------------------------------------

DisableExplicit

If OpenWindow(0, 0, 0, 350, 180, "TreeGadget")
  CreateGadgetList(WindowID(0))
  
  TreeGadget(0, 10, 10, 330, 160)
  SetTreeGadgetTree(0, Expression)
  
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
  
  Debug GetTreeGadgetString(0)
  Debug TreeString
EndIf
Dri

Publié : dim. 31/déc./2006 13:52
par Flype
http://www.purebasic.fr/english/viewtop ... xor#174594

Publié : dim. 31/déc./2006 14:17
par Dr. Dri
C'est pas une histoire de syntaxe avec de l'asm (mon code est 100% PB)

Dri

Publié : sam. 17/févr./2007 10:32
par linkerstorm
Salut Dri.

Après des tests poussés, je confirme le bug du XOr logique.
Si Fred n'a pas sorti de patch et si tu n'as pas encore trouvé de solution, voici le code que je te propose :

Code : Tout sélectionner

Procedure.s GetTreeGadgetString(Gadget.l)
  Protected String.s, Count.l
  Protected Item.l, Level.l, NextLevel.l
  Protected TestLevel.b, TestItem.b
  
  Count = CountGadgetItems(Gadget)
 
  If Count
    String = ""
   
    While Item < Count
      NextLevel = GetGadgetItemAttribute(Gadget, Item+1, #PB_Tree_SubLevel)
     
      ;If Level = 0 XOr Item = 0 ; Ce test est remplacé par les 3 lignes qui suivent
      If Level = 0 : TestLevel = 1 : Else : TestLevel = 0 : EndIf
      If Item  = 0 : TestItem  = 1 : Else : TestItem  = 0 : EndIf
      If TestLevel ! TestItem ; On utilise le XOR binaire
        ;L'arbre a plusieurs racines !
        String = ""
        Break
      EndIf
     
      String + "{" + GetGadgetItemText(Gadget, Item, #PB_Default)
     
      While Level >= NextLevel
        String + "}"
        Level - 1
      Wend
     
      Level = NextLevel
      Item + 1
    Wend
  EndIf
 
  ProcedureReturn String
EndProcedure
Plus tard, je détaillerai ici et en assembleur (ça sera surtout pour Fred) la mécanique du bug, à moins qu'un correctif soit sorti d'ici là.

linkerstorm

Publié : sam. 17/févr./2007 10:37
par Backup
je vous encourage a en parler sur le forum anglais, parceque Fred y passe plus de temps, me semble t'il :D

Publié : sam. 17/févr./2007 12:08
par Dr. Dri
@linkerstorm
sur le fond le code n'est pas bon, ca faisait parti de mes différents essais et j'ai pu isoler le bug... mais je te remercie quand même ^_^

Dri

Publié : dim. 18/févr./2007 11:55
par linkerstorm
Dri>
Ok, je savais pas (suis nouveau sur le forum) ;)

Dobro>
Ok pour le forum (officiel) anglais, bien que mon anglais ne soit pas au top :roll:

Par contre, sur ce même forum anglais, j'ai lu quelque part que Fred passait bcp moins de temps sur PB à cause de son nouveau job.

L'un d'entre vous peut me confirmer ? :?:

Merci.

linkerstorm
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru