Check Variables

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
gnasen
Enthusiast
Enthusiast
Posts: 282
Joined: Wed Sep 24, 2008 12:21 am

Check Variables

Post by gnasen »

I programmed this tool as a little helper for all purebasic coders as a result of this thread: http://www.purebasic.fr/english/viewtopic.php?t=35703
It can be used as a plug-in (just have a look at the pictures)

The tool checks your code for procedures and variables and analysis their behaviour. So its easy to have an overlook over all your vars to find unused vars etc.

I hope it will help some people of you.
I cant promise that I found all bugs, but I can say, that it runs fine on all my codes.

You can also use it as standalone app, you dont have to set it in the IDE.

EnableExplicit has to be on (only valid declarations are checked)!

Download Link is no more available, sourcecode is posted

Pictures:
Image
Image
Image
Image

Some explanation:

Upper List:
Here are all selfmade Procedures listet. You can see their name, the lines they start and end, how often they are called from different places of the code and how much vars are defined in them.

Middle List:
Here are all defined vars of the specified Procedure listet. The single things mean:
Name (">>" means global var used)
Line (in which they are defined)
Header (defined in the procedure header?)
Usage? (If they are used at all)
Value Change (if it changes the value in the procedure)
Calculation (used in calculations like "+","-" or bit things like "!","&")
Comparison (used in comparisons)
argument (given as an argument to a procedure)

Lower List:
Do they appear in a special case like an "If" Statement.

Problems:
Problems could appear with Macros and IncludeFile commands, atm they are just not traced. If you want to check a bigger project with include Files, you have to merge the files (saw a tool for that here before some time)

Report Bugs, use enableexplicit and Have fun.
Last edited by gnasen on Tue Jun 02, 2009 7:25 pm, edited 9 times in total.
pb 5.11
User avatar
idle
Always Here
Always Here
Posts: 5042
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Post by idle »

that could be very very useful. Thanks :D
Windows 11, Manjaro, Raspberry Pi OS
Image
gnasen
Enthusiast
Enthusiast
Posts: 282
Joined: Wed Sep 24, 2008 12:21 am

Post by gnasen »

added:
-start and end lines for Procedures
-Header (shows if the var was declared in the procedure header)

increased:
-readability of the source
-speed

killed:
-some minor bugs
pb 5.11
Amundo
Enthusiast
Enthusiast
Posts: 191
Joined: Thu Feb 16, 2006 1:41 am
Location: New Zealand

Post by Amundo »

Hi gnasen,

Any chance of getting the source code to this?

