Variable Checking

Just starting out? Need help? Post your questions and find answers here.
Post Reply
SniffTheGlove
Enthusiast
Enthusiast
Posts: 122
Joined: Sat Nov 19, 2011 6:51 pm

Variable Checking

Post by SniffTheGlove »

Hi All,

A long time ago (a few years) another PB user posted this code. It checks a pb file for used variables and declared unused variables in procedures etc.

Having spent a while searching here for it I can not find it, I was checking to see if there had been an update to it recently as currently it does not work any longer and I can not find the reason why.

So I am posting the code to see if anyone else can fix it to run with the latest version of PB.

Also, if anyone who has a old copy of PB hanging around that is installed on their system, could you compile

Code: Select all

EnableExplicit

#maxVars = 1000

#var_use_noUse     = %00000000000000
#var_use_anyUse    = %00000000000001
#var_use_argument  = %00000000000010
#var_use_calculate = %00000000000100
#var_use_compare   = %00000000001000
#var_use_storeVal  = %00000000010000
#var_spc_Return    = %00000000100000
#var_spc_For       = %00000001000000
#var_spc_ForEach   = %00000010000000
#var_spc_While     = %00000100000000
#var_spc_Repeat    = %00001000000000
#var_spc_Select    = %00010000000000
#var_spc_GoSub     = %00100000000000
#var_spc_GoTo      = %01000000000000
#var_spc_If        = %10000000000000

Structure varstructure
  
  varName.s
  varUsable.l
  varChecked.l
  varType.l
  varDecType.s
  varLine.l
  
  varParent.l
  varParentID.l
  
