paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-04 11:18:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

o patch by Michael Denisenko, resolves #14734:

Browse Source 
* fixes memory leaks in case of string code
  * replace usage of strcmp
  * improved tests

git-svn-id: trunk@13830 -
This commit is contained in:
florian 2009-10-09 20:40:22 +00:00
parent 93171fdc23
commit 44aed2af60
28 changed files with 135 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
compiler/ncon.pas
View File

@ -192,6 +192,7 @@ interface
{ some helper routines }
function get_ordinal_value(p : tnode) : TConstExprInt;
function get_string_value(p : tnode; is_wide : boolean = false) : TConstString;
function compare_strings(str1, str2: pchar) : longint;
function is_constresourcestringnode(p : tnode) : boolean;
function is_emptyset(p : tnode):boolean;
function genconstsymtree(p : tconstsym) : tnode;
@ -254,11 +255,12 @@ implementation
if (not is_wide) then
begin
if ordValRecord.signed then
stringVal := char(ordValRecord.svalue) + ''#0
stringVal := char(ordValRecord.svalue)
else
stringVal := char(ordValRecord.uvalue) + ''#0;
getmem(pCharVal, length(stringVal));
stringVal := char(ordValRecord.uvalue);
getmem(pCharVal, length(stringVal) + 1);
strpcopy(pCharVal, stringVal);
pCharVal[length(stringVal)] := #0;
get_string_value := pCharVal;
end
else
@ -317,6 +319,25 @@ implementation
end;
end;
function compare_strings(str1, str2: pchar) : longint;
var
minlen, len1, len2: integer;
begin
len1 := length(str1);
len2 := length(str2);
if len1 < len2 then
minlen := len1
else
minlen := len2;
minlen := comparebyte(str1^, str2^, minlen);
if minlen = 0 then
minlen := len1 - len2;
Result := minlen;
end;
function is_constresourcestringnode(p : tnode) : boolean;
begin
is_constresourcestringnode:=(p.nodetype=loadn) and

19
compiler/nset.pas
View File

@ -766,7 +766,7 @@ implementation
condit := caddnode.create(
equaln, left.getcopy, cstringconstnode.createstr(labtree^._low_str));
if (strcomp(labtree^._low_str, labtree^._high_str) <> 0) then
if (compare_strings(labtree^._low_str, labtree^._high_str) <> 0) then
begin
condit.nodetype := gten;
condit := caddnode.create(
@ -791,10 +791,17 @@ implementation
init_block:=nil;
expectloc:=LOC_VOID;
{ evalutes the case expression }
firstpass(left);
set_varstate(left,vs_read,[vsf_must_be_valid]);
if codegenerror then
exit;
{ Load caseexpr into temp var if complex. }
{ No need to do this for ordinal, because }
{ in that case caseexpr is generated once }
if (labels^.label_type = ltConstString) and (not valid_for_addr(left, false)) then
if (labels^.label_type = ltConstString) and (not valid_for_addr(left, false)) and
(blocks.count > 0) then
begin
init_block := internalstatements(stmt);
tempcaseexpr :=
@ -811,12 +818,6 @@ implementation
typecheckpass(left);
end;
{ evalutes the case expression }
firstpass(left);
set_varstate(left,vs_read,[vsf_must_be_valid]);
if codegenerror then
exit;
{ first case }
for i:=0 to blocks.count-1 do
firstpass(pcaseblock(blocks[i])^.statement);
@ -1065,7 +1066,7 @@ implementation
if (str_type in [cst_widestring, cst_unicodestring]) then
result := comparewidestrings(pcompilerwidestring(l), pcompilerwidestring(h))
else
result := strcomp(l, h);
result := compare_strings(l, h);
end;
var

29
compiler/pstatmnt.pas
View File

@ -183,8 +183,8 @@ implementation
end;
hl1:=0;
hl2:=0;
sl1:='';
sl2:='';
sl1:=nil;
sl2:=nil;
if (p.nodetype=rangen) then
begin
{ type check for string case statements }
@ -197,7 +197,7 @@ implementation
if (
(is_wide_or_unicode_string(casedef) and (
comparewidestrings(pcompilerwidestring(sl1), pcompilerwidestring(sl2)) > 0)) or
((not is_wide_or_unicode_string(casedef)) and (strcomp(sl1, sl2) > 0))) then
((not is_wide_or_unicode_string(casedef)) and (compare_strings(sl1, sl2) > 0))) then
CGMessage(parser_e_case_lower_less_than_upper_bound);
end
{ type checking for ordinal case statements }
@ -245,6 +245,29 @@ implementation
end;
end;
p.free;
if caseofstring then
begin
if is_wide_or_unicode_string(casedef) then
begin
if assigned(sl1) then
donewidestring(pcompilerwidestring(sl1));
if assigned(sl2) then
donewidestring(pcompilerwidestring(sl2));
end
else
begin
if assigned(sl1) then
begin
freemem(sl1);
sl1 := nil;
end;
if assigned(sl2) then
begin
freemem(sl2);
sl2 := nil;
end;
end;
end;
if token=_COMMA then
consume(_COMMA)
else

6
tests/test/tcase15.pp
View File

@ -3,9 +3,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase16.pp
View File

@ -3,9 +3,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase17.pp
View File

@ -3,9 +3,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase19.pp
View File

@ -5,9 +5,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase20.pp
View File

@ -5,9 +5,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase21.pp
View File

@ -5,9 +5,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase22.pp
View File

@ -3,9 +3,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase23.pp
View File

@ -5,9 +5,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase24.pp
View File

@ -3,9 +3,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase25.pp
View File

@ -3,9 +3,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase26.pp
View File

@ -5,9 +5,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase27.pp
View File

@ -5,9 +5,9 @@
{$H+}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase31.pp
View File

@ -3,9 +3,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase32.pp
View File

@ -3,9 +3,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase33.pp
View File

@ -3,9 +3,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase35.pp
View File

@ -5,9 +5,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase36.pp
View File

@ -5,9 +5,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase37.pp
View File

@ -5,9 +5,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase38.pp
View File

@ -3,9 +3,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase39.pp
View File

@ -5,9 +5,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase40.pp
View File

@ -3,9 +3,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase41.pp
View File

@ -3,9 +3,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase42.pp
View File

@ -5,9 +5,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase43.pp
View File

@ -5,9 +5,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin

6
tests/test/tcase44.pp
View File

@ -4,9 +4,9 @@
{$H-}
var
my_str: string;
my_str_wide: string;
my_str_ansi: string;
my_str_uni: string;
my_str_wide: widestring;
my_str_ansi: ansistring;
my_str_uni: unicodestring;
i: integer;
begin