It is currently Mon Nov 30, 2020 9:01 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 19 posts ]  Go to page 1, 2  Next
Author Message
 Post subject: Check Variables
PostPosted: Sun Dec 21, 2008 2:58 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Sep 24, 2008 12:21 am
Posts: 282
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.

_________________
pb 5.11


Last edited by gnasen on Tue Jun 02, 2009 7:25 pm, edited 9 times in total.

Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Dec 21, 2008 5:25 am 
Offline
Addict
Addict
User avatar

Joined: Fri Sep 21, 2007 5:52 am
Posts: 3554
Location: New Zealand
that could be very very useful. Thanks :D


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Dec 21, 2008 2:34 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Sep 24, 2008 12:21 am
Posts: 282
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


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Tue Jun 02, 2009 1:01 pm 
Offline
Enthusiast
Enthusiast

Joined: Thu Feb 16, 2006 1:41 am
Posts: 180
Location: New Zealand
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


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Tue Jun 02, 2009 7:19 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Sep 24, 2008 12:21 am
Posts: 282
Code:
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

_________________
pb 5.11


Last edited by gnasen on Wed Jun 03, 2009 5:18 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Wed Jun 03, 2009 10:55 am 
Offline
Addict
Addict

Joined: Thu Nov 01, 2007 5:37 pm
Posts: 1981
Location: Germany
Nice tool...but what's that:
Code:
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

:?:


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Wed Jun 03, 2009 3:50 pm 
Offline
Addict
Addict

Joined: Wed Aug 24, 2005 8:39 am
Posts: 2736
Location: Southwest OH - USA
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


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Wed Jun 03, 2009 5:20 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Sep 24, 2008 12:21 am
Posts: 282
c4s wrote:
Code:
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


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Thu Jun 04, 2009 12:31 am 
Offline
Enthusiast
Enthusiast

Joined: Thu Feb 16, 2006 1:41 am
Posts: 180
Location: New Zealand
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


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Thu Jun 04, 2009 6:38 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Fri Apr 25, 2003 5:10 pm
Posts: 555
Location: Doubs - France
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:
          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


Top
 Profile  
Reply with quote  
 Post subject: Re: Check Variables
PostPosted: Mon Dec 21, 2009 7:35 am 
Offline
User
User

Joined: Sun Jun 29, 2008 9:11 am
Posts: 66
Location: Italy
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Check Variables
PostPosted: Mon Dec 21, 2009 9:52 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Sep 24, 2008 12:21 am
Posts: 282
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Check Variables
PostPosted: Mon Dec 10, 2012 3:15 pm 
Offline
Enthusiast
Enthusiast

Joined: Tue Oct 31, 2006 4:34 am
Posts: 540
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Check Variables
PostPosted: Mon Mar 17, 2014 3:30 am 
Offline
Enthusiast
Enthusiast

Joined: Sat Nov 19, 2011 6:51 pm
Posts: 122
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Check Variables
PostPosted: Mon Mar 17, 2014 11:41 am 
Offline
Addict
Addict
User avatar

Joined: Tue Nov 09, 2010 10:15 pm
Posts: 1687
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).


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 19 posts ]  Go to page 1, 2  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 7 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye