[Prolint-cvs] SF.net SVN: prolint: [273] trunk/prolint
Brought to you by:
johnallengreen,
jurjen
Menu
▾
▴
[Prolint-cvs] SF.net SVN: prolint: [273] trunk/prolint
|
From: <ju...@us...> - 2006-08-05 09:26:29
|
Revision: 273 Author: jurjen Date: 2006-08-05 02:25:43 -0700 (Sat, 05 Aug 2006) ViewCVS: http://svn.sourceforge.net/prolint/?rev=273&view=rev Log Message: ----------- clean up the root of prolint; move files to subdirectories (not finished yet, but it works so far) Modified Paths: -------------- trunk/prolint/ab/ablint.p trunk/prolint/desktop.w trunk/prolint/filters/_template.pp trunk/prolint/filters/exclude.p trunk/prolint/filters/ignoreab.p trunk/prolint/filters/nowarn.p trunk/prolint/help/newrule.htxt trunk/prolint/help/overview.htxt trunk/prolint/help/run_prolint.htxt trunk/prolint/help/settings.htxt trunk/prolint/lintproglist.p trunk/prolint/mvo-lintFileList.p trunk/prolint/outputhandlers/logwin.w trunk/prolint/outputhandlers/logwin8.w trunk/prolint/rtb/checkin-event.p trunk/prolint/rtb/lintobj.p trunk/prolint/rtb/linttask.p trunk/prolint/ruleparams.i trunk/prolint/start.p trunk/prolint/test.p Added Paths: ----------- trunk/prolint/core/filterplugins.p trunk/prolint/core/lintsuper.p trunk/prolint/core/prolint.p trunk/prolint/core/propsuper.p trunk/prolint/images/prolint.ico Removed Paths: ------------- trunk/prolint/filterplugins.p trunk/prolint/lintsuper.p trunk/prolint/prolint.ico trunk/prolint/prolint.p trunk/prolint/propsuper.p trunk/prolint/publish.i trunk/prolint/publish_char.i trunk/prolint/publish_log.i trunk/prolint/publish_result.i trunk/prolint/subscribe.i trunk/prolint/unsubscribe.i trunk/prolint/v8pubsub.i trunk/prolint/v8pubsub.p Modified: trunk/prolint/ab/ablint.p =================================================================== --- trunk/prolint/ab/ablint.p 2006-08-05 08:59:22 UTC (rev 272) +++ trunk/prolint/ab/ablint.p 2006-08-05 09:25:43 UTC (rev 273) @@ -26,7 +26,7 @@ DEFINE INPUT PARAMETER pSourceFile AS CHARACTER NO-UNDO. -RUN prolint/prolint.p (pSourceFile, +RUN prolint/core/prolint.p (pSourceFile, ?, "AppBuilder":U, TRUE). Copied: trunk/prolint/core/filterplugins.p (from rev 262, trunk/prolint/filterplugins.p) =================================================================== --- trunk/prolint/core/filterplugins.p (rev 0) +++ trunk/prolint/core/filterplugins.p 2006-08-05 09:25:43 UTC (rev 273) @@ -0,0 +1,166 @@ +/* ------------------------------------------------------------------ + file : prolint/core/filterplugins.p + purpose : loads filter plug-ins + ----------------------------------------------------------------- + + Copyright (C) 2001,2002 Jurjen Dijkstra + + This file is part of Prolint. + + Prolint is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + Prolint is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with Prolint; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + ------------------------------------------------------------------ */ + +{prolint/dlc-version.i} + +DEFINE INPUT PARAMETER pProfileDirectory AS CHARACTER NO-UNDO. + +DEFINE VARIABLE hLintSuper AS HANDLE NO-UNDO. +FUNCTION RelativeFilename RETURNS CHARACTER (pFileName AS CHARACTER) IN hLintSuper. + +/* temp-table definition tt_filters + contains the list of filter plugins */ +DEFINE TEMP-TABLE tt_filters NO-UNDO + FIELD filtername AS CHARACTER + FIELD hpFilter AS HANDLE. + +/* local tt_ignore. This is a filter, but not a plug-in. + this one is used for _proparse_ prolint-nowarn directives + for rules that cannot use proparse, like "whole-index" and "sort-access" */ +DEFINE TEMP-TABLE tt_ignore NO-UNDO + FIELD Sourcefile AS CHARACTER + FIELD RuleID AS CHARACTER + FIELD LineNumber AS INTEGER + INDEX idx_1 AS PRIMARY SourceFile RuleID LineNumber. + +ON "CLOSE":U OF THIS-PROCEDURE DO: + FOR EACH tt_filters : + APPLY "CLOSE":U TO tt_filters.hpFilter. + END. + DELETE PROCEDURE THIS-PROCEDURE. +END. + +RUN InitializePlugins. +SUBSCRIBE TO "Prolint_Status_FileEnd" ANYWHERE. +RETURN. + +/* ------------------------ internal procedures ------------------------------ */ + +PROCEDURE SethLintSuper : + DEFINE INPUT PARAMETER ph AS HANDLE NO-UNDO. + hLintSuper = ph. +END PROCEDURE. + +PROCEDURE InitializePlugins : + /* purpose: run filters\*.p persistent */ + DEFINE VARIABLE fulldir AS CHARACTER NO-UNDO. + DEFINE VARIABLE progname AS CHARACTER NO-UNDO. + + FILE-INFORMATION:FILE-NAME = "prolint/filters":U. + fulldir = FILE-INFORMATION:FULL-PATHNAME. + INPUT FROM OS-DIR ( fulldir ). + REPEAT: + IMPORT progname. + IF progname MATCHES "*~~.p":U THEN + DO: + CREATE tt_filters. + RUN VALUE( "prolint/filters/":U + progname ) + PERSISTENT SET tt_filters.hpFilter ( pProfileDirectory ). + tt_filters.filtername = LC( SUBSTRING( progname, 1, LENGTH( progname ) - 2 ) ). + END. + END. + INPUT CLOSE. + +END PROCEDURE. + + + +PROCEDURE AddNowarnFilter : + /* purpose: add entries for rules that do not use Proparse, + but still need to suppress warnings from _proparse_ directives + like rule whole-index */ + DEFINE INPUT PARAMETER pRuleID AS CHARACTER NO-UNDO. + DEFINE INPUT PARAMETER pSourcefile AS CHARACTER NO-UNDO. + DEFINE INPUT PARAMETER pLineNumber AS INTEGER NO-UNDO. + + DEFINE VARIABLE relname AS CHARACTER NO-UNDO. + relname = RelativeFilename( pSourcefile ). + + FIND tt_Ignore WHERE + tt_Ignore.sourcefile = relname + AND tt_Ignore.RuleId = pRuleId + AND tt_Ignore.LineNumber = pLineNumber NO-ERROR. + IF NOT AVAILABLE tt_Ignore THEN + DO: + CREATE tt_Ignore. + ASSIGN + tt_Ignore.sourcefile = relname + tt_Ignore.RuleId = pRuleId + tt_Ignore.LineNumber = pLineNumber. + END. + + +END PROCEDURE. + + + +PROCEDURE GetFilterResult : +/* purpose : call each filter's GetFilterResult procedure */ + DEFINE INPUT PARAMETER pCompilationUnit AS CHARACTER NO-UNDO. + DEFINE INPUT PARAMETER pFullSource AS CHARACTER NO-UNDO. + DEFINE INPUT PARAMETER pRelativeSource AS CHARACTER NO-UNDO. + DEFINE INPUT PARAMETER pLineNumber AS INTEGER NO-UNDO. + DEFINE INPUT PARAMETER pRuleID AS CHARACTER NO-UNDO. + DEFINE INPUT PARAMETER pIgnoreAB AS LOGICAL NO-UNDO. + DEFINE INPUT-OUTPUT PARAMETER pDescription AS CHARACTER NO-UNDO. + DEFINE INPUT-OUTPUT PARAMETER pSeverity AS INTEGER NO-UNDO. + DEFINE OUTPUT PARAMETER filteredby AS CHARACTER NO-UNDO. + + DEFINE VARIABLE filtered AS LOGICAL NO-UNDO. + + + filtered = CAN-FIND(tt_ignore WHERE tt_ignore.SourceFile = pRelativeSource + AND tt_ignore.RuleID = pRuleID + AND tt_ignore.LineNumber = pLineNumber). + + IF filtered THEN + filteredby = "pragma":U. + ELSE + FOR EACH tt_filters : + RUN GetFilterResult IN tt_filters.hpFilter (pCompilationUnit, + pFullSource, + pRelativeSource, + pLineNumber, + pRuleID, + pIgnoreAB, + INPUT-OUTPUT pDescription, + INPUT-OUTPUT pSeverity, + OUTPUT filtered). + IF filtered THEN DO: + filteredby = TRIM(filteredby + ",":U + tt_filters.filtername,",":U). + RETURN. + END. + END. + +END PROCEDURE. + + +PROCEDURE Prolint_Status_FileEnd : +/* purpose : linting of a compilation unit is done. You can clean up now */ + FOR EACH tt_ignore : + DELETE tt_ignore. + END. + +END PROCEDURE. + Copied: trunk/prolint/core/lintsuper.p (from rev 265, trunk/prolint/lintsuper.p) =================================================================== --- trunk/prolint/core/lintsuper.p (rev 0) +++ trunk/prolint/core/lintsuper.p 2006-08-05 09:25:43 UTC (rev 273) @@ -0,0 +1,512 @@ +/* ------------------------------------------------------------------ + file : prolint/core/lintsuper.p + purpose : super procedure for every rule + ----------------------------------------------------------------- + + Copyright (C) 2001,2002 Jurjen Dijkstra + + This file is part of Prolint. + + Prolint is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + Prolint is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with Prolint; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + ------------------------------------------------------------------ */ + +{prolint/dlc-version.i} + +DEFINE INPUT PARAMETER hparser AS HANDLE NO-UNDO. +DEFINE INPUT PARAMETER hpFilterPlugins AS HANDLE NO-UNDO. +{proparse/api/proparse.i hparser} + +DEFINE VARIABLE IgnoreAB AS LOGICAL NO-UNDO INITIAL FALSE. +DEFINE VARIABLE ActivePragma AS INTEGER NO-UNDO. +DEFINE VARIABLE ActiveSeverity AS INTEGER NO-UNDO. +DEFINE VARIABLE AbortSearch AS LOGICAL NO-UNDO. + + /* tt_procedure lists every procedure and function in a compilation unit */ + {prolint/ttprocedure.i} + + /* tt_cacheRelativeName makes function RelativeFilename slightly faster */ + DEFINE TEMP-TABLE tt_cacheRelativeName NO-UNDO + FIELD longname AS CHAR + FIELD relativename AS CHAR + INDEX idx_1 AS PRIMARY UNIQUE longname. + DEFINE VARIABLE SearchPath AS CHARACTER NO-UNDO. + +ON "CLOSE":U OF THIS-PROCEDURE DO: + DELETE PROCEDURE THIS-PROCEDURE. +END. + +/* -------------------------------------------------------------------------------- + maintenance procedures for tt_procedure + (see BuildProcedureList in prolint.p) + -------------------------------------------------------------------------------- */ + +PROCEDURE ProcedureListClear : + /* empty the temp-table. */ + FOR EACH tt_procedure : + DELETE tt_procedure. + END. +END PROCEDURE. + + +PROCEDURE ProcedureListGet : + /* copy temp-table tt_procedure to calling procedure. + It would be cleaner to only output the handle, but then the calling procedure would + have to use dynamic FIND statements to navigate the temp-table. That's slightly slower */ + DEFINE OUTPUT PARAMETER TABLE FOR tt_procedure. +END PROCEDURE. + + +PROCEDURE ProcedureListAdd : + /* create a new record tt_procedure */ + DEFINE INPUT PARAMETER pProcType AS CHARACTER NO-UNDO. + DEFINE INPUT PARAMETER pProcName AS CHARACTER NO-UNDO. + DEFINE INPUT PARAMETER pPrototype AS LOGICAL NO-UNDO. + DEFINE INPUT PARAMETER pStartnode AS INTEGER NO-UNDO. + + DEFINE VARIABLE vstartnode AS INTEGER NO-UNDO. + + ASSIGN + vstartnode = parserGetHandle(). + + parserCopyHandle(pStartnode, vstartnode). + + CREATE tt_procedure. + ASSIGN tt_procedure.proctype = pProctype + tt_procedure.procname = pProcName + tt_procedure.prototype = pPrototype + tt_procedure.startnode = vStartnode. + + /* do not releaseHandle(vStartnode)! */ + +END PROCEDURE. + + +/* -------------------------------------------------------------------------------- + misc functions and procedures + -------------------------------------------------------------------------------- */ + +PROCEDURE parsePropath : +/* purpose: makes function RelativeFilename faster */ + DEFINE VARIABLE i AS INTEGER NO-UNDO. + + DO i=1 TO NUM-ENTRIES(PROPATH) : + /* ignore PL files */ + FILE-INFO:FILE-NAME = ENTRY(i, PROPATH). + IF FILE-INFO:FULL-PATHNAME<>? AND FILE-INFO:FILE-TYPE MATCHES "*D*":U THEN DO: + SearchPath = SearchPath + ",":U + FILE-INFO:FULL-PATHNAME. + END. + END. + SearchPath = TRIM(SearchPath, ",":U). + SearchPath = REPLACE(SearchPath, "~\":U, "/"). +END PROCEDURE. + + +FUNCTION RelativeFilename RETURNS CHARACTER (pFileName AS CHARACTER): + DEFINE VARIABLE i AS INTEGER NO-UNDO. + DEFINE VARIABLE subdir AS CHARACTER NO-UNDO. + DEFINE VARIABLE tmp AS CHARACTER NO-UNDO. + DEFINE VARIABLE shortpath AS CHARACTER NO-UNDO. + + IF SearchPath = "" THEN RUN parsePropath. + pFileName = REPLACE(pFileName, "~\", "/"). + + /* search pFileName in cache, for speed */ + FIND tt_cacheRelativeName WHERE tt_cacheRelativeName.longname = pFileName NO-ERROR. + IF AVAILABLE tt_cacheRelativeName THEN + RETURN tt_cacheRelativeName.relativename. + + IF SUBSTRING(pFileName, 1, 2) = './':U THEN + pFileName = SUBSTRING(pFileName, 3). + + DO i=1 to num-entries(SearchPath) : + subdir = entry(i, SearchPath). + if length(subdir)<length(pFileName) then + if subdir = substring(pFileName,1,length(subdir)) then + DO: + shortpath = SUBSTRING(pFileName, length(subdir) + 2). + if length(shortpath) < length(pFileName) then DO: + FILE-INFO:FILE-NAME = shortpath. + IF REPLACE(FILE-INFO:FULL-PATHNAME,"~\","/") = pFileName THEN DO: + CREATE tt_cacheRelativeName. + ASSIGN tt_cacheRelativeName.longname = pFileName + tt_cacheRelativeName.relativename = shortpath. + RETURN shortpath. + END. + END. + END. + END. + RETURN pFileName. +END FUNCTION. + + +PROCEDURE GetFilePosition : +/* purpose: return linenumber and sourcefile where theNode is found */ + DEFINE INPUT PARAMETER theNode AS INTEGER NO-UNDO. + DEFINE OUTPUT PARAMETER LineNumber AS INTEGER NO-UNDO. + DEFINE OUTPUT PARAMETER SourceFile AS CHARACTER NO-UNDO. + + DEFINE VARIABLE subnode AS INTEGER NO-UNDO. + DEFINE VARIABLE numresults AS INTEGER NO-UNDO. + DEFINE VARIABLE i AS INTEGER NO-UNDO. + + ASSIGN + LineNumber = parserGetNodeLine(theNode) + SourceFile = parserGetNodeFilename(theNode). + + /* if TheNode is a synthetic node, then LineNumber will be 0 and SourceFile will be "". + in that case, query children/grandchildren until you find any non-synthetic node. + Just assume it's on the same line */ + IF LineNumber EQ 0 OR SourceFile EQ "" THEN DO: + subnode = parserGetHandle(). + numResults = parserQueryCreate(TheNode, "getfileposition":U, "":U). + i = 1. + DO WHILE (i LE numResults) AND (LineNumber EQ 0 OR SourceFile EQ ""): + parserQueryGetResult("getfileposition":U, i, subnode). + ASSIGN + LineNumber = parserGetNodeLine(subnode) + SourceFile = parserGetNodeFilename(subnode) + i = i + 1. + END. + parserQueryClear ("getfileposition":U). + parserReleaseHandle(subnode). + END. + + IF SourceFile NE "" THEN + SourceFile = RelativeFileName(SourceFile). + +END PROCEDURE. + + +FUNCTION GetFieldnameFromFieldref RETURNS CHARACTER (INPUT nFieldRef AS INTEGER) : + /* assuming nFieldRef is a "Field_ref" node, return the name of the field */ + + DEFINE VARIABLE child AS INTEGER NO-UNDO. + DEFINE VARIABLE retval AS CHARACTER NO-UNDO. + + child = parserGetHandle(). + + IF "ID":U <> parserNodeFirstChild(nFieldRef, child) THEN + IF "ID":U <> parserNodeNextSibling(child, child) THEN + parserNodeNextSibling(child, child). + + retval = parserGetNodeText(child). + parserReleaseHandle(child). + RETURN retval. + +END FUNCTION. + + +PROCEDURE SetRuleParameters : + /* purpose: helps {&_Proparse_ prolint-nowarn} directives */ + DEFINE INPUT PARAMETER pActivePragma AS INTEGER NO-UNDO. + DEFINE INPUT PARAMETER pActiveSeverity AS INTEGER NO-UNDO. + DEFINE INPUT PARAMETER pIgnoreAB AS LOGICAL NO-UNDO. + + ASSIGN + AbortSearch = FALSE + IgnoreAB = pIgnoreAB + ActivePragma = pActivePragma + ActiveSeverity = pActiveSeverity. + +END PROCEDURE. + + +PROCEDURE searchNode : + /* purpose: query the tree: + find all nodes of type NodeTypesToInspect within theNode. For every node + found run value(ipCallBack) which will implement the actual rule. + Params: theNode : a proparse node + ipCallBack : an internal procedure in a rule + NodeTypesToInspect : comma separated list of nodetypes */ + DEFINE INPUT PARAMETER theNode AS INTEGER NO-UNDO. + DEFINE INPUT PARAMETER ipCallBack AS CHAR NO-UNDO. + DEFINE INPUT PARAMETER NodetypesToInspect AS CHAR NO-UNDO. + + /* searching a tree (recursive) is probably faster than a query if no nodetypes are specified */ + /* actually this may not be true anymore with the latest version of proparse, have to test that */ + IF NodeTypesToInspect="" OR NodeTypesToInspect=? THEN + RUN SearchNodeTree IN TARGET-PROCEDURE (theNode, ipCallBack, NodeTypesToInspect). + ELSE + RUN searchNodeQueries IN TARGET-PROCEDURE (theNode, ipCallBack, NodeTypesToInspect). + +END PROCEDURE. + + +PROCEDURE searchNodeQueries : + /* purpose : like SearchNode, using queries in proparse */ + DEFINE INPUT PARAMETER theNode AS INTEGER NO-UNDO. + DEFINE INPUT PARAMETER ipCallBack AS CHAR NO-UNDO. + DEFINE INPUT PARAMETER NodetypesToInspect AS CHAR NO-UNDO. + + DEFINE VARIABLE numResults AS INTEGER NO-UNDO. + DEFINE VARIABLE q AS INTEGER NO-UNDO. + DEFINE VARIABLE i AS INTEGER NO-UNDO. + DEFINE VARIABLE queryname AS CHAR NO-UNDO. + DEFINE VARIABLE childnode AS INTEGER NO-UNDO. + DEFINE VARIABLE SearchChildren AS LOGICAL NO-UNDO INITIAL FALSE. + + childnode = parserGetHandle(). + + loop_nodetypes: + DO q=1 TO NUM-ENTRIES(NodetypesToInspect) : + /* invent a probably unique name */ + queryname = 'query_':U + ENTRY(q,NodetypesToInspect) + "_":U + STRING(theNode) + "_":U + STRING(q). + numResults = parserQueryCreate(theNode, queryname, ENTRY(q,NodetypesToInspect)). + loop_results: + DO i=1 TO numResults : + /* skip node if marked by FindProparseDirectives in prolint.p */ + IF parserQueryGetResult(queryname, i, childnode) THEN + IF 0=parserAttrGetI(childnode,ActivePragma) THEN + RUN VALUE(ipCallBack) IN TARGET-PROCEDURE (childnode, + OUTPUT AbortSearch, + OUTPUT SearchChildren). + IF AbortSearch THEN LEAVE loop_results. + END. + parserQueryClear(queryname). + IF AbortSearch THEN LEAVE loop_nodetypes. + END. + + parserReleaseHandle(childnode). + +END PROCEDURE. + + +PROCEDURE searchNodeTree : + /* purpose : like SearchNode, using a recursive loop. In general this is lots slower + than searchNodeQuery, although in some cases it's faster */ + DEFINE INPUT PARAMETER theNode AS INTEGER NO-UNDO. + DEFINE INPUT PARAMETER ipCallBack AS CHARACTER NO-UNDO. + DEFINE INPUT PARAMETER NodetypesToInspect AS CHARACTER NO-UNDO. + + DEFINE VARIABLE child AS INTEGER NO-UNDO. + DEFINE VARIABLE nodetype AS CHARACTER NO-UNDO. + DEFINE VARIABLE SearchChildren AS LOGICAL NO-UNDO INITIAL YES. + DEFINE VARIABLE grandchild AS INTEGER NO-UNDO. + + ASSIGN + child = parserGetHandle() + grandchild = parserGetHandle(). + + IF 0=parserAttrGetI(theNode,ActivePragma) THEN + IF (NodetypesToInspect=?) OR (LOOKUP(parserGetNodeType(theNode),NodetypesToInspect) GT 0) THEN + RUN VALUE(ipCallBack) IN TARGET-PROCEDURE (theNode, + OUTPUT AbortSearch, + OUTPUT SearchChildren). + + IF SearchChildren AND (NOT AbortSearch) THEN DO: + ASSIGN nodetype = parserNodeFirstChild(theNode,child). + DO WHILE nodetype<>"" AND (NOT AbortSearch): + + /* if child is a new node head, run searchNodeTree with it (recursion) */ + IF parserNodeFirstChild(child, grandchild)<>"" THEN + RUN searchNodeTree IN TARGET-PROCEDURE (child, ipCallBack, NodetypesToInspect). + nodetype = parserNodeNextSibling(child,child). + END. + END. + + parserReleaseHandle(child). + parserReleaseHandle(grandchild). +END. + + +PROCEDURE PublishResult : + /* purpose: if a rule finds something to complain about, it runs this procedure, + using the default severity level for this rule. + Here is an opportunity to override PUBLISH "Prolint_AddResult" */ + DEFINE INPUT PARAMETER pCompilationUnit AS CHAR NO-UNDO. /* the sourcefile we're parsing */ + DEFINE INPUT PARAMETER pSource AS CHAR NO-UNDO. /* may be an includefile */ + DEFINE INPUT PARAMETER pLineNumber AS INTEGER NO-UNDO. /* line number in pSourceFile */ + DEFINE INPUT PARAMETER pDescription AS CHAR NO-UNDO. /* human-readable hint */ + DEFINE INPUT PARAMETER pRuleID AS CHAR NO-UNDO. /* defines rule-program and maps to help */ + + RUN PublishResultSeverity IN TARGET-PROCEDURE + (pCompilationunit, + pSource, + pLineNumber, + REPLACE(pDescription,"~n":U," ":U), + pRuleID, + ActiveSeverity). + +END PROCEDURE. + + +PROCEDURE PublishResultSeverity : + /* purpose: Like PublishResult, but with extra Severity parameter. + If a rule finds something to complain about, it runs this procedure. + Here is an opportunity to override PUBLISH "Prolint_AddResult" */ + DEFINE INPUT PARAMETER pCompilationUnit AS CHAR NO-UNDO. /* the sourcefile we're parsing */ + DEFINE INPUT PARAMETER pSource AS CHAR NO-UNDO. /* may be an includefile */ + DEFINE INPUT PARAMETER pLineNumber AS INTEGER NO-UNDO. /* line number in pSourceFile */ + DEFINE INPUT PARAMETER pDescription AS CHAR NO-UNDO. /* human-readable hint */ + DEFINE INPUT PARAMETER pRuleID AS CHAR NO-UNDO. /* defines rule-program and maps to help */ + DEFINE INPUT PARAMETER pCurrentSeverity AS INTEGER NO-UNDO. /* allows override of ActiveSeverity */ + + DEFINE VARIABLE filteredby AS CHARACTER NO-UNDO. /* comma-sep list of filters that deny this warning */ + DEFINE VARIABLE severity AS INTEGER NO-UNDO. + DEFINE VARIABLE RelativeSource AS CHARACTER NO-UNDO. + + ASSIGN + pDescription = REPLACE(REPLACE(pDescription,"~n":U," ":U),CHR(9)," ":U) + severity = IF pCurrentSeverity=? THEN ActiveSeverity ELSE pCurrentSeverity. + + /* replace fully-qualified path by relative path (relative to propath) */ + IF pCompilationUnit = pSource THEN + ASSIGN + pCompilationUnit = RelativeFileName(pCompilationUnit) + RelativeSource = pCompilationUnit. + ELSE + ASSIGN + pCompilationUnit = RelativeFileName(pCompilationUnit) + RelativeSource = RelativeFileName(pSource). + + RUN GetFilterResult IN hpFilterPlugins (pCompilationUnit, + pSource, + RelativeSource, + pLineNumber, + pRuleID, + IgnoreAB, + INPUT-OUTPUT pDescription, + INPUT-OUTPUT severity, + OUTPUT filteredby). + + IF filteredby <> "" THEN RETURN. /* TODO: send filteredby to outputhandlers */ + + PUBLISH "Prolint_AddResult":U (pCompilationunit, + RelativeSource, + pLineNumber, + REPLACE(pDescription,"~n":U," ":U), + pRuleID, + severity). + +END PROCEDURE. + + +PROCEDURE PublishResultSeverityRelative : + /* purpose: Like PublishResultSeverity, but this time we know for sure that filenames are already relative filenames */ + DEFINE INPUT PARAMETER pCompilationUnit AS CHAR NO-UNDO. /* the sourcefile we're parsing */ + DEFINE INPUT PARAMETER pSource AS CHAR NO-UNDO. /* may be an includefile */ + DEFINE INPUT PARAMETER pLineNumber AS INTEGER NO-UNDO. /* line number in pSourceFile */ + DEFINE INPUT PARAMETER pDescription AS CHAR NO-UNDO. /* human-readable hint */ + DEFINE INPUT PARAMETER pRuleID AS CHAR NO-UNDO. /* defines rule-program and maps to help */ + DEFINE INPUT PARAMETER pCurrentSeverity AS INTEGER NO-UNDO. /* allows override of ActiveSeverity */ + + DEFINE VARIABLE filteredby AS CHARACTER NO-UNDO. /* comma-sep list of filters that deny this warning */ + DEFINE VARIABLE severity AS INTEGER NO-UNDO. + DEFINE VARIABLE RelativeSource AS CHARACTER NO-UNDO. + + ASSIGN + pDescription = REPLACE(REPLACE(pDescription,"~n":U," ":U),CHR(9)," ":U) + severity = IF pCurrentSeverity=? THEN ActiveSeverity ELSE pCurrentSeverity. + + RUN GetFilterResult IN hpFilterPlugins (pCompilationUnit, + pSource, + pSource, + pLineNumber, + pRuleID, + IgnoreAB, + INPUT-OUTPUT pDescription, + INPUT-OUTPUT severity, + OUTPUT filteredby). + + IF filteredby <> "" THEN RETURN. /* TODO: send filteredby to outputhandlers */ + + PUBLISH "Prolint_AddResult":U (pCompilationunit, + pSource, + pLineNumber, + REPLACE(pDescription,"~n":U," ":U), + pRuleID, + severity). + +END PROCEDURE. + + + +PROCEDURE NextNaturalNode : +/* purpose: set a handle to point at the next non-synthetic node + There are at least two reasons for wanting the next non-synthetic node: + - finding line/filename (not stored in synthetic nodes) + - finding hidden tokens (are only attached to natural nodes) + This function became more necessary with the removal of parserHiddenGetAfter(). + Author: John Green + INPUT: start handle, target handle (may be the same as each other) + OUTPUT: TRUE if a natural node was found, FALSE otherwise. + NOTES: * If the start handle is a natural node, then targetHandle=startHandle, + and the return value is TRUE. + * If no natural node is found, + then targetHandle isn't pointing to anything useful. + * Siblings of startHandle are checked, but not parents. + * Watches for "operator nodes" which were made root to its operands. + From 1 + 2, we want the "1", not the "+". + * Are PROPARSEDIRECTIVE nodes natural? + Well, they have no text, but they do have a line number, + and they do hold hidden tokens. We use line number as our test, + which serves us correctly here for hidden tokens. +*/ + DEFINE INPUT PARAMETER startNode AS INTEGER NO-UNDO. + DEFINE INPUT PARAMETER targetNode AS INTEGER NO-UNDO. + DEFINE OUTPUT PARAMETER wasFound AS LOGICAL NO-UNDO. + + DEFINE VARIABLE operatorAttr AS CHARACTER NO-UNDO. + DEFINE VARIABLE nodeLine AS INTEGER NO-UNDO. + + /* Only copy start to target if they aren't the same handle */ + IF startNode <> targetNode THEN + parserCopyHandle(startNode, targetNode). + + /* exit condition - "natural" nodes have a line number */ + IF parserGetNodeLine(targetNode) <> 0 THEN DO: + wasFound = TRUE. + RETURN. + END. + + /* Check for child, then check for sibling, then fail */ + IF ( parserNodeFirstChild(targetNode, targetNode) = "" + AND parserNodeNextSibling(targetNode, targetNode) = "" + ) THEN DO: + wasFound = FALSE. + RETURN. + END. + + /* Now we have either the first child or the next sibling */ + nodeLine = parserGetNodeLine(targetNode). + DO WHILE nodeLine = 0: + IF parserNodeFirstChild(targetNode, targetNode) = "" THEN DO: + /* This would happen at end of file; ie: next sibling was Program_tail */ + wasFound = FALSE. + RETURN. + END. + nodeLine = parserGetNodeline(targetNode). + END. + + /* Now we have a natural node. + But if it's an *operator* node, then it's not really the *first* natural node! */ + operatorAttr = parserAttrGet(targetNode, "operator":U). + DO WHILE operatorAttr = "t":U : + findnatural: + DO WHILE TRUE: /* find first non-synthetic child */ + parserNodeFirstChild(targetNode, targetNode). + IF parserGetNodeLine(targetNode) <> 0 THEN + LEAVE findnatural. + END. + operatorAttr = parserAttrGet(targetNode, "operator":U). + END. + + /* Now we really have the first natural node. */ + wasFound = TRUE. + RETURN. + +END PROCEDURE. /* NextNaturalNode */ + + Copied: trunk/prolint/core/prolint.p (from rev 271, trunk/prolint/prolint.p) =================================================================== --- trunk/prolint/core/prolint.p (rev 0) +++ trunk/prolint/core/prolint.p 2006-08-05 09:25:43 UTC (rev 273) @@ -0,0 +1,1333 @@ +/* ========================================================================================== + file : prolint/core/prolint.p + purpose : scan sourcefile(s), look for sloppy programming and common mistakes + see prolint/help/index.htm + + Copyright (C) 2001,2002 Jurjen Dijkstra + + This file is part of Prolint. + + Prolint is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + Prolint is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with Prolint; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + ========================================================================================== */ + +/* ProparseVersion is the expected/"supported" version of proparse.dll for this release of prolint. + When Joanju releases a new version of proparse, we need to do regression testing */ +/* Only the first four digits must match, because for example release 1.0d is functionally + similar to bugfix 1.0d04 */ +&SCOPED-DEFINE ProparseVersion "3.0b":U + +{prolint/dlc-version.i} + +DEFINE INPUT PARAMETER pSourcefile AS CHARACTER NO-UNDO. /* a single filename to lint */ +DEFINE INPUT PARAMETER hSourcefileList AS HANDLE NO-UNDO. /* handle to a list of filenames to lint */ +DEFINE INPUT PARAMETER pCustomprofile AS CHARACTER NO-UNDO. /* name of subdir in prolint/settings */ +DEFINE INPUT PARAMETER pClearOutput AS LOGICAL NO-UNDO. /* add to existing output, or start new log */ + +/* TODO: idea for future version: accept wildcards in pSourcefile and/or in records in hSourcefileList. + this current version expects specific filenames, wildcards are not supported */ + +DEFINE VARIABLE ProfileDirectory AS CHAR NO-UNDO. +DEFINE VARIABLE MaxSeverity AS INTEGER NO-UNDO. +DEFINE VARIABLE listingfile AS CHAR NO-UNDO. +DEFINE VARIABLE xreffile AS CHAR NO-UNDO. +DEFINE VARIABLE hparser AS HANDLE NO-UNDO. +DEFINE VARIABLE topnode AS INTEGER NO-UNDO. +DEFINE VARIABLE NeedProparse AS LOGICAL NO-UNDO INITIAL NO. +DEFINE VARIABLE HasProparse AS LOGICAL NO-UNDO INITIAL YES. +DEFINE VARIABLE HasJpplus AS LOGICAL NO-UNDO INITIAL NO. +DEFINE VARIABLE needCompilerStreamIO AS LOGICAL NO-UNDO INITIAL NO. +DEFINE VARIABLE NeedListing AS LOGICAL NO-UNDO INITIAL NO. +DEFINE VARIABLE NeedXref AS LOGICAL NO-UNDO INITIAL NO. +DEFINE VARIABLE NeedProclist AS LOGICAL NO-UNDO INITIAL NO. +DEFINE VARIABLE hLintSuper AS HANDLE NO-UNDO. +DEFINE VARIABLE grandchild AS INTEGER NO-UNDO. +DEFINE VARIABLE tempdir AS CHARACTER NO-UNDO. +DEFINE VARIABLE tmpTurbolintOut AS CHARACTER NO-UNDO. /* tempfile where turbolint.dll writes results to */ +DEFINE VARIABLE tmpTurbolintNowarn AS CHARACTER NO-UNDO. /* tempfile where turbolint.dll writes nowarn-lines to */ +DEFINE VARIABLE hTurbolint AS INTEGER NO-UNDO. /* hInstance of turbolint.dll */ +DEFINE VARIABLE hpFilterPlugins AS HANDLE NO-UNDO. +DEFINE VARIABLE hpProperties AS HANDLE NO-UNDO. + +{proparse/api/proparse.i hparser} + +DEFINE TEMP-TABLE tt_rules NO-UNDO + FIELD RuleID AS CHARACTER /* equals name of sourcefile, without path or extension */ + FIELD severity AS INTEGER /* importance. 1=minimum, 9=maximum. 0=don't run this rule */ + FIELD useproparse AS LOGICAL /* uses proparse.dll to inspect source */ + FIELD uselisting AS LOGICAL /* reads output from compile...listing */ + FIELD usexref AS LOGICAL /* reads output from compile...xref */ + FIELD useproclist AS LOGICAL /* needs a list of internal procedures and user-defined functions */ + FIELD ignoreAB AS LOGICAL /* suppress warnings from UIB/AB-generated code */ + FIELD pragma AS INTEGER /* unique integer, used for prolint-nowarn */ + FIELD custom AS LOGICAL /* is this a standard rule or is it found in prolint/custom/rules? */ + FIELD byturbolint AS LOGICAL /* will this rule be run by turbolint.dll */ + FIELD hpRulePersist AS HANDLE /* handle to persistent "rules/persist/[ruleid].p" */ + INDEX idx_id AS PRIMARY RuleID. + +DEFINE TEMP-TABLE tt_output NO-UNDO + FIELD progname AS CHARACTER + FIELD DlcVersion AS INTEGER + FIELD WindowSystem AS CHARACTER + INDEX idx_progname AS PRIMARY UNIQUE progname. + +DEFINE TEMP-TABLE tt_files NO-UNDO + FIELD sourcefile AS CHARACTER + INDEX idx_sourcefile AS PRIMARY UNIQUE sourcefile. + + RUN prolint/core/propsuper.p PERSISTENT SET hpProperties. + + /* make sure hParser is invalid. We will use function VALID-HANDLE() later, in GetProparseHandle */ + ASSIGN + hParser = ?. + + /* did the user install (purchase) proparse yet? If not most rules won't work. + Add a warning to the logfile to say proparse is required */ + IF opsys="UNIX":U THEN + hasProparse = NOT( SEARCH("proparse/libproparse.so":U)=? AND SEARCH("proparse/libproparse.sl":U)=? ). + ELSE + hasProparse = NOT( SEARCH("proparse/proparse.dll":U)=? ). + + /* pick a dir for temporary files */ + RUN MakeTempdir. + + /* the place to read your custom settings from */ + RUN GetProfileDirectory. + + /* We need to subscribe to "Prolint_AddResult" because we want to set MaxSeverity */ + SUBSCRIBE TO "Prolint_AddResult" ANYWHERE. + + /* Initialize a place to store results: a logfile, the 'Prolint result window', whatever */ + RUN InitializeOutputhandler. + IF RETURN-VALUE="no handlers":U THEN DO: + {&_proparse_ prolint-nowarn(message)} + MESSAGE "prolint: no valid outputhandlers specified":U VIEW-AS ALERT-BOX. + RUN DeleteTempdir. + DELETE PROCEDURE hpProperties. + RETURN. + END. + + PUBLISH "Prolint_Status_Action" ("initializing..."). + PUBLISH "Prolint_Status_Profile" (pCustomProfile). + + /* Initialize the set of rules, eg populate tt_rules. + If there are no rules there is no point in continuing */ + RUN InitializeRules. + + /* are there any rules that need proparse but proparse isn't installed? */ + IF NeedProparse AND (NOT HasProparse) THEN + PUBLISH "Prolint_AddResult":U ("":U, "":U,"0":U, "proparse required but not found":T, "noproparse":U, 0). + + /* are there any rules at all? If not, close logfile and stop. */ + IF NOT CAN-FIND(FIRST tt_rules) THEN DO: + PUBLISH "Prolint_FinalizeResults". + RUN DeleteTempdir. + DELETE PROCEDURE hpProperties. + RETURN STRING(MaxSeverity). + END. + + RUN PublishRuleList. + + /* show hourglass cursor */ + RUN set-hourglass(TRUE). + + /* load and initialize proparse.dll */ + IF NeedProparse AND HasProparse THEN DO: + RUN GetProparseHandle. + RUN LoadTurbolintDLL. + END. + + /* start a super procedure, to be used by every rule */ + RUN prolint/core/filterplugins.p PERSISTENT SET hpFilterPlugins (ProfileDirectory). + RUN prolint/core/lintsuper.p PERSISTENT SET hLintSuper (hParser,hpFilterPlugins). + RUN SethLintSuper in hpFilterPlugins (hLintSuper). /* ugly circular reference, sorry */ + + /* Lint files: the file specified in pSourceFile plus the contents of hSourcefileList */ + IF VALID-HANDLE(hSourcefileList) THEN + CASE hSourcefileList:TYPE : + WHEN "TEMP-TABLE":U THEN RUN AddTemptableSourceFiles. + WHEN "PROCEDURE":U THEN RUN AddIPProvidedSourceFiles. + OTHERWISE DO: /* other types not supported. Suggestions? */ END. + END CASE. + + IF NOT(pSourceFile="":U OR pSourceFile=?) THEN + RUN AddOneSourceItem(pSourceFile). + + RUN CheckMultipleSetups. + + /* load all procedures in directory rules/persist */ + FOR EACH tt_rules WHERE tt_rules.byturbolint=FALSE NO-LOCK : + IF SEARCH("prolint/custom/rules/persist/":U + tt_rules.ruleid + ".p":U)<>? THEN + RUN VALUE("prolint/custom/rules/persist/":U + tt_rules.ruleid + ".p":U) PERSISTENT SET tt_rules.hpRulePersist(INPUT hLintSuper). + ELSE + IF SEARCH("prolint/rules/persist/":U + tt_rules.ruleid + ".p":U)<>? THEN + RUN VALUE("prolint/rules/persist/":U + tt_rules.ruleid + ".p":U) PERSISTENT SET tt_rules.hpRulePersist(INPUT hLintSuper). + END. + + /* lint all sourcefiles */ + RUN LintAllSourcefiles. + + /* unload rules/persist */ + FOR EACH tt_rules NO-LOCK : + IF VALID-HANDLE(tt_rules.hpRulePersist) THEN DO: + DELETE PROCEDURE tt_rules.hpRulePersist. + tt_rules.hpRulePersist = ?. + END. + END. + + /* tell the logfile/result-window we are done with it */ + PUBLISH "Prolint_FinalizeResults". + + /* release resources */ + RUN ClearProparseResources. + APPLY "CLOSE":U TO hLintSuper. + hLintSuper = ?. + APPLY "CLOSE":U TO hpFilterPlugins. + hpFilterPlugins = ?. + RUN ReleaseProparseHandle. + RUN DeleteTempdir. + IF hTurbolint<>0 THEN + RUN FreeLibrary (hTurbolint). + DELETE PROCEDURE hpProperties. + + /* stop hourglass cursor */ + RUN set-hourglass(FALSE). + + /* return highest severity to the caller */ + /* the calling application might need to know that we found something, + for example: Roundtable might decide NOT to complete this task */ +RETURN STRING(MaxSeverity). + + +/* ======================================================================================= + internal procedures + ======================================================================================= */ + +PROCEDURE GetProfileDirectory : + /* purpose: determine the location of configuration settings. + this would be "local-prolint/settings/" + pCustomProfile + or "prolint/settings/ + pCustomProfile + or just "prolint/settings" */ + + DEFINE VARIABLE PrivateDir AS CHARACTER NO-UNDO. + DEFINE VARIABLE SharedDir AS CHARACTER NO-UNDO. + DEFINE VARIABLE mandatory_d AS CHARACTER NO-UNDO. + DEFINE VARIABLE profile AS CHARACTER NO-UNDO. + + IF pCustomProfile = "":U OR pCustomProfile="<none>":U THEN DO: + FILE-INFO:FILE-NAME = "prolint/settings":U. + ProfileDirectory = FILE-INFO:FULL-PATHNAME. + END. + ELSE DO: + + FILE-INFO:FILE-NAME = "local-prolint/settings/":U + pCustomProfile. + PrivateDir = FILE-INFO:FULL-PATHNAME. + + FILE-INFO:FILE-NAME = "prolint/settings/":U + pCustomProfile. + SharedDir = FILE-INFO:FULL-PATHNAME. + + IF PrivateDir=? AND SharedDir=? THEN + ProfileDirectory = "prolint/settings":U. + ELSE + IF PrivateDir<>? AND SharedDir=? THEN + ProfileDirectory = PrivateDir. + ELSE + IF PrivateDir=? AND SharedDir<>? THEN + ProfileDirectory = SharedDir. + ELSE + IF PrivateDir<>? AND SharedDir<>? THEN DO: + /* are private settings allowed to override shared settings? */ + FILE-INFO:FILE-NAME = SharedDir + "/no-local-settings.lk":U. + IF FILE-INFO:FULL-PATHNAME = ? THEN + ProfileDirectory = PrivateDir. + ELSE + ProfileDirectory = SharedDir. /* ignore PrivateDir */ + END. + END. + +END PROCEDURE. + + + +PROCEDURE InitializeRules : + /* purpose : make a list of rules to run (populate tt_rules). + first import tt_rules from rules.d + then override them with configuration settings from rules.d */ + + DEFINE VARIABLE customrequired AS LOGICAL NO-UNDO. + DEFINE VARIABLE customrule AS CHAR NO-UNDO. + DEFINE VARIABLE customlevel AS INTEGER NO-UNDO. + DEFINE VARIABLE skippedrule AS CHARACTER NO-UNDO. + + DEFINE BUFFER buf_rules FOR tt_rules. + + /* import the custom rules (e.g. those NOT shipped by Prolint Open Source Project) */ + FILE-INFO:FILE-NAME = "prolint/custom/rules/rules.d":U. + IF FILE-INFO:FULL-PATHNAME <> ? THEN DO: + INPUT FROM VALUE(file-info:FULL-PATHNAME). + REPEAT: + CREATE tt_rules. + IMPORT tt_rules EXCEPT tt_rules.pragma tt_rules.custom tt_rules.byturbolint tt_rules.hpRulePersist. + tt_rules.custom = FALSE. + tt_rules.byturbolint = FALSE. + IF CAN-FIND(buf_rules WHERE buf_rules.RuleID=tt_rules.RuleID AND ROWID(buf_rules) NE ROWID(tt_rules)) THEN + DELETE tt_rules. + END. + INPUT CLOSE. + END. + FOR EACH tt_rules WHERE tt_rules.RuleID = "" : + DELETE tt_rules. + END. + + /* import the default rules (e.g. those shipped by www.prolint.org) */ + FILE-INFO:FILE-NAME = "prolint/rules/rules.d":U. + IF FILE-INFO:FULL-PATHNAME <> ? THEN DO: + INPUT FROM VALUE(file-info:FULL-PATHNAME). + REPEAT: + CREATE tt_rules. + IMPORT tt_rules EXCEPT tt_rules.pragma tt_rules.custom tt_rules.byturbolint tt_rules.hpRulePersist. + tt_rules.custom = FALSE. + tt_rules.byturbolint = FALSE. + IF CAN-FIND(buf_rules WHERE buf_rules.RuleID=tt_rules.RuleID AND ROWID(buf_rules) NE ROWID(tt_rules)) THEN + DELETE tt_rules. + END. + INPUT CLOSE. + END. + FOR EACH tt_rules WHERE tt_rules.RuleID = "" : + DELETE tt_rules. + END. + + /* modify standard severity: read custom severity from severity.d */ + /* notice: new rules added to rules.d will run with default severity. That's a good feature */ + FILE-INFO:FILE-NAME = ProfileDirectory + "/severity.d":U. + IF FILE-INFO:FULL-PATHNAME <> ? THEN DO: + INPUT FROM VALUE(file-info:FULL-PATHNAME). + REPEAT: + customlevel = -1. /* if still -1 after import, means that user doesn't want to modify the default */ + IMPORT customrequired customrule customlevel. + FIND tt_rules WHERE tt_rules.RuleID = customrule NO-ERROR. + IF AVAILABLE tt_rules THEN + IF customrequired=FALSE THEN + DELETE tt_rules. + ELSE + IF NOT customlevel=-1 THEN + ASSIGN tt_rules.severity = customlevel. + END. + INPUT CLOSE. + END. + + /* skip rules which are listed in prolint/custom/rules/skiprules.d */ + FILE-INFO:FILE-NAME = "prolint/custom/rules/skiprules.lst":U. + IF FILE-INFO:FULL-PATHNAME <> ? THEN DO: + INPUT FROM VALUE(file-info:FULL-PATHNAME). + REPEAT: + IMPORT UNFORMATTED skippedrule. + skippedrule = TRIM(skippedrule). + FOR EACH tt_rules WHERE tt_rules.RuleID=skippedrule : + DELETE tt_rules. + END. + END. + INPUT CLOSE. + END. + + /* locate the source for each rule: decide if it is a custom rule */ + FOR EACH tt_rules : + FILE-INFO:FILE-NAME = "prolint/custom/rules/":U + tt_rules.RuleId + ".p":U. + IF FILE-INFO:FULL-PATHNAME <> ? THEN + tt_rules.custom = TRUE. + END. + + + /* Clean up the list of rules. */ + + /* do we need Xref file or Listing file? Hope not, it slows down the process */ + ASSIGN + NeedProparse = FALSE + NeedListing = FALSE + NeedXref = FALSE + NeedProclist = FALSE. + + loop_needsomething: + FOR EACH tt_rules : + IF tt_rules.useproparse THEN NeedProparse = TRUE. + IF tt_rules.uselisting THEN NeedListing = TRUE. + IF tt_rules.usexref THEN NeedXref = TRUE. + IF tt_rules.useproclist THEN NeedProclist = TRUE. + + IF (NeedProparse AND NeedListing AND NeedXref AND NeedProclist) THEN + LEAVE loop_needsomething. + END. + + /* forget rules that depend on proparse if proparse isn't installed */ + IF NeedProparse AND NOT HasProparse THEN + FOR EACH tt_rules WHERE tt_rules.useproparse=YES : + DELETE tt_rules. + END. + + /* sanity check: + rules that don't need proparse or xref or listing are nonsense */ + FOR EACH tt_rules WHERE tt_rules.useproparse=NO AND tt_rules.uselisting=NO AND tt_rules.usexref=NO : + DELETE tt_rules. + END. + + /* finally, assign tt_rules.pragma a unique number, starting at 50001 */ + DEFINE VARIABLE vPragma AS INTEGER NO-UNDO INITIAL 50001. + FOR EACH tt_rules : + ASSIGN tt_rules.pragma = vPragma + vPragma = vPragma + 1. + END. + +END PROCEDURE. + + +PROCEDURE InitializeOutputhandler : + /* purpose: start one or more persistent procedures to publish the results to. + each pp can write a logfile or show results on screen, or whatever it wants to do */ + + DEFINE VARIABLE LogwinRunning AS LOGICAL NO-UNDO INITIAL NO. + DEFINE VARIABLE handlers AS CHARACTER NO-UNDO. + DEFINE VARIABLE handler AS CHARACTER NO-UNDO. + DEFINE VARIABLE i AS INTEGER NO-UNDO. + DEFINE VARIABLE hw AS HANDLE NO-UNDO. + + /* import list of outputhandlers */ + FILE-INFO:FILE-NAME = "prolint/outputhandlers/choices.d":U. + IF FILE-INFO:FULL-PATHNAME <> ? THEN DO: + INPUT FROM VALUE(file-info:FULL-PATHNAME). + REPEAT: + CREATE tt_output. + IMPORT tt_output. + END. + INPUT CLOSE. + END. + + /* forget each outputhandler that isn't supported in this Progress session: */ + FOR EACH tt_output : + IF tt_output.DlcVersion GT {&dlc-version} OR + NOT CAN-DO(tt_output.WindowSystem,SessionWindowSystem) THEN + DELETE tt_output. + END. + + /* get the list of handlers you want to use, as specified in profile settings: */ + handlers = "":U. + FILE-INFO:FILE-NAME = ProfileDirectory + "/handlers.d":U. + IF FILE-INFO:FULL-PATHNAME <> ? THEN DO: + INPUT FROM VALUE(file-info:FULL-PATHNAME). + REPEAT: + IMPORT handler. + /* if handler exists and supported in this Progress session, then add to list */ + IF CAN-FIND(tt_output WHERE tt_output.progname=handler) THEN + handlers = handlers + ",":U + handler. + END. + INPUT CLOSE. + END. + + handlers = TRIM(handlers,',':U). + IF handlers="" THEN + RETURN "no handlers":U. + + DO i=1 TO NUM-ENTRIES(handlers) : + handler = ENTRY(i,handlers). + + CASE handler : + WHEN "logwin.w":U THEN DO: + LogwinRunning = FALSE. + hw = SESSION:FIRST-CHILD. + DO WHILE VALID-HANDLE(hw) : + IF hw:PRIVATE-DATA = "prolint_outputhandler_logwin.w":U THEN + LogwinRunning = TRUE. + hw = hw:NEXT-SIBLING. + END. + IF NOT LogwinRunning THEN + RUN VALUE(DYNAMIC-FUNCTION("ProlintProperty", "outputhandlers.resultwindow")) PERSISTENT. + END. + + OTHERWISE RUN VALUE("prolint/outputhandlers/":U + handler) PERSISTENT. + END. + END. + + PUBLISH "Prolint_InitializeResults" (pClearOutput). + +END PROCEDURE. + + +PROCEDURE GetProparseHandle : + /* purpose: run proparse.p persistent set hParser + or find an already running instance of proparse.p and use its handle */ + + DEFINE VARIABLE hpp AS HANDLE NO-UNDO. + DEFINE VARIABLE dllversion AS CHARACTER NO-UNDO. + + hpp = session:FIRST-PROCEDURE. + DO WHILE VALID-HANDLE(hpp) AND (NOT VALID-HANDLE(hparser)) : + IF hpp:FILE-NAME MATCHES "~*~/proparse.*":U THEN /* added tildes because Progress confused it for a comment :-)*/ + hparser = hpp. + ELSE + hpp = hpp:NEXT-SIBLING. + END. + IF (NOT VALID-HANDLE(hParser)) AND (HasProparse) THEN + RUN proparse/api/proparse.p PERSISTENT SET hparser. + + /* check if proparse version matches the prolint version. If not, you must upgrade one or the other */ + IF VALID-HANDLE(hParser) THEN DO: + dllversion = parserGetVersion(). + /* only compare the first four digits: release 1.0d is functionally similar to bugfix 1.0d02 */ + IF SUBSTRING(dllversion,1,4) NE SUBSTRING({&ProparseVersion},1,4) THEN + PUBLISH "Prolint_AddResult":U ("", "","0":U, SUBSTITUTE("Expected proparse version &1, found &2":T, {&proparseversion}, dllversion), "version":U, 0). + END. + + /* Look for the "jpplus" package, which provides + * tree attributes beyond what the basic parser does. + * jpplus/4gl/startup.p is run by proparse.p - we don't do it here. + */ + IF VALID-HANDLE(hParser) AND SEARCH("jpplus/4gl/startup.p":U) <> ? THEN DO: + ASSIGN HasJpplus = true. + END. + + /* enable reading of PROPARSE-DIRECTIVE for Prolint pragma's */ + IF VALID-HANDLE(hParser) THEN + parserConfigSet("show-proparse-directives":U, "true":U). + + /* define database aliases: */ + RUN DefineAliases. + +END PROCEDURE. + +PROCEDURE DefineAliases : + /* purpose: */ + DEFINE VARIABLE vAlias AS CHARACTER NO-UNDO. + DEFINE VARIABLE vDbname AS CHARACTER NO-UNDO. + DEFINE VARIABLE i AS INTEGER NO-UNDO. + + /* first delete all existing aliases */ + parserSchemaAliasDelete(""). + + /* pass all aliases which are defined in the current Progress session */ + REPEAT i=1 TO NUM-ALIASES: + parserSchemaAliasCreate(ALIAS(i),LDBNAME(ALIAS(i))). + END. + + /* now read list of aliasses from the optional file settings/dbaliases */ + FILE-INFO:FILE-NAME = "prolint/settings/dbaliases.d":U. + IF FILE-INFO:FULL-PATHNAME <> ? THEN DO: + INPUT FROM VALUE(file-info:FULL-PATHNAME). + REPEAT: + IMPORT vAlias vDbname. + parserSchemaAliasCreate(vAlias,vDbname). + END. + INPUT CLOSE. + END. + +END PROCEDURE. + +PROCEDURE AddTemptableSourceFiles : + /* purpose : if parameter hSourcefileList is a temp-table, then assume it is a list of + sourcefiles to lint. The temp-table must have a field SourceFile, other + fields (if any) don't matter */ + + DEFINE VARIABLE hBuffer AS HANDLE NO-UNDO. + DEFINE VARIABLE hField AS HANDLE NO-UNDO. + DEFINE VARIABLE hQuery AS HANDLE NO-UNDO. + + hBuffer = hSourcefileList:DEFAULT-BUFFER-HANDLE. + hField = hBuffer:BUFFER-FIELD("SourceFile":U). + IF VALID-HANDLE(hField) THEN DO: + CREATE QUERY hQuery. + hQuery:SET-BUFFERS(hBuffer). + hQuery:QUERY-PREPARE(SUBSTITUTE("for each &1 no-lock":U, hSourcefileList:NAME)). + hQuery:QUERY-OPEN(). + hQuery:GET-FIRST(). + DO WHILE hBuffer:AVAILABLE : + RUN AddOneSourceItem(hField:BUFFER-VALUE). + hQuery:GET-NEXT(). + END. + hQuery:QUERY-CLOSE(). + DELETE OBJECT hQuery. + END. + +END PROCEDURE. + + +PROCEDURE AddIPProvidedSourceFiles : + /* purpose : if parameter hSourcefileList is a procedure, then this procedure should contain + internal procedures that provides us with names of sourcefiles - one at a time */ + + DEFINE VARIABLE v-SourceFile AS CHARACTER NO-UNDO. + + RUN GetFirstLintSource IN hSourcefileList (OUTPUT v-SourceFile). + DO WHILE v-SourceFile NE ? : + RUN AddOneSourceItem(v-SourceFile). + RUN GetNextLintSource IN hSourcefileList (OUTPUT v-SourceFile). + END. + +END PROCEDURE. + + +PROCEDURE AddOneSourceItem : + /* purpose: SourceItem can be a filename or a directoryname. + if it's a directory then lint all files in it */ + DEFINE INPUT PARAMETER p-SourceItem AS CHARACTER NO-UNDO. + + DEFINE VARIABLE basename AS CHARACTER NO-UNDO. + DEFINE VARIABLE fullpath AS CHARACTER NO-UNDO. + DEFINE VARIABLE attribs AS CHARACTER NO-UNDO. + + FILE-INFO:FILE-NAME = p-SourceItem. + IF FILE-INFO:FULL-PATHNAME = ? THEN + PUBLISH "Prolint_AddResult":U (p-SourceItem, p-SourceItem,"0":U, "file not found":T, "prolint":U, 9). + ELSE + IF FILE-INFO:FILE-TYPE MATCHES "*F*":U THEN + RUN AddOneSourceFile(FILE-INFO:FULL-PATHNAME). + ELSE + IF FILE-INFO:FILE-TYPE MATCHES "*D*":U THEN DO: + /* scan directory contents. recursive! */ + INPUT FROM OS-DIR (FILE-INFO:FULL-PATHNAME). + REPEAT: + IMPORT basename fullpath attribs. + IF attribs MATCHES "*D*":U AND NOT(basename=".":U OR basename="..":U) THEN + RUN AddOneSourceItem(fullpath). + IF attribs MATCHES "*F*":U THEN + IF (basename MATCHES "*~~.w":U) OR (basename MATCHES "*~~.p":U) THEN + RUN AddOneSourceFile(fullpath). + END. + INPUT CLOSE. + END. +END PROCEDURE. + + +PROCEDURE AddOneSourceFile : + /* purpose : add name of sourcefile to tt_files. + That way we can assure the names are unique, + we can count the files and show a percentage done, + and we won't have to run LintOneSourceFile from within + the recursive directory-scan (high stack usage) */ + DEFINE INPUT PARAMETER p-SourceFile AS CHARACTER NO-UNDO. + + p-SourceFile = DYNAMIC-FUNCTION("RelativeFilename":U IN hLintSuper, p-SourceFile). + FIND tt_files WHERE tt_files.sourcefile = p-SourceFile NO-ERROR. + IF NOT AVAILABLE tt_files THEN DO: + CREATE tt_files. + ASSIGN tt_files.sourcefile = p-Sourcefile. + END. + +END PROCEDURE. + + +PROCEDURE LintAllSourcefiles : + /* purpose: actually lint each tt_files.sourcefile. + also try to give an idea how long it's gonna take. */ + + DEFINE VARIABLE maxFiles AS INTEGER NO-UNDO. + DEFINE VARIABLE numFiles AS INTEGER NO-UNDO. + DEFINE VARIABLE done AS CHARACTER NO-UNDO. + + FOR EACH tt_files NO-LOCK : + maxFiles = maxFiles + 1. + END. + + IF maxFiles>1 THEN DO: + done = " 0%":U. + PUBLISH "Prolint_Status_Progress" ("done"). + END. + + FOR EACH tt_files NO-LOCK : + RUN LintOneSourceFile (tt_files.sourcefile). + numFiles = numFiles + 1. + done = STRING((100 * numFiles) / maxFiles, ">>9":U) + "%":U. + PUBLISH "Prolint_Status_Progress" ("done"). + END. + +END PROCEDURE. + +PROCEDURE LintOneSourceFile : + /* purpose : lint one sourcefile. + Just PreAnalyze it (=compile + parserParse) and run value(each rule) */ + + DEFINE INPUT PARAMETER p-SourceFile AS CHARACTER NO-UNDO. + + DEFINE VARIABLE ErrorMessage AS CHAR NO-UNDO. + + PUBLISH "Prolint_Status_FileStart" (p-SourceFile). + + FILE-INFO:FILE-NAME = p-SourceFile. + IF FILE-INFO:FULL-PATHNAME = ? THEN + PUBLISH "Prolint_AddResult":U (p-SourceFile, p-SourceFile,"0":U, "file not found":T, "prolint":U, 9). + ELSE DO: + p-SourceFile = FILE-INFO:FULL-PATHNAME. + + /* PreAnalyze creates compile listing, XREF ... [truncated message content] |
