1 unit WarnAssignToFunctionName;
2
3 {(*}
4 (*------------------------------------------------------------------------------
5 Delphi Code formatter source code
6
7 The Original Code is WarnAssignToFunctionName, released May 2003.
8 The Initial Developer of the Original Code is Anthony Steele.
9 Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
10 All Rights Reserved.
11 Contributor(s): Anthony Steele.
12
13 The contents of this file are subject to the Mozilla Public License Version 1.1
14 (the "License"). you may not use this file except in compliance with the License.
15 You may obtain a copy of the License at http://www.mozilla.org/NPL/
16
17 Software distributed under the License is distributed on an "AS IS" basis,
18 WITHOUT WARRANTY OF ANY KIND, either express or implied.
19 See the License for the specific language governing rights and limitations
20 under the License.
21
22 Alternatively, the contents of this file may be used under the terms of
23 the GNU General Public License Version 2 or later (the "GPL")
24 See http://www.gnu.org/licenses/gpl.html
25 ------------------------------------------------------------------------------*)
26 {*)}
27
28 {$I JcfGlobal.inc}
29
30 interface
31
32 { AFS 21 Sept 2001
33
34 warn of assignment to function name in old TurboPascal code
35
36 ie
37 function Fred: integer;
38 begin
39 Fred := 3;
40 end;
41
42 should be
43
44 function Fred: integer;
45 begin
46 Result := 3;
47 end;
48 }
49
50 uses
51 SysUtils,
52 Warning;
53
54 type
55
56 TWarnAssignToFunctionName = class(TWarning)
57 private
58 procedure WarnAllAssigns(const psFnName: string; const pcRoot: TObject);
59 public
60 constructor Create; override;
61
62 procedure PreVisitParseTreeNode(const pcNode: TObject); override;
63 end;
64
65
66 implementation
67
68 uses
69 { local }
70 ParseTreeNode, ParseTreeNodeType, SourceToken, Tokens, TokenUtils;
71
72
73
74 { get the node that represents the identifier that is being assigned to
75 node passed in will be statement
76
77 looking for the last id before the ':=',
78
79 e.g. in "TFoo(bar.baz) := fish;" we want "baz"
80
81 NB this may not work in complex examples as the id may be under an expr node
82 but may suffice for this fn name assign detection
83 }
GetIdentifierBeforeAssignnull84 function GetIdentifierBeforeAssign(const pcNode: TParseTreeNode): TSourceToken;
85 var
86 liLoop: integer;
87 lcDes: TParseTreeNode;
88 lcChildNode: TParseTreeNode;
89 lcSourceToken: TSourceToken;
90 begin
91 Result := nil;
92 Assert(pcNode <> nil);
93
94 lcDes := pcNode.GetImmediateChild(nDesignator);
95 Assert(lcDes <> nil);
96
97 for liLoop := 0 to lcDes.ChildNodeCount - 1 do
98 begin
99 lcChildNode := lcDes.ChildNodes[liLoop];
100
101 if lcChildNode.NodeType = nIdentifier then
102 begin
103 lcSourceToken := lcChildNode.FirstSolidLeaf as TSourceToken;
104
105 if lcSourceToken.WordType in IdentifierTypes then
106 Result := lcSourceToken;
107 end
108 else if lcChildNode.NodeType = nBracketedQual then
109 begin
110 // go inside the brackets - should be a designator in there
111 Result := GetIdentifierBeforeAssign(lcChildNode);
112 end
113 else if lcChildNode.NodeType = nAssignment then
114 break;
115
116 end;
117 end;
118
119 constructor TWarnAssignToFunctionName.Create;
120 begin
121 inherited;
122
123 HasPreVisit := True;
124 HasPostVisit := False;
125 HasSourceTokenVisit := False;
126 end;
127
128 procedure TWarnAssignToFunctionName.PreVisitParseTreeNode(const pcNode: TObject);
129 var
130 lcNode: TParseTreeNode;
131 lcFunctionHeading: TParseTreeNode;
132 lsName: string;
133 begin
134 lcNode := TParseTreeNode(pcNode);
135
136 if lcNode.NodeType <> nFunctionDecl then
137 exit;
138
139 { we now have a function decl
140 Find the name, find the assign statements. Compare }
141 lcFunctionHeading := lcNode.GetImmediateChild([nFunctionHeading]);
142 Assert(lcFunctionHeading <> nil);
143
144 lsName := ExtractNameFromFunctionHeading(lcFunctionHeading, False);
145
146 WarnAllAssigns(lsName, lcNode);
147 end;
148
149 procedure TWarnAssignToFunctionName.WarnAllAssigns(const psFnName: string;
150 const pcRoot: TObject);
151 var
152 lcNode: TParseTreeNode;
153 lcLeftName: TSourceToken;
154 liLoop: integer;
155 begin
156 Assert(pcRoot <> nil);
157 lcNode := TParseTreeNode(pcRoot);
158
159 if (lcNode.NodeType = nStatement) and (lcNode.HasChildNode(nAssignment, 1)) then
160 begin
161
162 // this is an assign statement. Look at the LHS
163 lcLeftName := GetIdentifierBeforeAssign(lcNode);
164
165 Assert(lcLeftName <> nil, 'No id before assign');
166
167 if AnsiSameText(lcLeftName.SourceCode, psFnName) then
168 begin
169 SendWarning(lcLeftName,
170 'Assignment to the function name "' + psFnName +
171 '" is deprecated, Use assignment to "Result"');
172 end;
173 end
174 else
175 begin
176 // look at all nodes under here
177 for liLoop := 0 to lcNode.ChildNodeCount - 1 do
178 WarnAllAssigns(psFnName, lcNode.ChildNodes[liLoop]);
179 end;
180 end;
181
182 end.
183