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

o update by Michael Denisenko for case <string> of

Browse Source 
* memory management fixed
  * idention fixed

git-svn-id: trunk@13712 -
This commit is contained in:
florian 2009-09-14 21:44:11 +00:00
parent da7fdf76d5
commit 02eeb3dad6
2 changed files with 58 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/ncon.pas
View File

@ -277,7 +277,11 @@ implementation
if is_wide then
begin
if (tstringconstnode(p).cst_type in [cst_widestring, cst_unicodestring]) then
get_string_value := tstringconstnode(p).value_str
begin
initwidestring(pWideStringVal);
copywidestring(pcompilerwidestring(tstringconstnode(p).value_str), pWideStringVal);
get_string_value := TConstString(pWideStringVal);
end
else
{ if string must be wide, but actually was parsed as usual }
begin
@ -297,7 +301,12 @@ implementation
get_string_value := pCharVal;
end
else
get_string_value := tstringconstnode(p).value_str;
begin
getmem(pCharVal, tstringconstnode(p).len + 1);
strcopy(pCharVal, tstringconstnode(p).value_str);
pCharVal[tstringconstnode(p).len] := #0;
get_string_value := pCharVal;
end;
end;
end;
end

92
compiler/pstatmnt.pas
View File

@ -187,60 +187,62 @@ implementation
sl2:='';
if (p.nodetype=rangen) then
begin
{ type check for string case statements }
if caseofstring and
is_conststring_or_constcharnode(trangenode(p).left) and
is_conststring_or_constcharnode(trangenode(p).right) then
begin
sl1 := get_string_value(trangenode(p).left, is_wide_or_unicode_string(casedef));
sl2 := get_string_value(trangenode(p).right, is_wide_or_unicode_string(casedef));
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
CGMessage(parser_e_case_lower_less_than_upper_bound);
end
{ type checking for ordinal case statements }
else if (not caseofstring) and
is_subequal(casedef, trangenode(p).left.resultdef) and
is_subequal(casedef, trangenode(p).right.resultdef) then
begin
hl1:=get_ordinal_value(trangenode(p).left);
hl2:=get_ordinal_value(trangenode(p).right);
if hl1>hl2 then
CGMessage(parser_e_case_lower_less_than_upper_bound);
if not casedeferror then
{ type check for string case statements }
if caseofstring and
is_conststring_or_constcharnode(trangenode(p).left) and
is_conststring_or_constcharnode(trangenode(p).right) then
begin
sl1 := get_string_value(trangenode(p).left, is_wide_or_unicode_string(casedef));
sl2 := get_string_value(trangenode(p).right, is_wide_or_unicode_string(casedef));
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
CGMessage(parser_e_case_lower_less_than_upper_bound);
end
{ type checking for ordinal case statements }
else if (not caseofstring) and
is_subequal(casedef, trangenode(p).left.resultdef) and
is_subequal(casedef, trangenode(p).right.resultdef) then
begin
hl1:=get_ordinal_value(trangenode(p).left);
hl2:=get_ordinal_value(trangenode(p).right);
if hl1>hl2 then
CGMessage(parser_e_case_lower_less_than_upper_bound);
if not casedeferror then
begin
testrange(casedef,hl1,false);
testrange(casedef,hl2,false);
end;
end
else
CGMessage(parser_e_case_mismatch);
end
else
CGMessage(parser_e_case_mismatch);
if caseofstring then
casenode.addlabel(blockid,sl1,sl2,st2cst[tstringdef(casedef).stringtype])
else
casenode.addlabel(blockid,hl1,hl2);
if caseofstring then
casenode.addlabel(blockid,sl1,sl2,st2cst[tstringdef(casedef).stringtype])
else
casenode.addlabel(blockid,hl1,hl2);
end
else
begin
{ type check for string case statements }
if (caseofstring and (not is_conststring_or_constcharnode(p))) or
{ type checking for ordinal case statements }
((not caseofstring) and (not is_subequal(casedef, p.resultdef))) then
CGMessage(parser_e_case_mismatch);
{ type check for string case statements }
if (caseofstring and (not is_conststring_or_constcharnode(p))) or
{ type checking for ordinal case statements }
((not caseofstring) and (not is_subequal(casedef, p.resultdef))) then
CGMessage(parser_e_case_mismatch);
if caseofstring then begin
sl1:=get_string_value(p, is_wide_or_unicode_string(casedef));
casenode.addlabel(blockid,sl1,sl1,st2cst[tstringdef(casedef).stringtype]);
end
else begin
hl1:=get_ordinal_value(p);
if not casedeferror then
testrange(casedef,hl1,false);
casenode.addlabel(blockid,hl1,hl1);
end;
if caseofstring then
begin
sl1:=get_string_value(p, is_wide_or_unicode_string(casedef));
casenode.addlabel(blockid,sl1,sl1,st2cst[tstringdef(casedef).stringtype]);
end
else
begin
hl1:=get_ordinal_value(p);
if not casedeferror then
testrange(casedef,hl1,false);
casenode.addlabel(blockid,hl1,hl1);
end;
end;
p.free;
if token=_COMMA then