The files are no longer available :(

Thanks!
Win8.1, PB5.x, okayish CPU, onboard video card, fuzzy monitor (or is that my eyesight?)
"When the facts change, I change my mind" - John Maynard Keynes
gnasen
Enthusiast
Enthusiast
Posts: 282
Joined: Wed Sep 24, 2008 12:21 am

Post by gnasen »

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.l
  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,600,520,GetFilePart(Sourcefile),#PB_Window_SystemMenu|#PB_Window_MinimizeGadget)

CreateGadgetList(WindowID(0))
ListIconGadget(#g_icon_Procs, 10,10,580,200,"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,210,580,200,"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,420,100,20,"special usage:")
CheckBoxGadget(#g_check_return,  10, 440, 100, 20, "return")
CheckBoxGadget(#g_check_gosub,   10, 460, 100, 20, "gosub")
CheckBoxGadget(#g_check_goto,    10, 480, 100, 20, "goto")
CheckBoxGadget(#g_check_if,      110, 440, 100, 20, "if")
CheckBoxGadget(#g_check_for,     110, 460, 100, 20, "for")
CheckBoxGadget(#g_check_foreach, 110, 480, 100, 20, "foreach")
CheckBoxGadget(#g_check_while,   210, 440, 100, 20, "while")
CheckBoxGadget(#g_check_repeat,  210, 460, 100, 20, "repeat")
CheckBoxGadget(#g_check_select,  210, 480, 100, 20, "select")
TextGadget(#g_text_dectype, 320,420,100,20,"declaration:")
TextGadget(#g_text_vartype, 320,440,100,20,"declarated as:")
TextGadget(#g_text_dectype2, 420,420,100,20,"")
TextGadget(#g_text_vartype2, 420,440,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
  
  ClearGadgetItemList(#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

 
Thats it. Any improvements are welcome (I tried it with all my projects and it worked fine, but you know, Murphys Law and so on ;) )

PS: Enumerate with 2^n steps would be awesome
PPS: A tag to fold text in the Forum would be gorgeous
Last edited by gnasen on Wed Jun 03, 2009 5:18 pm, edited 1 time in total.
pb 5.11
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

Post by c4s »

Nice tool...but what's that:

Code: Select all

Procedure test()
	Protected v1.b, v2.c, v3.d, v4.f, v5.i, v6.l, v7.q, v8.s
EndProcedure
Result wrote:procedures=1,...,variables=1

v1: line=2, declaration=Protected,declared as=long
:?:
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Looks to be a very useful tool. :D

I've been wanting to put something like this together for some time but never got around to it. This is great.

Many thanks for sharing with us.

cheers
gnasen
Enthusiast
Enthusiast
Posts: 282
Joined: Wed Sep 24, 2008 12:21 am

Post by gnasen »

c4s wrote:

Code: Select all

Procedure test()
	Protected v1.b, v2.c, v3.d, v4.f, v5.i, v6.l, v7.q, v8.s
EndProcedure
Result wrote:procedures=1,...,variables=1
v1: line=2, declaration=Protected,declared as=long
Good that you say that, I noticed that I havent uploaded the latest version.

The Code above is updated with the more newer one.
pb 5.11
Amundo
Enthusiast
Enthusiast
Posts: 191
Joined: Thu Feb 16, 2006 1:41 am
Location: New Zealand

Post by Amundo »

Thank you! :)
Win8.1, PB5.x, okayish CPU, onboard video card, fuzzy monitor (or is that my eyesight?)
"When the facts change, I change my mind" - John Maynard Keynes
Denis
Enthusiast
Enthusiast
Posts: 704
Joined: Fri Apr 25, 2003 5:10 pm
Location: Doubs - France

Post by Denis »

gnasen,
goog idea this tools, it's lacking in PB.


i've tested a bit your code.

it seems that protected var based on structure are not correctly detected as used ones.

I get an error , array index out of bounds line 664 with a file with 9377 lines.
May be it's because it's an include file.

Code: Select all

          addProcedure = checkCodeSpecialSub(code(a)\code,"EndProcedure")
          
          If addProcedure
               proc(b)\procEnd     = a   ;   <---  error here
               proc(b)\procEndLine = code(a)\line
               b+1
               inProc = #False
          EndIf
          
          If inProc = #True
               CheckCodeVars(@proc(b),code(a)\code,code(a)\line)
          EndIf
A+
Denis
somic
User
User
Posts: 66
Joined: Sun Jun 29, 2008 9:11 am
Location: Italy
Contact:

Re: Check Variables

Post by somic »

Hi,

I get the same runtime error at the same line but only with "complicate" code (many Includefile) and sometime the VarType is not correct (or not updated in the output form, when changing the selection).

Any bug fix up today?

Rgds
----------------------------------------------------------------------------
Semel in anno licet insanire (Seneca)
email: somic@libero.it, website: http://www.semelinanno.com
gnasen
Enthusiast
Enthusiast
Posts: 282
Joined: Wed Sep 24, 2008 12:21 am

Re: Check Variables

Post by gnasen »

Im sorry, but I dont have much time at the moment (university etc...) and if I get to program, I only work at my main project.
However I may update this tool from scratch, because I have some good Ideas to make this better. Until then there will unfortunately be no updates :(
pb 5.11
yrreti
Enthusiast
Enthusiast
Posts: 546
Joined: Tue Oct 31, 2006 4:34 am

Re: Check Variables

Post by yrreti »

Hi gnasen

I know this is an old thread, :oops: but have you ever done any more work on this ?
It really sounds interesting and definitely useful - especially if you have a lot of code
to check over.
SniffTheGlove
Enthusiast
Enthusiast
Posts: 122
Joined: Sat Nov 19, 2011 6:51 pm

Re: Check Variables

Post by SniffTheGlove »

Does anybody have an updated code to work with 5.21

I have tried to update it but it keeps coming up with Syntax errors and "native types can't be used with pointers" errors etc
User avatar
Tenaja
Addict
Addict
Posts: 1948
Joined: Tue Nov 09, 2010 10:15 pm

Re: Check Variables

Post by Tenaja »

SniffTheGlove wrote:Does anybody have an updated code to work with 5.21

I have tried to update it but it keeps coming up with Syntax errors and "native types can't be used with pointers" errors etc
With old code giving you that error, delete the .i (i being any variable type suffix) from all pointer variables (those starting with an asterisk).
Post Reply