EndStructure
Structure procstructure
  
  procName.s
  procStart.l
  procEnd.l
  procStartLine.l
  procEndLine.l
  procUsable.l
  procChecked.l
  procVarCount.l
  procVars.varstructure[#maxVars]
  
EndStructure
Structure codestructure
  code.s
  line.l
EndStructure

Global Dim code.codestructure(0)
Global Dim proc.procstructure(0)
Global proc_size.l
Global Commands_size = 4
Global Dim Commands.s(Commands_size)

Commands(0) = "Global "
Commands(1) = "Define "
Commands(2) = "Protected "
Commands(3) = "Shared "
Commands(4) = "Static "

Procedure.l AddVar(*proc.procstructure, var.s, varType.l,varLine.l, *globalproc.procstructure=#False, VarID.l = #False)
  
  Protected Cancel.l
  Protected a.l
  Protected find.l
  Protected find2.l
  Protected find3.l
  Protected varDecType.s
  
  Cancel = #False
  
  var = LTrim(RTrim(var))
  
  If var = ""
    ProcedureReturn #False
  EndIf
  
  If *globalproc
    var = ">>" + var
  EndIf
  
  Cancel = FindString(var,".",1)
  If Cancel
    
    find  = FindString(var," ",Cancel)
    find2 = FindString(var,"(",Cancel)
    find3 = FindString(var,"[",Cancel)
    
    If (find > find2 Or find = 0) And find2 <> 0
      find = find2
    EndIf
    If (find > find3 Or find = 0) And find3 <> 0
      find = find3
    EndIf
    
    varDecType = Mid(var,Cancel+1,find-Cancel-1)
    var        = Left(var,Cancel-1)
    
  EndIf
  
  Cancel = FindString(var,"=",1)
  If Cancel
    var = Left(var,Cancel-1)
  EndIf
  
  Cancel = FindString(var,"Dim ",1)
  If Cancel
    var = Mid(var,Cancel+Len("Dim "))
    find = FindString(var,"(",1)
    If find
      var = Left(var,find)
    Else
      var + "("
    EndIf
  EndIf
  
  Cancel = FindString(var,"NewList ",1)
  If Cancel
    var = Mid(var,Cancel+Len("NewList "))
    find = FindString(var,"(",1)
    If find
      var = Left(var,find)
    Else
      var + "("
    EndIf
  EndIf
  
  var = LTrim(RTrim(var))
  
  Cancel = #False
  For a=0 To *proc\procVarCount-1
    If *proc\procVars[a]\varName = var
      Cancel = #True
      Break
    EndIf
  Next
  If Cancel = #False
    *proc\procVars[*proc\procVarCount]\varName     = var
    *proc\procVars[*proc\procVarCount]\varType     = varType
    *proc\procVars[*proc\procVarCount]\varDecType  = varDecType
    *proc\procVars[*proc\procVarCount]\varLine     = varLine
    *proc\procVars[*proc\procVarCount]\varParent   = *globalproc
    *proc\procVars[*proc\procVarCount]\varParentID = VarID
    *proc\procVarCount + 1
  EndIf
  
EndProcedure
Procedure.l getVarUsage(*code.codestructure,*proc.procstructure,*procitself.procstructure,procSpecial)
  
  Protected a.l
  Protected varPos1.l     = 0
  Protected varPos2.l     = 0
  Protected codeLen.l     = 0
  Protected varAsc.l      = 0
  Protected varAscStore.l = 0
  Protected varCur.l      = 0
  Protected code.s        = *code\code
  Protected Cancel.l
  
  For a=0 To 4
    If FindString(code,Commands(a),1)
      ProcedureReturn #False
    EndIf
  Next
  
  For a=0 To *proc\procVarCount-1
    
    If     *procitself <> *proc And *proc\procVars[a]\varType <> 0
      Continue
    EndIf
    
    varPos1 = FindString(code,*proc\procVars[a]\varName,1)
    
    While varPos1
      
      Cancel = #False
      
      varPos2 = varPos1 + Len(*proc\procVars[a]\varName) - 1
      
      varCur = varPos1
      While varCur > 1
        
        varAsc = Asc(Mid(code,varCur-1,1))
        Select varAsc
          Case '\' , '#' , ')' , '0' To '9' , 'a' To 'z' , 'A' To 'Z'
            *proc\procVars[a]\varUsable | #var_use_noUse
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
            Cancel = #True
            Break
          Case '+','-','*','/','&','!','|','~','%'
            *proc\procVars[a]\varUsable | #var_use_calculate
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
            Break
          Case '('
            varAscStore = Asc(Mid(code,varCur-1-1,1))
            If (varAscStore => 'a' And varAscStore <= 'z') Or  (varAscStore => 'A' And varAscStore <= 'Z')
              *proc\procVars[a]\varUsable | #var_use_argument
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            Else
              *proc\procVars[a]\varUsable | #var_use_calculate
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            EndIf
            Break
          Case '<','>'
            varAscStore = Asc(Mid(code,varCur-1-1,1))
            If varAscStore = varAsc
              *proc\procVars[a]\varUsable | #var_use_calculate
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            Else
              *proc\procVars[a]\varUsable | #var_use_compare
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            EndIf
            Break
          Case '='
            *proc\procVars[a]\varUsable | #var_use_anyUse
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
            Break
          Case ','
            *proc\procVars[a]\varUsable | #var_use_argument
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
          Case ' ','@'
            If procSpecial
              Break
            EndIf
          Default
            Break
        EndSelect
        varCur -1
      Wend
      
      Protected struct.l = #False
      
      varCur = varPos2
      codeLen = Len(code)
      While varCur < codeLen
        varAsc = Asc(Mid(code,varCur+1,1))
        Select varAsc
          Case '0' To '9' , 'a' To 'z' , 'A' To 'Z', '('
            If Right(*proc\procVars[a]\varName,1) <> "(" And struct = #False
              *proc\procVars[a]\varUsable | #var_use_noUse
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
              Cancel = #True
              Break
            EndIf
          Case ')',','
            If Right(*proc\procVars[a]\varName,1) <> "("
              Break
            EndIf
          Case '\'
            If varCur = varPos2 Or struct
              struct = #True
            Else
              Break
            EndIf
          Case '[',']'
            If struct = #False
              Break
            EndIf
          Case '+','-','*','/','&','!','|','~','%'
            *proc\procVars[a]\varUsable | #var_use_calculate
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
            Break
          Case '<','>'
            varAscStore = Asc(Mid(code,varCur-1-1,1))
            If varAscStore = varAsc
              *proc\procVars[a]\varUsable | #var_use_calculate
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            Else
              *proc\procVars[a]\varUsable | #var_use_compare
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            EndIf
            Break
          Case '='
            *proc\procVars[a]\varUsable | #var_use_storeVal
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
            Break
          Case ' '
            If procSpecial
              Break
            EndIf
          Default
            Break
        EndSelect
        varCur +1
      Wend
      
      If Cancel = #False
        If procSpecial
          *proc\procVars[a]\varUsable | procSpecial
          If *proc\procVars[a]\varType = 0
            AddVar(*procitself,Mid(*code\code,varPos1,varPos2-varPos1),0,*code\line,*proc)
          EndIf
          Break
        EndIf
      EndIf
      
      varPos1 = FindString(code,*proc\procVars[a]\varName,varPos1+1)
      
    Wend
    
  Next
  
EndProcedure
Procedure.l CheckCodeVars(*proc.procstructure, vars.s,varLine.l)
  
  Protected addoperators.l
  Protected newOperators.s
  Protected countOperators.l
  Protected a.l
  Protected b.l
  
  If vars = ""
    ProcedureReturn #False
  EndIf
  
  For b=0 To Commands_size
    
    addoperators = FindString(vars,Commands(b),1)
    If addoperators
      If CountString(Left(vars,addoperators-1),Chr(34)) % 2 = 0
        newOperators   = Mid(vars, addoperators+Len(Commands(b)))+","
        countOperators = CountString(newOperators,",")
        For a=1 To countOperators
          AddVar(*proc,StringField(newOperators,a,","),b,varLine)
          ;Break 2
        Next
      EndIf
    EndIf
  Next
  
EndProcedure
Procedure.l checkCodeSpecialSub(code.s,toFind.s,ReturnValue.l=0)
  
  Protected find.l
  
  find = FindString(code,toFind,1)
  If find
    If Left(code,find-1) = ""
      If ReturnValue = 0
        ProcedureReturn find
      Else
        ProcedureReturn ReturnValue
      EndIf
    EndIf
  EndIf
  
  ProcedureReturn #False
  
EndProcedure
Procedure.l checkCodeSpecial(code.s)
  
  Protected result = #False 
  
  result | checkCodeSpecialSub(code,"ProcedureReturn",#var_spc_Return)
  result | checkCodeSpecialSub(code,"For ",#var_spc_For)
  result | checkCodeSpecialSub(code,"ForEach ",#var_spc_ForEach)
  result | checkCodeSpecialSub(code,"While ",#var_spc_While)
  result | checkCodeSpecialSub(code,"Until ",#var_spc_Repeat)
  result | checkCodeSpecialSub(code,"Select ",#var_spc_Select)
  result | checkCodeSpecialSub(code,"Case ",#var_spc_Select)
  result | checkCodeSpecialSub(code,"Gosub ",#var_spc_GoSub)
  result | checkCodeSpecialSub(code,"GoTo ",#var_spc_GoTo)
  result | checkCodeSpecialSub(code,"If ",#var_spc_If)
  result | checkCodeSpecialSub(code,"ElseIf ",#var_spc_If)
  
  ProcedureReturn result
  
EndProcedure
Procedure.s OpenSourceFile(Sourcefile.s)
  
  Define file.l
  Define file_size.l
  Define *buffer
  Define out.s
  
  file_size = FileSize(Sourcefile)
  
  If file_size > 0
    
    file = OpenFile(#PB_Any,Sourcefile)
    
    If file
      
      *buffer = AllocateMemory(file_size)
      
      If *buffer
        
        ReadData(file,*buffer,file_size)
        out = PeekS(*buffer,file_size)
        FreeMemory(*buffer)
        
        CloseFile(file)
        
        ProcedureReturn out
        
      EndIf
      
    EndIf
    
  EndIf
  
  ProcedureReturn ""
  
EndProcedure
Procedure.l CheckSourceSub(*proc.procstructure)
  
  Protected a.l
  Protected b.l
  Protected c.l
  Protected d.l
  Protected skip.l
  Protected find.l
  
  If *proc\procChecked = #True
    ProcedureReturn #True
  EndIf
  
  For a=*proc\procStart+1 To *proc\procEnd-1
    
    ;Aussortieren
    If code(a)\code = ""
      Continue
    EndIf
    
    ;Prozeduren überspringen
    For b=1 To proc_size
      If proc(b)\procStart = code(a)\line Or proc(b)\procEnd = code(a)\line
        skip!1
      EndIf
    Next
    
    If skip = 0
      For b = 0 To proc_size
        
        ;Aufruf nachgehen
        find = FindString(code(a)\code,proc(b)\procName,1)
        If find
          
          If CountString(Left(code(a)\code,find-1),Chr(34)) % 2 = 1
            Continue
          EndIf
          
          Protected newOperators.s
          Protected countOperators
          Protected countBrackets.l
          Protected tempName.s
          
          newOperators  = Mid(code(a)\code,FindString(code(a)\code,proc(b)\procName,1)+Len(proc(b)\procName))
          countBrackets = 1
          
          For c=0 To Len(newOperators)-1
            Select PeekC(@newOperators+c)
              Case '('
                countBrackets+1
              Case ')'
                countBrackets-1
            EndSelect
            If countBrackets = 0
              Break
            EndIf
          Next
          
          newOperators = Left(newOperators,c) + ","
          
          If newOperators <> ""
            countOperators = CountString(newOperators,",")
            For c=0 To countOperators-1
              tempName = StringField(newOperators,c+1,",")
              For d=0 To *proc\procVarCount-1
                If *proc\procVars[d]\varName = tempName
                  *proc\procVars[d]\varUsable | #var_use_argument
                  *proc\procVars[d]\varUsable | proc(b)\procVars[c]\varUsable
                  Break
                EndIf
              Next
            Next
          EndIf
          
          proc(b)\procUsable + 1
          
          Continue
          
        EndIf
        
      Next
      
      ;Korrektur
      
      Protected procSpecial.l  = #False
      
      procSpecial = checkCodeSpecial(code(a)\code)
      
      For b=0 To proc_size
        getVarUsage(@code(a),proc(b),*proc,procSpecial)
      Next
      
    EndIf
    
  Next
  
  For b=0 To *proc\procVarCount
    
    *proc\procChecked            = #True
    *proc\procVars[b]\varChecked = #True
    If *proc\procVars[b]\varUsable
      *proc\procVars[b]\varUsable | #var_use_anyUse
    EndIf
    
  Next
  
EndProcedure
Procedure.l CheckSource(SourceCode.s)
  
  Protected countLines.l
  Protected countProcs.l
  Protected a.l
  Protected b.l
  Protected addLines.l
  Protected FindQuotes.l
  
  If Right(SourceCode,2) <> #CRLF$
    SourceCode + #CRLF$
  EndIf
  
  countLines = CountString(SourceCode,#CRLF$)+CountString(SourceCode,":")
  ReDim code.codestructure(countLines+1)
  
  code(0)\code = "Procedure wjXdiWEZoRL()"
  For a=1 To countLines
    code(a)\code = StringField(SourceCode,a-b,#CR$)
    code(a)\code = ReplaceString(code(a)\code, #LF$, "")
    
    FindQuotes = FindString(code(a)\code,";",1)
    While FindQuotes > 0
      If CountString(Left(code(a)\code,FindQuotes),Chr(34)) % 2 = 0
        code(a)\code = Left(code(a)\code,FindQuotes-1)
      EndIf
      FindQuotes = FindString(code(a)\code,";",FindQuotes+1)
    Wend
    
    addLines = FindString(code(a)\code,":",1)
    While addLines
      If CountString(Left(code(a)\code,addLines-1),Chr(34)) % 2 = 0
        code(a+1)\code = Mid(code(a)\code,addLines+1)
        code(a)\code   = Left(code(a)\code,addLines-1)
        a+1
        b+1
        addLines = FindString(code(a)\code,":",1)
      Else
        addLines = FindString(code(a)\code,":",addLines+1)
      EndIf
    Wend
    code(a)\code = LTrim(RTrim(code(a)\code))
    code(a)\line = a-b
    
  Next
  code(countLines+1)\code = "EndProcedure"
  
  For a=0 To countLines+1
    
    If checkCodeSpecialSub(code(a)\code,"Procedure.") Or checkCodeSpecialSub(code(a)\code,"Procedure ")
      countProcs+1
    EndIf
    
  Next
  
  ReDim proc.procstructure(countProcs-1)
  proc_size = countProcs-1
  
  Protected addProcedure.l
  Protected newOperators.s
  Protected countOperators.l
  Protected Cancel.l = #False
  Protected c.l
  
  proc(0)\procName      = "wjXdiWEZoRL("
  proc(0)\procStart     = 0
  proc(0)\procEnd       = countLines+1
  proc(0)\procStartLine = 0
  proc(0)\procEndLine   = 0
  For a=1 To countLines
    
    If checkCodeSpecialSub(code(a)\code,"Procedure.") Or checkCodeSpecialSub(code(a)\code,"Procedure ")  Or checkCodeSpecialSub(code(a)\code,"EndProcedure")
      Cancel!1
    EndIf
    
    If Cancel = #False
      CheckCodeVars(@proc(0),code(a)\code,code(a)\line)
    EndIf
    
  Next
  
  b=1
  
  Protected inProc.l = #False
  
  For a=1 To countLines
    
    addProcedure = checkCodeSpecialSub(code(a)\code,"Procedure.")
    If addProcedure = 0
      addProcedure = checkCodeSpecialSub(code(a)\code,"Procedure ")
    EndIf
    
    If addProcedure
      
      inProc = #True
      
      proc(b)\procName  = Mid(code(a)\code,FindString(code(a)\code," ",addProcedure+Len("Procedure")))
      
      proc(b)\procName  = RTrim(LTrim(proc(b)\procName))
      proc(b)\procName  = Left(proc(b)\procName,FindString(proc(b)\procName,"(",1))
      
      newOperators = proc(b)\procName
      newOperators = Mid(code(a)\code,FindString(code(a)\code,proc(b)\procName,1)+Len(proc(b)\procName))
      Repeat
        newOperators = Left(newOperators,Len(newOperators)-1)
      Until Right(newOperators,1) <> ")" Or newOperators = ""
      newOperators + ","
      
      If newOperators <> ""
        countOperators = CountString(newOperators,",")
        For c=1 To countOperators
          AddVar(@proc(b),StringField(newOperators,c,","),2,a)
        Next
      EndIf
      
      proc(b)\procStart     = a
      proc(b)\procStartLine = code(a)\line
    EndIf
    
    addProcedure = checkCodeSpecialSub(code(a)\code,"EndProcedure")
    
    If addProcedure
      proc(b)\procEnd     = a
      proc(b)\procEndLine = code(a)\line
      b+1
      inProc = #False
    EndIf
    
    If inProc = #True
      CheckCodeVars(@proc(b),code(a)\code,code(a)\line)
    EndIf
    
  Next
  
  proc(0)\procUsable + 1
  For b=0 To proc_size
    CheckSourceSub(proc(b))
  Next
  
  Protected *tempProc.procstructure
  
  For b=0 To proc_size
    For c=0 To proc(b)\procVarCount
      If proc(b)\procVars[c]\varParent <> 0
        *tempProc = proc(b)\procVars[c]\varParent
        proc(b)\procVars[c]\varUsable   | *tempProc\procVars[proc(b)\procVars[c]\varParentID]\varUsable
        proc(b)\procVars[c]\varDecType  = *tempProc\procVars[proc(b)\procVars[c]\varParentID]\varDecType
      EndIf
      If proc(b)\procVars[c]\varUsable
        proc(b)\procVars[c]\varUsable | #var_use_anyUse
      EndIf
    Next
  Next
  
  proc(0)\procName = ">MainCode<"
  
EndProcedure

Define Sourcefile.s
Define SourceCode.s

Sourcefile = ProgramParameter()

If FileSize(Sourcefile) <= 0
  Sourcefile = OpenFileRequester("File","","",0)
EndIf
SourceCode = OpenSourceFile(Sourcefile)

If SourceCode <> ""
  CheckSource(SourceCode)
EndIf


;- Showcase

Enumeration ;gadgets
  
  #g_icon_Procs
  #g_icon_Vars
  
  #g_text_spezial
  
  #g_check_return
  #g_check_gosub
  #g_check_goto
  #g_check_if
  #g_check_for
  #g_check_foreach
  #g_check_while
  #g_check_repeat
  #g_check_select
  
  #g_text_vartype
  #g_text_dectype
  #g_text_vartype2
  #g_text_dectype2
  
EndEnumeration

OpenWindow(0,0,0,900,720,GetFilePart(Sourcefile),#PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
ListIconGadget(#g_icon_Procs, 10,10,880,300,"procedures",150,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
AddGadgetColumn(#g_icon_Procs,1,"line",65)
AddGadgetColumn(#g_icon_Procs,2,"calls",65)
AddGadgetColumn(#g_icon_Procs,3,"variables",65)
ListIconGadget(#g_icon_Vars ,10,310,880,300,"Variablen" ,150,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
AddGadgetColumn(#g_icon_Vars,1,"line",60)
AddGadgetColumn(#g_icon_Vars,2,"Header",60)
AddGadgetColumn(#g_icon_Vars,3,"used?",60)
AddGadgetColumn(#g_icon_Vars,4,"value changes",60)
AddGadgetColumn(#g_icon_Vars,5,"calculation",60)
AddGadgetColumn(#g_icon_Vars,6,"comparison",60)
AddGadgetColumn(#g_icon_Vars,7,"argument",60)
TextGadget(#g_text_spezial,10,620,100,20,"special usage:")
CheckBoxGadget(#g_check_return,  10, 640, 100, 20, "return")
CheckBoxGadget(#g_check_gosub,   10, 660, 100, 20, "gosub")
CheckBoxGadget(#g_check_goto,    10, 680, 100, 20, "goto")
CheckBoxGadget(#g_check_if,      110, 640, 100, 20, "if")
CheckBoxGadget(#g_check_for,     110, 660, 100, 20, "for")
CheckBoxGadget(#g_check_foreach, 110, 680, 100, 20, "foreach")
CheckBoxGadget(#g_check_while,   210, 640, 100, 20, "while")
CheckBoxGadget(#g_check_repeat,  210, 660, 100, 20, "repeat")
CheckBoxGadget(#g_check_select,  210, 680, 100, 20, "select")
TextGadget(#g_text_dectype, 320,620,100,20,"declaration:")
TextGadget(#g_text_vartype, 320,640,100,20,"declarated as:")
TextGadget(#g_text_dectype2, 420,620,100,20,"")
TextGadget(#g_text_vartype2, 420,640,100,20,"")

Define a.l
Define b.l
Define correct.l

For a=0 To proc_size
  If a=0
    
    correct=0
    For b=0 To proc(a)\procVarCount-1
      If proc(a)\procVars[b]\varParent
        correct+1
      EndIf
    Next
    
    proc(0)\procVarCount-correct
    
    AddGadgetItem(#g_icon_Procs,-1,proc(a)\procName + Chr(10)+Chr(10)+Chr(10)+Str(proc(a)\procVarCount))
  Else
    AddGadgetItem(#g_icon_Procs,-1,proc(a)\procName + ")"+Chr(10)+Str(proc(a)\procStart)+"-"+Str(proc(a)\procEnd)+Chr(10)+Str(proc(a)\procUsable)+Chr(10)+Str(proc(a)\procVarCount))
  EndIf
Next

Global g_id.l

Procedure FillSpecial(number.l)
  
  If number < 0
    ProcedureReturn #False
  EndIf
  
  SetGadgetState(#g_check_gosub,0)
  SetGadgetState(#g_check_goto,0)
  SetGadgetState(#g_check_if,0)
  SetGadgetState(#g_check_for,0)
  SetGadgetState(#g_check_foreach,0)
  SetGadgetState(#g_check_while,0)
  SetGadgetState(#g_check_repeat,0)
  SetGadgetState(#g_check_select,0)
  SetGadgetState(#g_check_return,0)
  
  If proc(g_id)\procVars[number]\varUsable & #var_spc_Return
    SetGadgetState(#g_check_return,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_GoSub
    SetGadgetState(#g_check_gosub,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_GoTo
    SetGadgetState(#g_check_goto,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_If
    SetGadgetState(#g_check_if,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_For
    SetGadgetState(#g_check_for,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_ForEach
    SetGadgetState(#g_check_foreach,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_While
    SetGadgetState(#g_check_while,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_Repeat
    SetGadgetState(#g_check_repeat,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_Select
    SetGadgetState(#g_check_select,1)
  EndIf
  
  SetGadgetText(#g_text_dectype2, LTrim(Commands(proc(g_id)\procVars[number]\varType)))
  
  Protected tempstring.s
  
  Select proc(g_id)\procVars[number]\varDecType
    Case "f"
      tempstring = "float"
    Case "l",""
      tempstring = "long"
    Case "w"
      tempstring = "word"
    Case "i"
      tempstring = "integer"
    Case "d"
      tempstring = "double"
    Case "q"
      tempstring = "quad"
    Case "s"
      tempstring = "string"
    Case "c"
      tempstring = "character"
    Case "b"
      tempstring = "byte"
    Default
      tempstring = proc(g_id)\procVars[number]\varDecType
  EndSelect
  
  SetGadgetText(#g_text_vartype2, tempstring)
  
EndProcedure
Procedure FillVars(id.l)
  
  If id >= 0
    g_id = id
  Else
    ProcedureReturn #False
  EndIf
  
  ClearGadgetItems(#g_icon_Vars)
  
  Protected tempstring.s
  Protected a.l
  
  For a=0 To proc(id)\procVarCount-1
    
    If id=0 And proc(id)\procVars[a]\varParent
      Continue
    EndIf
    
    tempstring = ""
    
    If Right(proc(id)\procVars[a]\varName,1) = "("
      tempstring + proc(id)\procVars[a]\varName + ")"
    Else
      tempstring + proc(id)\procVars[a]\varName
    EndIf
    
    tempstring + Chr(10) + Str(proc(id)\procVars[a]\varLine)
    If proc(id)\procStart = proc(id)\procVars[a]\varLine
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    
    If proc(id)\procVars[a]\varUsable & #var_use_anyUse
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    If proc(id)\procVars[a]\varUsable & #var_use_storeVal
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    If proc(id)\procVars[a]\varUsable & #var_use_calculate
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    If proc(id)\procVars[a]\varUsable & #var_use_compare
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    If proc(id)\procVars[a]\varUsable & #var_use_argument
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    
    AddGadgetItem(#g_icon_Vars,-1,tempstring)
    
  Next
  
EndProcedure

FillVars(0)
FillSpecial(0)

Define EventID

Repeat
  
  EventID = WaitWindowEvent()
  
  Select EventID
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #g_icon_Procs
          FillVars(GetGadgetState(#g_icon_Procs))
          FillSpecial(0)
        Case #g_icon_Vars
          FillSpecial(GetGadgetState(#g_icon_Vars))
      EndSelect
      
  EndSelect
  
  
Until EventID = #PB_Event_CloseWindow
Top
Dude
Addict
Addict
Posts: 1907
Joined: Mon Feb 16, 2015 2:49 pm

Re: Variable Checking

Post by Dude »

SniffTheGlove wrote:if anyone who has a old copy of PB hanging around that is installed on their system, could you compile
You can download old PureBasic copies from your online account at PureBasic.com :)
Top
SniffTheGlove
Enthusiast
Enthusiast
Posts: 122
Joined: Sat Nov 19, 2011 6:51 pm

Re: Variable Checking

Post by SniffTheGlove »

Dude wrote:
SniffTheGlove wrote:if anyone who has a old copy of PB hanging around that is installed on their system, could you compile
You can download old PureBasic copies from your online account at PureBasic.com :)
I know, I just did not want to try install a few old copies in seperate area and mess with cfg files just to try to compile a single file, besides it would be great if someone could see why the above code does not work on 5.6x. I am not an expert at PB, if I was I would be master of the universe but alas I am just a lowly person at the bottom of the food chain :-)
Top
User avatar
HeX0R
Addict
Addict
Posts: 1187
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: Variable Checking

Post by HeX0R »

SniffTheGlove wrote:I know, I just did not want to try install a few old copies in seperate area and mess with cfg files just to try to compile a single file, besides it would be great if someone could see why the above code does not work on 5.6x. I am not an expert at PB, if I was I would be master of the universe but alas I am just a lowly person at the bottom of the food chain :-)
aha... :|
It's quite simpel, just look more closely on line 418 and keep in mind that current PB versions are unicode only.
Top
User avatar
Bisonte
Addict
Addict
Posts: 1305
Joined: Tue Oct 09, 2007 2:15 am

Re: Variable Checking

Post by Bisonte »

SniffTheGlove wrote:A long time ago (a few years) another PB user posted this code.
The "lost" PB User is gnasen. And his thread is http://www.purebasic.fr/english/viewtop ... 12#p287912.

It was designed as a jaPBe IDE Tool in 2008.

And HeX0r is right. It's an unicode issue at the given line ;)
PureBasic 6.21 (Windows x64) | Windows 11 Pro | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
English is not my native language... (I often use DeepL.)
Top
SniffTheGlove
Enthusiast
Enthusiast
Posts: 122
Joined: Sat Nov 19, 2011 6:51 pm

Re: Variable Checking

Post by SniffTheGlove »

Thanks for the pointers. :-)

Here is the code with the unicode alteration for anyone else who might like to check for variables and unused declared variables.

Code: Select all

EnableExplicit

#maxVars = 1000

#var_use_noUse     = %00000000000000
#var_use_anyUse    = %00000000000001
#var_use_argument  = %00000000000010
#var_use_calculate = %00000000000100
#var_use_compare   = %00000000001000
#var_use_storeVal  = %00000000010000
#var_spc_Return    = %00000000100000
#var_spc_For       = %00000001000000
#var_spc_ForEach   = %00000010000000
#var_spc_While     = %00000100000000
#var_spc_Repeat    = %00001000000000
#var_spc_Select    = %00010000000000
#var_spc_GoSub     = %00100000000000
#var_spc_GoTo      = %01000000000000
#var_spc_If        = %10000000000000

Structure varstructure
  
  varName.s
  varUsable.l
  varChecked.l
  varType.l
  varDecType.s
  varLine.l
  
  varParent.l
  varParentID.l
  
EndStructure
Structure procstructure
  
  procName.s
  procStart.l
  procEnd.l
  procStartLine.l
  procEndLine.l
  procUsable.l
  procChecked.l
  procVarCount.l
  procVars.varstructure[#maxVars]
  
EndStructure
Structure codestructure
  code.s
  line.l
EndStructure

Global Dim code.codestructure(0)
Global Dim proc.procstructure(0)
Global proc_size.l
Global Commands_size = 4
Global Dim Commands.s(Commands_size)

Commands(0) = "Global "
Commands(1) = "Define "
Commands(2) = "Protected "
Commands(3) = "Shared "
Commands(4) = "Static "

Procedure.l AddVar(*proc.procstructure, var.s, varType.l,varLine.l, *globalproc.procstructure=#False, VarID.l = #False)
  
  Protected Cancel.l
  Protected a.l
  Protected find.l
  Protected find2.l
  Protected find3.l
  Protected varDecType.s
  
  Cancel = #False
  
  var = LTrim(RTrim(var))
  
  If var = ""
    ProcedureReturn #False
  EndIf
  
  If *globalproc
    var = ">>" + var
  EndIf
  
  Cancel = FindString(var,".",1)
  If Cancel
    
    find  = FindString(var," ",Cancel)
    find2 = FindString(var,"(",Cancel)
    find3 = FindString(var,"[",Cancel)
    
    If (find > find2 Or find = 0) And find2 <> 0
      find = find2
    EndIf
    If (find > find3 Or find = 0) And find3 <> 0
      find = find3
    EndIf
    
    varDecType = Mid(var,Cancel+1,find-Cancel-1)
    var        = Left(var,Cancel-1)
    
  EndIf
  
  Cancel = FindString(var,"=",1)
  If Cancel
    var = Left(var,Cancel-1)
  EndIf
  
  Cancel = FindString(var,"Dim ",1)
  If Cancel
    var = Mid(var,Cancel+Len("Dim "))
    find = FindString(var,"(",1)
    If find
      var = Left(var,find)
    Else
      var + "("
    EndIf
  EndIf
  
  Cancel = FindString(var,"NewList ",1)
  If Cancel
    var = Mid(var,Cancel+Len("NewList "))
    find = FindString(var,"(",1)
    If find
      var = Left(var,find)
    Else
      var + "("
    EndIf
  EndIf
  
  var = LTrim(RTrim(var))
  
  Cancel = #False
  For a=0 To *proc\procVarCount-1
    If *proc\procVars[a]\varName = var
      Cancel = #True
      Break
    EndIf
  Next
  If Cancel = #False
    *proc\procVars[*proc\procVarCount]\varName     = var
    *proc\procVars[*proc\procVarCount]\varType     = varType
    *proc\procVars[*proc\procVarCount]\varDecType  = varDecType
    *proc\procVars[*proc\procVarCount]\varLine     = varLine
    *proc\procVars[*proc\procVarCount]\varParent   = *globalproc
    *proc\procVars[*proc\procVarCount]\varParentID = VarID
    *proc\procVarCount + 1
  EndIf
  
EndProcedure
Procedure.l getVarUsage(*code.codestructure,*proc.procstructure,*procitself.procstructure,procSpecial)
  
  Protected a.l
  Protected varPos1.l     = 0
  Protected varPos2.l     = 0
  Protected codeLen.l     = 0
  Protected varAsc.l      = 0
  Protected varAscStore.l = 0
  Protected varCur.l      = 0
  Protected code.s        = *code\code
  Protected Cancel.l
  
  For a=0 To 4
    If FindString(code,Commands(a),1)
      ProcedureReturn #False
    EndIf
  Next
  
  For a=0 To *proc\procVarCount-1
    
    If     *procitself <> *proc And *proc\procVars[a]\varType <> 0
      Continue
    EndIf
    
    varPos1 = FindString(code,*proc\procVars[a]\varName,1)
    
    While varPos1
      
      Cancel = #False
      
      varPos2 = varPos1 + Len(*proc\procVars[a]\varName) - 1
      
      varCur = varPos1
      While varCur > 1
        
        varAsc = Asc(Mid(code,varCur-1,1))
        Select varAsc
          Case '\' , '#' , ')' , '0' To '9' , 'a' To 'z' , 'A' To 'Z'
            *proc\procVars[a]\varUsable | #var_use_noUse
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
            Cancel = #True
            Break
          Case '+','-','*','/','&','!','|','~','%'
            *proc\procVars[a]\varUsable | #var_use_calculate
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
            Break
          Case '('
            varAscStore = Asc(Mid(code,varCur-1-1,1))
            If (varAscStore => 'a' And varAscStore <= 'z') Or  (varAscStore => 'A' And varAscStore <= 'Z')
              *proc\procVars[a]\varUsable | #var_use_argument
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            Else
              *proc\procVars[a]\varUsable | #var_use_calculate
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            EndIf
            Break
          Case '<','>'
            varAscStore = Asc(Mid(code,varCur-1-1,1))
            If varAscStore = varAsc
              *proc\procVars[a]\varUsable | #var_use_calculate
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            Else
              *proc\procVars[a]\varUsable | #var_use_compare
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            EndIf
            Break
          Case '='
            *proc\procVars[a]\varUsable | #var_use_anyUse
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
            Break
          Case ','
            *proc\procVars[a]\varUsable | #var_use_argument
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
          Case ' ','@'
            If procSpecial
              Break
            EndIf
          Default
            Break
        EndSelect
        varCur -1
      Wend
      
      Protected struct.l = #False
      
      varCur = varPos2
      codeLen = Len(code)
      While varCur < codeLen
        varAsc = Asc(Mid(code,varCur+1,1))
        Select varAsc
          Case '0' To '9' , 'a' To 'z' , 'A' To 'Z', '('
            If Right(*proc\procVars[a]\varName,1) <> "(" And struct = #False
              *proc\procVars[a]\varUsable | #var_use_noUse
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
              Cancel = #True
              Break
            EndIf
          Case ')',','
            If Right(*proc\procVars[a]\varName,1) <> "("
              Break
            EndIf
          Case '\'
            If varCur = varPos2 Or struct
              struct = #True
            Else
              Break
            EndIf
          Case '[',']'
            If struct = #False
              Break
            EndIf
          Case '+','-','*','/','&','!','|','~','%'
            *proc\procVars[a]\varUsable | #var_use_calculate
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
            Break
          Case '<','>'
            varAscStore = Asc(Mid(code,varCur-1-1,1))
            If varAscStore = varAsc
              *proc\procVars[a]\varUsable | #var_use_calculate
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            Else
              *proc\procVars[a]\varUsable | #var_use_compare
              If *proc\procVars[a]\varType = 0
                AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
              EndIf
            EndIf
            Break
          Case '='
            *proc\procVars[a]\varUsable | #var_use_storeVal
            If *proc\procVars[a]\varType = 0
              AddVar(*procitself,*proc\procVars[a]\varName,0,*code\line,*proc,a)
            EndIf
            Break
          Case ' '
            If procSpecial
              Break
            EndIf
          Default
            Break
        EndSelect
        varCur +1
      Wend
      
      If Cancel = #False
        If procSpecial
          *proc\procVars[a]\varUsable | procSpecial
          If *proc\procVars[a]\varType = 0
            AddVar(*procitself,Mid(*code\code,varPos1,varPos2-varPos1),0,*code\line,*proc)
          EndIf
          Break
        EndIf
      EndIf
      
      varPos1 = FindString(code,*proc\procVars[a]\varName,varPos1+1)
      
    Wend
    
  Next
  
EndProcedure
Procedure.l CheckCodeVars(*proc.procstructure, vars.s,varLine.l)
  
  Protected addoperators.l
  Protected newOperators.s
  Protected countOperators.l
  Protected a.l
  Protected b.l
  
  If vars = ""
    ProcedureReturn #False
  EndIf
  
  For b=0 To Commands_size
    
    addoperators = FindString(vars,Commands(b),1)
    If addoperators
      If CountString(Left(vars,addoperators-1),Chr(34)) % 2 = 0
        newOperators   = Mid(vars, addoperators+Len(Commands(b)))+","
        countOperators = CountString(newOperators,",")
        For a=1 To countOperators
          AddVar(*proc,StringField(newOperators,a,","),b,varLine)
          ;Break 2
        Next
      EndIf
    EndIf
  Next
  
EndProcedure
Procedure.l checkCodeSpecialSub(code.s,toFind.s,ReturnValue.l=0)
  
  Protected find.l
  
  find = FindString(code,toFind,1)
  If find
    If Left(code,find-1) = ""
      If ReturnValue = 0
        ProcedureReturn find
      Else
        ProcedureReturn ReturnValue
      EndIf
    EndIf
  EndIf
  
  ProcedureReturn #False
  
EndProcedure
Procedure.l checkCodeSpecial(code.s)
  
  Protected result = #False 
  
  result | checkCodeSpecialSub(code,"ProcedureReturn",#var_spc_Return)
  result | checkCodeSpecialSub(code,"For ",#var_spc_For)
  result | checkCodeSpecialSub(code,"ForEach ",#var_spc_ForEach)
  result | checkCodeSpecialSub(code,"While ",#var_spc_While)
  result | checkCodeSpecialSub(code,"Until ",#var_spc_Repeat)
  result | checkCodeSpecialSub(code,"Select ",#var_spc_Select)
  result | checkCodeSpecialSub(code,"Case ",#var_spc_Select)
  result | checkCodeSpecialSub(code,"Gosub ",#var_spc_GoSub)
  result | checkCodeSpecialSub(code,"GoTo ",#var_spc_GoTo)
  result | checkCodeSpecialSub(code,"If ",#var_spc_If)
  result | checkCodeSpecialSub(code,"ElseIf ",#var_spc_If)
  
  ProcedureReturn result
  
EndProcedure
Procedure.s OpenSourceFile(Sourcefile.s)
  
  Define file.l
  Define file_size.l
  Define *buffer
  Define out.s
  
  file_size = FileSize(Sourcefile)
  
  If file_size > 0
    
    file = OpenFile(#PB_Any,Sourcefile)
    
    If file
      
      *buffer = AllocateMemory(file_size)
      
      If *buffer
        
        ReadData(file,*buffer,file_size)
        out = PeekS(*buffer,file_size,#PB_UTF8)
        FreeMemory(*buffer)
        
        CloseFile(file)
        
        ProcedureReturn out
        
      EndIf
      
    EndIf
    
  EndIf
  
  ProcedureReturn ""
  
EndProcedure
Procedure.l CheckSourceSub(*proc.procstructure)
  
  Protected a.l
  Protected b.l
  Protected c.l
  Protected d.l
  Protected skip.l
  Protected find.l
  
  If *proc\procChecked = #True
    ProcedureReturn #True
  EndIf
  
  For a=*proc\procStart+1 To *proc\procEnd-1
    
    ;Aussortieren
    If code(a)\code = ""
      Continue
    EndIf
    
    ;Prozeduren überspringen
    For b=1 To proc_size
      If proc(b)\procStart = code(a)\line Or proc(b)\procEnd = code(a)\line
        skip!1
      EndIf
    Next
    
    If skip = 0
      For b = 0 To proc_size
        
        ;Aufruf nachgehen
        find = FindString(code(a)\code,proc(b)\procName,1)
        If find
          
          If CountString(Left(code(a)\code,find-1),Chr(34)) % 2 = 1
            Continue
          EndIf
          
          Protected newOperators.s
          Protected countOperators
          Protected countBrackets.l
          Protected tempName.s
          
          newOperators  = Mid(code(a)\code,FindString(code(a)\code,proc(b)\procName,1)+Len(proc(b)\procName))
          countBrackets = 1
          
          For c=0 To Len(newOperators)-1
            Select PeekC(@newOperators+c)
              Case '('
                countBrackets+1
              Case ')'
                countBrackets-1
            EndSelect
            If countBrackets = 0
              Break
            EndIf
          Next
          
          newOperators = Left(newOperators,c) + ","
          
          If newOperators <> ""
            countOperators = CountString(newOperators,",")
            For c=0 To countOperators-1
              tempName = StringField(newOperators,c+1,",")
              For d=0 To *proc\procVarCount-1
                If *proc\procVars[d]\varName = tempName
                  *proc\procVars[d]\varUsable | #var_use_argument
                  *proc\procVars[d]\varUsable | proc(b)\procVars[c]\varUsable
                  Break
                EndIf
              Next
            Next
          EndIf
          
          proc(b)\procUsable + 1
          
          Continue
          
        EndIf
        
      Next
      
      ;Korrektur
      
      Protected procSpecial.l  = #False
      
      procSpecial = checkCodeSpecial(code(a)\code)
      
      For b=0 To proc_size
        getVarUsage(@code(a),proc(b),*proc,procSpecial)
      Next
      
    EndIf
    
  Next
  
  For b=0 To *proc\procVarCount
    
    *proc\procChecked            = #True
    *proc\procVars[b]\varChecked = #True
    If *proc\procVars[b]\varUsable
      *proc\procVars[b]\varUsable | #var_use_anyUse
    EndIf
    
  Next
  
EndProcedure
Procedure.l CheckSource(SourceCode.s)
  
  Protected countLines.l
  Protected countProcs.l
  Protected a.l
  Protected b.l
  Protected addLines.l
  Protected FindQuotes.l
  
  If Right(SourceCode,2) <> #CRLF$
    SourceCode + #CRLF$
  EndIf
  
  countLines = CountString(SourceCode,#CRLF$)+CountString(SourceCode,":")
  ReDim code.codestructure(countLines+1)
  
  code(0)\code = "Procedure wjXdiWEZoRL()"
  For a=1 To countLines
    code(a)\code = StringField(SourceCode,a-b,#CR$)
    code(a)\code = ReplaceString(code(a)\code, #LF$, "")
    
    FindQuotes = FindString(code(a)\code,";",1)
    While FindQuotes > 0
      If CountString(Left(code(a)\code,FindQuotes),Chr(34)) % 2 = 0
        code(a)\code = Left(code(a)\code,FindQuotes-1)
      EndIf
      FindQuotes = FindString(code(a)\code,";",FindQuotes+1)
    Wend
    
    addLines = FindString(code(a)\code,":",1)
    While addLines
      If CountString(Left(code(a)\code,addLines-1),Chr(34)) % 2 = 0
        code(a+1)\code = Mid(code(a)\code,addLines+1)
        code(a)\code   = Left(code(a)\code,addLines-1)
        a+1
        b+1
        addLines = FindString(code(a)\code,":",1)
      Else
        addLines = FindString(code(a)\code,":",addLines+1)
      EndIf
    Wend
    code(a)\code = LTrim(RTrim(code(a)\code))
    code(a)\line = a-b
    
  Next
  code(countLines+1)\code = "EndProcedure"
  
  For a=0 To countLines+1
    
    If checkCodeSpecialSub(code(a)\code,"Procedure.") Or checkCodeSpecialSub(code(a)\code,"Procedure ")
      countProcs+1
    EndIf
    
  Next
  
  ReDim proc.procstructure(countProcs-1)
  proc_size = countProcs-1
  
  Protected addProcedure.l
  Protected newOperators.s
  Protected countOperators.l
  Protected Cancel.l = #False
  Protected c.l
  
  proc(0)\procName      = "wjXdiWEZoRL("
  proc(0)\procStart     = 0
  proc(0)\procEnd       = countLines+1
  proc(0)\procStartLine = 0
  proc(0)\procEndLine   = 0
  For a=1 To countLines
    
    If checkCodeSpecialSub(code(a)\code,"Procedure.") Or checkCodeSpecialSub(code(a)\code,"Procedure ")  Or checkCodeSpecialSub(code(a)\code,"EndProcedure")
      Cancel!1
    EndIf
    
    If Cancel = #False
      CheckCodeVars(@proc(0),code(a)\code,code(a)\line)
    EndIf
    
  Next
  
  b=1
  
  Protected inProc.l = #False
  
  For a=1 To countLines
    
    addProcedure = checkCodeSpecialSub(code(a)\code,"Procedure.")
    If addProcedure = 0
      addProcedure = checkCodeSpecialSub(code(a)\code,"Procedure ")
    EndIf
    
    If addProcedure
      
      inProc = #True
      
      proc(b)\procName  = Mid(code(a)\code,FindString(code(a)\code," ",addProcedure+Len("Procedure")))
      
      proc(b)\procName  = RTrim(LTrim(proc(b)\procName))
      proc(b)\procName  = Left(proc(b)\procName,FindString(proc(b)\procName,"(",1))
      
      newOperators = proc(b)\procName
      newOperators = Mid(code(a)\code,FindString(code(a)\code,proc(b)\procName,1)+Len(proc(b)\procName))
      Repeat
        newOperators = Left(newOperators,Len(newOperators)-1)
      Until Right(newOperators,1) <> ")" Or newOperators = ""
      newOperators + ","
      
      If newOperators <> ""
        countOperators = CountString(newOperators,",")
        For c=1 To countOperators
          AddVar(@proc(b),StringField(newOperators,c,","),2,a)
        Next
      EndIf
      
      proc(b)\procStart     = a
      proc(b)\procStartLine = code(a)\line
    EndIf
    
    addProcedure = checkCodeSpecialSub(code(a)\code,"EndProcedure")
    
    If addProcedure
      proc(b)\procEnd     = a
      proc(b)\procEndLine = code(a)\line
      b+1
      inProc = #False
    EndIf
    
    If inProc = #True
      CheckCodeVars(@proc(b),code(a)\code,code(a)\line)
    EndIf
    
  Next
  
  proc(0)\procUsable + 1
  For b=0 To proc_size
    CheckSourceSub(proc(b))
  Next
  
  Protected *tempProc.procstructure
  
  For b=0 To proc_size
    For c=0 To proc(b)\procVarCount
      If proc(b)\procVars[c]\varParent <> 0
        *tempProc = proc(b)\procVars[c]\varParent
        proc(b)\procVars[c]\varUsable   | *tempProc\procVars[proc(b)\procVars[c]\varParentID]\varUsable
        proc(b)\procVars[c]\varDecType  = *tempProc\procVars[proc(b)\procVars[c]\varParentID]\varDecType
      EndIf
      If proc(b)\procVars[c]\varUsable
        proc(b)\procVars[c]\varUsable | #var_use_anyUse
      EndIf
    Next
  Next
  
  proc(0)\procName = ">MainCode<"
  
EndProcedure

Define Sourcefile.s
Define SourceCode.s

Sourcefile = ProgramParameter()

If FileSize(Sourcefile) <= 0
  Sourcefile = OpenFileRequester("File","","",0)
EndIf
SourceCode = OpenSourceFile(Sourcefile)

If SourceCode <> ""
  CheckSource(SourceCode)
EndIf


;- Showcase

Enumeration ;gadgets
  
  #g_icon_Procs
  #g_icon_Vars
  
  #g_text_spezial
  
  #g_check_return
  #g_check_gosub
  #g_check_goto
  #g_check_if
  #g_check_for
  #g_check_foreach
  #g_check_while
  #g_check_repeat
  #g_check_select
  
  #g_text_vartype
  #g_text_dectype
  #g_text_vartype2
  #g_text_dectype2
  
EndEnumeration

OpenWindow(0,0,0,900,720,GetFilePart(Sourcefile),#PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
ListIconGadget(#g_icon_Procs, 10,10,880,300,"procedures",150,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
AddGadgetColumn(#g_icon_Procs,1,"line",65)
AddGadgetColumn(#g_icon_Procs,2,"calls",65)
AddGadgetColumn(#g_icon_Procs,3,"variables",65)
ListIconGadget(#g_icon_Vars ,10,310,880,300,"Variablen" ,150,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
AddGadgetColumn(#g_icon_Vars,1,"line",60)
AddGadgetColumn(#g_icon_Vars,2,"Header",60)
AddGadgetColumn(#g_icon_Vars,3,"used?",60)
AddGadgetColumn(#g_icon_Vars,4,"value changes",60)
AddGadgetColumn(#g_icon_Vars,5,"calculation",60)
AddGadgetColumn(#g_icon_Vars,6,"comparison",60)
AddGadgetColumn(#g_icon_Vars,7,"argument",60)
TextGadget(#g_text_spezial,10,620,100,20,"special usage:")
CheckBoxGadget(#g_check_return,  10, 640, 100, 20, "return")
CheckBoxGadget(#g_check_gosub,   10, 660, 100, 20, "gosub")
CheckBoxGadget(#g_check_goto,    10, 680, 100, 20, "goto")
CheckBoxGadget(#g_check_if,      110, 640, 100, 20, "if")
CheckBoxGadget(#g_check_for,     110, 660, 100, 20, "for")
CheckBoxGadget(#g_check_foreach, 110, 680, 100, 20, "foreach")
CheckBoxGadget(#g_check_while,   210, 640, 100, 20, "while")
CheckBoxGadget(#g_check_repeat,  210, 660, 100, 20, "repeat")
CheckBoxGadget(#g_check_select,  210, 680, 100, 20, "select")
TextGadget(#g_text_dectype, 320,620,100,20,"declaration:")
TextGadget(#g_text_vartype, 320,640,100,20,"declarated as:")
TextGadget(#g_text_dectype2, 420,620,100,20,"")
TextGadget(#g_text_vartype2, 420,640,100,20,"")

Define a.l
Define b.l
Define correct.l

For a=0 To proc_size
  If a=0
    
    correct=0
    For b=0 To proc(a)\procVarCount-1
      If proc(a)\procVars[b]\varParent
        correct+1
      EndIf
    Next
    
    proc(0)\procVarCount-correct
    
    AddGadgetItem(#g_icon_Procs,-1,proc(a)\procName + Chr(10)+Chr(10)+Chr(10)+Str(proc(a)\procVarCount))
  Else
    AddGadgetItem(#g_icon_Procs,-1,proc(a)\procName + ")"+Chr(10)+Str(proc(a)\procStart)+"-"+Str(proc(a)\procEnd)+Chr(10)+Str(proc(a)\procUsable)+Chr(10)+Str(proc(a)\procVarCount))
  EndIf
Next

Global g_id.l

Procedure FillSpecial(number.l)
  
  If number < 0
    ProcedureReturn #False
  EndIf
  
  SetGadgetState(#g_check_gosub,0)
  SetGadgetState(#g_check_goto,0)
  SetGadgetState(#g_check_if,0)
  SetGadgetState(#g_check_for,0)
  SetGadgetState(#g_check_foreach,0)
  SetGadgetState(#g_check_while,0)
  SetGadgetState(#g_check_repeat,0)
  SetGadgetState(#g_check_select,0)
  SetGadgetState(#g_check_return,0)
  
  If proc(g_id)\procVars[number]\varUsable & #var_spc_Return
    SetGadgetState(#g_check_return,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_GoSub
    SetGadgetState(#g_check_gosub,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_GoTo
    SetGadgetState(#g_check_goto,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_If
    SetGadgetState(#g_check_if,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_For
    SetGadgetState(#g_check_for,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_ForEach
    SetGadgetState(#g_check_foreach,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_While
    SetGadgetState(#g_check_while,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_Repeat
    SetGadgetState(#g_check_repeat,1)
  EndIf
  If proc(g_id)\procVars[number]\varUsable & #var_spc_Select
    SetGadgetState(#g_check_select,1)
  EndIf
  
  SetGadgetText(#g_text_dectype2, LTrim(Commands(proc(g_id)\procVars[number]\varType)))
  
  Protected tempstring.s
  
  Select proc(g_id)\procVars[number]\varDecType
    Case "f"
      tempstring = "float"
    Case "l",""
      tempstring = "long"
    Case "w"
      tempstring = "word"
    Case "i"
      tempstring = "integer"
    Case "d"
      tempstring = "double"
    Case "q"
      tempstring = "quad"
    Case "s"
      tempstring = "string"
    Case "c"
      tempstring = "character"
    Case "b"
      tempstring = "byte"
    Default
      tempstring = proc(g_id)\procVars[number]\varDecType
  EndSelect
  
  SetGadgetText(#g_text_vartype2, tempstring)
  
EndProcedure
Procedure FillVars(id.l)
  
  If id >= 0
    g_id = id
  Else
    ProcedureReturn #False
  EndIf
  
  ClearGadgetItems(#g_icon_Vars)
  
  Protected tempstring.s
  Protected a.l
  
  For a=0 To proc(id)\procVarCount-1
    
    If id=0 And proc(id)\procVars[a]\varParent
      Continue
    EndIf
    
    tempstring = ""
    
    If Right(proc(id)\procVars[a]\varName,1) = "("
      tempstring + proc(id)\procVars[a]\varName + ")"
    Else
      tempstring + proc(id)\procVars[a]\varName
    EndIf
    
    tempstring + Chr(10) + Str(proc(id)\procVars[a]\varLine)
    If proc(id)\procStart = proc(id)\procVars[a]\varLine
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    
    If proc(id)\procVars[a]\varUsable & #var_use_anyUse
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    If proc(id)\procVars[a]\varUsable & #var_use_storeVal
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    If proc(id)\procVars[a]\varUsable & #var_use_calculate
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    If proc(id)\procVars[a]\varUsable & #var_use_compare
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    If proc(id)\procVars[a]\varUsable & #var_use_argument
      tempstring + Chr(10) + "X"
    Else
      tempstring + Chr(10)
    EndIf
    
    AddGadgetItem(#g_icon_Vars,-1,tempstring)
    
  Next
  
EndProcedure

FillVars(0)
FillSpecial(0)

Define EventID

Repeat
  
  EventID = WaitWindowEvent()
  
  Select EventID
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #g_icon_Procs
          FillVars(GetGadgetState(#g_icon_Procs))
          FillSpecial(0)
        Case #g_icon_Vars
          FillSpecial(GetGadgetState(#g_icon_Vars))
      EndSelect
      
  EndSelect
  
  
Until EventID = #PB_Event_CloseWindow
PS, these are just some keywords to help others when search PB Forums and looking for a way to check variables

Variable Checking
Checking for unused variables
Checking for unused declared variables
Checking for Procedure calls
Checking for unused Procedure calls
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 6202
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Variable Checking

Post by mk-soft »

Very nice :wink:

but not supported includefiles...

Perhaps can help this modify funktion from my project to load all includefiles

Update - Added Recursive search

Code: Select all


Global NewList ListIncludeFiles.s()

; ***************************************************************************************

Procedure FindStringLeft(String.s, StringToFind.s, Startposition.l = 0)

  Protected len, len2, index
  
  len = Len(String)
  len2 = Len(StringToFind)
  If Startposition = 0
    Startposition = len
  EndIf
  For index = Startposition To 1 Step - 1
    If Mid(String, index, len2) = StringToFind
      ProcedureReturn index
    EndIf
  Next
  ProcedureReturn 0
  
EndProcedure

; ***************************************************************************************

Procedure DoLoadIncludeFileList(File.s, Path_Project.s = "")

  Protected FF, Path.s, IFile.s, Path2.s, Line.s, Pos, PosB, PosE, temp.s
  
  If File <> ""
    If Path_Project <> ""
      Path2 = GetPathPart(path_project)
      File = Path2 + File
    Else
      path2 = GetPathPart(File)
    EndIf
    
    FF = ReadFile(#PB_Any, File)
    If FF
      Ft = ReadStringFormat(FF)
      If Not ft
        ft = #PB_UTF8
      EndIf
      
      While Not Eof(FF)
        IFile = ""
    
        Line = ReadString(FF, Ft)
  
        Pos = FindString(Line, "IncludePath", 1)
        If FindStringLeft(Line, ";", Pos) Or FindStringLeft(Line, #DQUOTE$, Pos)
          Pos = 0
        EndIf
        If Pos
          PosB = FindString(Line, #DQUOTE$, Pos + 12) + 1
          PosE = FindString(Line, #DQUOTE$, PosB)
          If PosB And PosE
            Path = Mid(Line, PosB, PosE - PosB)
          EndIf
        EndIf
  
        Pos = FindString(Line, "IncludeFile", 1)
        If FindStringLeft(Line, ";", Pos) Or FindStringLeft(Line, #DQUOTE$, Pos)
          Pos = 0
        EndIf
        If Pos
          PosB = FindString(Line, #DQUOTE$, Pos + 12) + 1
          PosE = FindString(Line, #DQUOTE$, PosB)
          If PosB And PosE
            IFile = Mid(Line, PosB, PosE - PosB)
          EndIf
        EndIf
  
        Pos = FindString(Line, "XIncludeFile", 1)
        If FindStringLeft(Line, ";", Pos) Or FindStringLeft(Line, #DQUOTE$, Pos)
          Pos = 0
        EndIf
        If Pos
          PosB = FindString(Line, #DQUOTE$, Pos + 13) + 1
          PosE = FindString(Line, #DQUOTE$, PosB)
          If PosB And PosE
            IFile = Mid(Line, PosB, PosE - PosB)
          EndIf
        EndIf
        
        If IFile <> ""
          temp = GetPathPart(IFile)
          
          If temp = ""
            temp = Path2 + IFile
          ElseIf Left(temp,1) = "\"
            temp = Left(Path2, Len(path2) - 1) + IFile
          Else
            temp = IFile
          EndIf
          Repeat ; No LOOP
            ForEach ListIncludeFiles()
              If UCase(ListIncludeFiles()) = UCase(temp)
                Break 2 ; No Add
              EndIf
            Next
            LastElement(ListIncludeFiles())
            AddElement(ListIncludeFiles())
            ListIncludeFiles() = temp
            ; Recurive
            DoLoadIncludeFileList(temp)
          Until #True
        EndIf
      Wend
      CloseFile(FF)
    EndIf
  EndIf

EndProcedure

; ***************************************************************************************

file.s = OpenFileRequester("Open PB-File", "", "", 0)
If Bool(file)
  DoLoadIncludeFileList(GetFilePart(file), GetPathPart(file))
  ForEach ListIncludeFiles()
    Debug ListIncludeFiles()
  Next
EndIf
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
Bisonte
Addict
Addict
Posts: 1305
Joined: Tue Oct 09, 2007 2:15 am

Re: Variable Checking

Post by Bisonte »

I tried to use it with a code (77k lines) without includes : The same error (array index out of bounds)

It seems that this error has nothing todo with includefiles ?
PureBasic 6.21 (Windows x64) | Windows 11 Pro | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
English is not my native language... (I often use DeepL.)
Top
Post Reply

Return to “Coding Questions”