Apple-2gs-SW/ORCA-C
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCA-C.git synced 2025-01-21 21:32:00 +00:00
Code Issues Projects Releases Wiki Activity

Add lint flag to check for several forms of undefined behavior in computations.

Browse Source 
This adds lint bit 5 (a value of 32), which currently enables checking for the following conditions:

*Integer overflow from arithmetic in constant expressions (currently only of type int).
*Invalid constant shift counts (negative, or >= the width of the type)
*Division by (constant) zero.

These (mainly the first two) can be indicative of code that was designed for larger type sizes and needs changes to support 16-bit int.
This commit is contained in:
Stephen Heumann 2018-09-05 23:43:58 -05:00
parent b2785dfe0e
commit dc1b0aa29f
3 changed files with 81 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
CCommon.pas
View File

@ -88,8 +88,9 @@ const
lintUndefFn = $0001; {flag use of undefined functions}
lintNoFnType = $0002; {flag functions with no type}
lintNotPrototyped = $0004; {flag functions with no prototypes}
lintPragmas = $0008; {flag unknown prototypes}
lintPragmas = $0008; {flag unknown pragmas}
lintPrintf = $0010; {check printf/scanf format flags}
lintOverflow = $0020; {check for overflows}
{bit masks for GetLInfo flags}
{----------------------------}

76
Expression.pas
View File

@ -1126,6 +1126,20 @@ var
end;
otherwise: Error(57);
end; {case}
if ((lint & lintOverflow) <> 0) then begin
if op^.token.kind in [plusch,minusch,asteriskch,slashch] then
if ekind = intConst then
if op1 <> long(op1).lsw then
Error(128);
if op^.token.kind in [ltltop,gtgtop] then begin
if ekind in [intConst,uintConst] then
if (op2 < 0) or (op2 > 15) then
Error(130);
if ekind in [longConst,ulongConst] then
if (op2 < 0) or (op2 > 31) then
Error(130);
end; {if}
end; {if}
op^.token.kind := ekind;
if ekind in [longconst,ulongconst] then begin
op^.token.lval := op1;
@ -2847,6 +2861,54 @@ var
end; {CompareCompatible}
procedure CheckDivByZero (var divisor: tokenType; opType: typePtr);
{ Check for division by (constant) zero. }
{ }
{ parameters: }
{ divisor - token for divisor }
{ opType - type of the result of the operation }
begin {CheckDivByZero}
if opType^.kind = scalarType then
if opType^.baseType in [cgByte,cgWord,cgUByte,cgUWord,cgLong,cgULong] then
if ((divisor.class = intConstant) and (divisor.ival = 0))
or ((divisor.class = longConstant) and (divisor.lval = 0))
or ((divisor.class = doubleConstant) and (divisor.rval = 0.0)) then
Error(129);
end; {CheckDivByZero}
procedure CheckShiftOverflow (var shiftCountTok: tokenType; opType: typePtr);
{ Check for invalid (too large or negative) shift count. }
{ }
{ parameters: }
{ shiftCountTok - token for shift count }
{ opType - type of the result of the operation }
var
shiftCount: longint;
begin {CheckShiftOverflow}
if shiftCountTok.class = intConstant then
shiftCount := shiftCountTok.ival
else if shiftCountTok.class = longConstant then
shiftCount := shiftCountTok.lval
else
shiftCount := 0;
if (shiftCount <> 0) and (opType^.kind = scalarType) then begin
if opType^.baseType in [cgByte,cgWord,cgUByte,cgUWord] then
if (shiftCount < 0) or (shiftCount > 15) then
Error(130);
if opType^.baseType in [cgLong,cgULong] then
if (shiftCount < 0) or (shiftCount > 31) then
Error(130);
end; {if}
end; {CheckShiftOverflow}
begin {GenerateCode}
lastwasconst := false;
case tree^.token.kind of
@ -3165,6 +3227,12 @@ case tree^.token.kind of
otherwise: Error(57);
end; {case}
if ((lint & lintOverflow) <> 0) then begin
if tree^.token.kind in [slasheqop,percenteqop] then
CheckDivByZero(tree^.right^.token, lType)
else if tree^.token.kind in [ltlteqop,gtgteqop] then
CheckShiftOverflow(tree^.right^.token, lType);
end; {if}
AssignmentConversion(lType,expressionType,false,0,true,true);
if doingScalar then begin
if kind = pointerType then
@ -3320,6 +3388,8 @@ case tree^.token.kind of
error(66);
end; {case}
expressionType := lType;
if ((lint & lintOverflow) <> 0) then
CheckShiftOverflow(tree^.right^.token, expressionType);
end; {case ltltop}
gtgtop: begin {>>}
@ -3346,6 +3416,8 @@ case tree^.token.kind of
error(66);
end; {case}
expressionType := lType;
if ((lint & lintOverflow) <> 0) then
CheckShiftOverflow(tree^.right^.token, expressionType);
end; {case gtgtop}
plusch: begin {+}
@ -3485,6 +3557,8 @@ case tree^.token.kind of
otherwise:
error(66);
end; {case}
if ((lint & lintOverflow) <> 0) then
CheckDivByZero(tree^.right^.token, expressionType);
end; {case slashch}
percentch: begin {%}
@ -3503,6 +3577,8 @@ case tree^.token.kind of
otherwise:
error(66);
end; {case}
if ((lint & lintOverflow) <> 0) then
CheckDivByZero(tree^.right^.token, expressionType);
end; {case percentch}
eqeqop, {==}

3
Scanner.pas
View File

@ -623,6 +623,9 @@ if list or (numErr <> 0) then begin
125: msg := @'lint: format string is not a string literal';
126: msg := @'scope rules may not be changed within a function';
127: msg := @'illegal storage class for declaration in for loop';
128: msg := @'lint: integer overflow in expression';
129: msg := @'lint: division by zero';
130: msg := @'lint: invalid shift count';
otherwise: Error(57);
end; {case}
writeln(msg^);