mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 19:09:23 +02:00
* cleanup of case <string> of code by Sergei Gorelkin, resolves #13700
git-svn-id: trunk@14467 -
This commit is contained in:
florian
parent
dab642986e
commit
448f3d99c1
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8807,6 +8807,7 @@ tests/test/tasout.pp svneol=native#text/plain
|
||||
tests/test/tassignmentoperator1.pp svneol=native#text/pascal
|
||||
tests/test/tbopr.pp svneol=native#text/plain
|
||||
tests/test/tbrtlevt.pp svneol=native#text/plain
|
||||
tests/test/tcase0.pp svneol=native#text/pascal
|
||||
tests/test/tcase1.pp svneol=native#text/plain
|
||||
tests/test/tcase10.pp svneol=native#text/pascal
|
||||
tests/test/tcase11.pp svneol=native#text/pascal
|
||||
|
||||
@ -135,6 +135,7 @@ interface
|
||||
function getpcharcopy : pchar;
|
||||
function docompare(p: tnode) : boolean; override;
|
||||
procedure changestringtype(def:tdef);
|
||||
function fullcompare(p: tstringconstnode): longint;
|
||||
end;
|
||||
tstringconstnodeclass = class of tstringconstnode;
|
||||
|
||||
@ -191,8 +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 get_string_value(p : tnode; def: tstringdef) : tstringconstnode;
|
||||
function is_constresourcestringnode(p : tnode) : boolean;
|
||||
function is_emptyset(p : tnode):boolean;
|
||||
function genconstsymtree(p : tconstsym) : tnode;
|
||||
@ -238,103 +238,32 @@ implementation
|
||||
Message(type_e_constant_expr_expected);
|
||||
end;
|
||||
|
||||
function get_string_value(p : tnode; is_wide : boolean) : TConstString;
|
||||
function get_string_value(p: tnode; def: tstringdef): tstringconstnode;
|
||||
var
|
||||
pCharVal: pchar;
|
||||
stringVal: string;
|
||||
pWideStringVal: pcompilerwidestring;
|
||||
ordValRecord: TConstExprInt;
|
||||
begin
|
||||
if is_conststring_or_constcharnode(p) then
|
||||
if is_constcharnode(p) then
|
||||
begin
|
||||
if is_constcharnode(p) or is_constwidecharnode(p) then
|
||||
begin
|
||||
{ if we have case like 'aa'..'b' the right part will never be ordinal }
|
||||
{ but in case 'a' it will go here }
|
||||
ordValRecord := tordconstnode(p).value;
|
||||
if (not is_wide) then
|
||||
begin
|
||||
if ordValRecord.signed then
|
||||
stringVal := char(ordValRecord.svalue)
|
||||
else
|
||||
stringVal := char(ordValRecord.uvalue);
|
||||
getmem(pCharVal, length(stringVal) + 1);
|
||||
strpcopy(pCharVal, stringVal);
|
||||
pCharVal[length(stringVal)] := #0;
|
||||
get_string_value := pCharVal;
|
||||
end
|
||||
else
|
||||
begin
|
||||
initwidestring(pWideStringVal);
|
||||
if ordValRecord.signed then
|
||||
concatwidestringchar(pWideStringVal, tcompilerwidechar(ordValRecord.svalue))
|
||||
else
|
||||
concatwidestringchar(pWideStringVal, tcompilerwidechar(ordValRecord.uvalue));
|
||||
get_string_value := TConstString(pWideStringVal);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if is_wide then
|
||||
begin
|
||||
if (tstringconstnode(p).cst_type in [cst_widestring, cst_unicodestring]) then
|
||||
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
|
||||
initwidestring(pWideStringVal);
|
||||
ascii2unicode(tstringconstnode(p).value_str, tstringconstnode(p).len, pWideStringVal);
|
||||
get_string_value := TConstString(pWideStringVal);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (tstringconstnode(p).cst_type in [cst_widestring, cst_unicodestring]) then
|
||||
{ string is wide but it must be usual }
|
||||
begin
|
||||
getmem(pCharVal, pcompilerwidestring(tstringconstnode(p).value_str)^.len + 1);
|
||||
unicode2ascii(pcompilerwidestring(tstringconstnode(p).value_str), pCharVal);
|
||||
pCharVal[pcompilerwidestring(tstringconstnode(p).value_str)^.len] := #0;
|
||||
get_string_value := pCharVal;
|
||||
end
|
||||
else
|
||||
begin
|
||||
getmem(pCharVal, tstringconstnode(p).len + 1);
|
||||
move(tstringconstnode(p).value_str^, pCharVal^, tstringconstnode(p).len);
|
||||
pCharVal[tstringconstnode(p).len] := #0;
|
||||
get_string_value := pCharVal;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
SetLength(stringVal,1);
|
||||
stringVal[1]:=char(tordconstnode(p).value.uvalue);
|
||||
result:=cstringconstnode.createstr(stringVal);
|
||||
end
|
||||
else if is_constwidecharnode(p) then
|
||||
begin
|
||||
initwidestring(pWideStringVal);
|
||||
concatwidestringchar(pWideStringVal, tcompilerwidechar(tordconstnode(p).value.uvalue));
|
||||
result:=cstringconstnode.createwstr(pWideStringVal);
|
||||
end
|
||||
else if is_conststringnode(p) then
|
||||
result:=tstringconstnode(p.getcopy)
|
||||
else
|
||||
begin
|
||||
Message(type_e_string_expr_expected);
|
||||
getmem(get_string_value, 1);
|
||||
get_string_value[0] := #0;
|
||||
stringVal:='';
|
||||
result:=cstringconstnode.createstr(stringVal);
|
||||
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;
|
||||
result.changestringtype(def);
|
||||
end;
|
||||
|
||||
|
||||
@ -1049,6 +978,15 @@ implementation
|
||||
resultdef:=def;
|
||||
end;
|
||||
|
||||
function tstringconstnode.fullcompare(p: tstringconstnode): longint;
|
||||
begin
|
||||
if cst_type<>p.cst_type then
|
||||
InternalError(2009121701);
|
||||
if cst_type in [cst_widestring,cst_unicodestring] then
|
||||
result:=comparewidestrings(pcompilerwidestring(value_str),pcompilerwidestring(p.value_str))
|
||||
else
|
||||
result:=compareansistrings(value_str,p.value_str,len,p.len);
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
TSETCONSTNODE
|
||||
|
||||
@ -28,7 +28,7 @@ interface
|
||||
uses
|
||||
cclasses,constexp,
|
||||
node,globtype,globals,
|
||||
aasmbase,aasmtai,aasmdata,ncon,symtype,strings;
|
||||
aasmbase,aasmtai,aasmdata,ncon,symtype;
|
||||
|
||||
type
|
||||
TLabelType = (ltOrdinal, ltConstString);
|
||||
@ -51,8 +51,7 @@ interface
|
||||
ltConstString:
|
||||
(
|
||||
_low_str,
|
||||
_high_str : TConstString;
|
||||
_str_type : TConstStringType;
|
||||
_high_str : tstringconstnode;
|
||||
);
|
||||
end;
|
||||
|
||||
@ -102,7 +101,7 @@ interface
|
||||
function pass_1 : tnode;override;
|
||||
function docompare(p: tnode): boolean; override;
|
||||
procedure addlabel(blockid:longint;l,h : TConstExprInt); overload;
|
||||
procedure addlabel(blockid:longint;l,h : TConstString; str_type : TConstStringType); overload;
|
||||
procedure addlabel(blockid:longint;l,h : tstringconstnode); overload;
|
||||
procedure addblock(blockid:longint;instr:tnode);
|
||||
procedure addelseblock(instr:tnode);
|
||||
end;
|
||||
@ -474,16 +473,8 @@ implementation
|
||||
deletecaselabels(p^.less);
|
||||
if (p^.label_type = ltConstString) then
|
||||
begin
|
||||
if (p^._str_type in [cst_widestring, cst_unicodestring]) then
|
||||
begin
|
||||
donewidestring(pcompilerwidestring(p^._low_str));
|
||||
donewidestring(pcompilerwidestring(p^._high_str));
|
||||
end
|
||||
else
|
||||
begin
|
||||
freemem(p^._low_str);
|
||||
freemem(p^._high_str);
|
||||
end;
|
||||
p^._low_str.Free;
|
||||
p^._high_str.Free;
|
||||
end;
|
||||
dispose(p);
|
||||
end;
|
||||
@ -498,24 +489,8 @@ implementation
|
||||
n^:=p^;
|
||||
if (p^.label_type = ltConstString) then
|
||||
begin
|
||||
if (p^._str_type in [cst_widestring, cst_unicodestring]) then
|
||||
begin
|
||||
initwidestring(pcompilerwidestring(n^._low_str));
|
||||
initwidestring(pcompilerwidestring(n^._high_str));
|
||||
copywidestring(
|
||||
pcompilerwidestring(p^._low_str), pcompilerwidestring(n^._low_str));
|
||||
copywidestring(
|
||||
pcompilerwidestring(p^._high_str), pcompilerwidestring(n^._high_str));
|
||||
end
|
||||
else
|
||||
begin
|
||||
getmem(n^._low_str, strlen(p^._low_str) + 1);
|
||||
strcopy(n^._low_str, p^._low_str);
|
||||
n^._low_str[strlen(p^._low_str)] := #0;
|
||||
getmem(n^._high_str, strlen(p^._high_str) + 1);
|
||||
strcopy(n^._high_str, p^._high_str);
|
||||
n^._high_str[strlen(p^._high_str)] := #0;
|
||||
end;
|
||||
n^._low_str := tstringconstnode(p^._low_str.getcopy);
|
||||
n^._high_str := tstringconstnode(p^._high_str.getcopy);
|
||||
end;
|
||||
if assigned(p^.greater) then
|
||||
n^.greater:=copycaselabel(p^.greater);
|
||||
@ -526,35 +501,14 @@ implementation
|
||||
|
||||
|
||||
procedure ppuwritecaselabel(ppufile:tcompilerppufile;p : pcaselabel);
|
||||
|
||||
procedure ppuwritestring(str_type : tconststringtype; value : pchar);
|
||||
|
||||
var
|
||||
len : integer;
|
||||
begin
|
||||
if str_type in [cst_widestring, cst_unicodestring] then
|
||||
begin
|
||||
len := pcompilerwidestring(value)^.len;
|
||||
ppufile.putlongint(len);
|
||||
ppufile.putdata(pcompilerwidestring(value)^.data, len * sizeof(tcompilerwidechar));
|
||||
end
|
||||
else
|
||||
begin
|
||||
len := strlen(value);
|
||||
ppufile.putlongint(len);
|
||||
ppufile.putdata(value^, len);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
b : byte;
|
||||
begin
|
||||
ppufile.putbyte(byte(p^.label_type = ltConstString));
|
||||
if (p^.label_type = ltConstString) then
|
||||
begin
|
||||
ppufile.putbyte(byte(p^._str_type));
|
||||
ppuwritestring(p^._str_type, p^._low_str);
|
||||
ppuwritestring(p^._str_type, p^._high_str);
|
||||
p^._low_str.ppuwrite(ppufile);
|
||||
p^._high_str.ppuwrite(ppufile);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -563,11 +517,7 @@ implementation
|
||||
end;
|
||||
|
||||
ppufile.putlongint(p^.blockid);
|
||||
b:=0;
|
||||
if assigned(p^.greater) then
|
||||
b:=b or 1;
|
||||
if assigned(p^.less) then
|
||||
b:=b or 2;
|
||||
b:=ord(assigned(p^.greater)) or (ord(assigned(p^.less)) shl 1);
|
||||
ppufile.putbyte(b);
|
||||
if assigned(p^.greater) then
|
||||
ppuwritecaselabel(ppufile,p^.greater);
|
||||
@ -577,29 +527,6 @@ implementation
|
||||
|
||||
|
||||
function ppuloadcaselabel(ppufile:tcompilerppufile):pcaselabel;
|
||||
|
||||
procedure ppuloadstring(str_type : tconststringtype; out value : pchar);
|
||||
|
||||
var
|
||||
pw : pcompilerwidestring;
|
||||
len : integer;
|
||||
begin
|
||||
len := ppufile.getlongint;
|
||||
if str_type in [cst_widestring, cst_unicodestring] then
|
||||
begin
|
||||
initwidestring(pw);
|
||||
setlengthwidestring(pw, len);
|
||||
ppufile.getdata(pw^.data, pw^.len * sizeof(tcompilerwidechar));
|
||||
pcompilerwidestring(value) := pw
|
||||
end
|
||||
else
|
||||
begin
|
||||
getmem(value, len + 1);
|
||||
ppufile.getdata(value^, len);
|
||||
value[len] := #0;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
b : byte;
|
||||
p : pcaselabel;
|
||||
@ -608,10 +535,8 @@ implementation
|
||||
if boolean(ppufile.getbyte) then
|
||||
begin
|
||||
p^.label_type := ltConstString;
|
||||
p^._str_type := tconststringtype(ppufile.getbyte);
|
||||
|
||||
ppuloadstring(p^._str_type, p^._low_str);
|
||||
ppuloadstring(p^._str_type, p^._high_str);
|
||||
p^._low_str := cstringconstnode.ppuload(stringconstn,ppufile);
|
||||
p^._high_str := cstringconstnode.ppuload(stringconstn,ppufile);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -736,45 +661,21 @@ implementation
|
||||
var
|
||||
condit : tnode;
|
||||
begin
|
||||
result := nil;
|
||||
if assigned(labtree^.less) then
|
||||
result := makeifblock(labtree^.less, prevconditblock)
|
||||
else
|
||||
result := prevconditblock;
|
||||
prevconditblock := nil;
|
||||
|
||||
if (labtree^._str_type in [cst_widestring, cst_unicodestring]) then
|
||||
begin
|
||||
condit := caddnode.create(
|
||||
equaln, left.getcopy,
|
||||
cstringconstnode.createwstr(pcompilerwidestring(labtree^._low_str)));
|
||||
|
||||
if (
|
||||
comparewidestrings(
|
||||
pcompilerwidestring(labtree^._low_str),
|
||||
pcompilerwidestring(labtree^._high_str)) <> 0) then
|
||||
begin
|
||||
condit.nodetype := gten;
|
||||
condit := caddnode.create(
|
||||
andn, condit, caddnode.create(
|
||||
lten, left.getcopy, cstringconstnode.createwstr(
|
||||
pcompilerwidestring(labtree^._high_str))));
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
condit := caddnode.create(
|
||||
equaln, left.getcopy, cstringconstnode.createstr(labtree^._low_str));
|
||||
condit := caddnode.create(equaln, left.getcopy, labtree^._low_str.getcopy);
|
||||
|
||||
if (compare_strings(labtree^._low_str, labtree^._high_str) <> 0) then
|
||||
begin
|
||||
condit.nodetype := gten;
|
||||
condit := caddnode.create(
|
||||
andn, condit, caddnode.create(
|
||||
lten, left.getcopy, cstringconstnode.createstr(labtree^._high_str)));
|
||||
end;
|
||||
if (labtree^._low_str.fullcompare(labtree^._high_str)<>0) then
|
||||
begin
|
||||
condit.nodetype := gten;
|
||||
condit := caddnode.create(
|
||||
andn, condit, caddnode.create(
|
||||
lten, left.getcopy, labtree^._high_str.getcopy));
|
||||
end;
|
||||
|
||||
|
||||
result :=
|
||||
cifnode.create(
|
||||
condit, pcaseblock(blocks[labtree^.blockid])^.statement, result);
|
||||
@ -855,7 +756,6 @@ implementation
|
||||
end
|
||||
else
|
||||
result := if_node;
|
||||
init_block := nil;
|
||||
elseblock := nil;
|
||||
exit;
|
||||
end;
|
||||
@ -1046,7 +946,10 @@ implementation
|
||||
result:=insertlabel(p^.greater);
|
||||
end
|
||||
else
|
||||
Message(parser_e_double_caselabel);
|
||||
begin
|
||||
dispose(hcaselabel);
|
||||
Message(parser_e_double_caselabel);
|
||||
end
|
||||
end;
|
||||
|
||||
begin
|
||||
@ -1059,15 +962,7 @@ implementation
|
||||
insertlabel(labels);
|
||||
end;
|
||||
|
||||
procedure tcasenode.addlabel(blockid : longint; l, h : TConstString; str_type : TConstStringType);
|
||||
|
||||
function str_compare(l, h : TConstString) : longint;
|
||||
begin
|
||||
if (str_type in [cst_widestring, cst_unicodestring]) then
|
||||
result := comparewidestrings(pcompilerwidestring(l), pcompilerwidestring(h))
|
||||
else
|
||||
result := compare_strings(l, h);
|
||||
end;
|
||||
procedure tcasenode.addlabel(blockid: longint; l, h: tstringconstnode);
|
||||
|
||||
var
|
||||
hcaselabel : pcaselabel;
|
||||
@ -1080,13 +975,18 @@ implementation
|
||||
result := p;
|
||||
end
|
||||
else
|
||||
if (str_compare(p^._low_str, hcaselabel^._high_str) > 0) then
|
||||
if (p^._low_str.fullcompare(hcaselabel^._high_str) > 0) then
|
||||
result := insertlabel(p^.less)
|
||||
else
|
||||
if (str_compare(p^._high_str, hcaselabel^._low_str) < 0) then
|
||||
if (p^._high_str.fullcompare(hcaselabel^._low_str) < 0) then
|
||||
result := insertlabel(p^.greater)
|
||||
else
|
||||
Message(parser_e_double_caselabel);
|
||||
begin
|
||||
hcaselabel^._low_str.free;
|
||||
hcaselabel^._high_str.free;
|
||||
dispose(hcaselabel);
|
||||
Message(parser_e_double_caselabel);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
@ -1095,24 +995,9 @@ implementation
|
||||
hcaselabel^.blockid := blockid;
|
||||
hcaselabel^.label_type := ltConstString;
|
||||
|
||||
if (str_type in [cst_widestring, cst_unicodestring]) then
|
||||
begin
|
||||
initwidestring(pcompilerwidestring(hcaselabel^._low_str));
|
||||
initwidestring(pcompilerwidestring(hcaselabel^._high_str));
|
||||
copywidestring(pcompilerwidestring(l), pcompilerwidestring(hcaselabel^._low_str));
|
||||
copywidestring(pcompilerwidestring(h), pcompilerwidestring(hcaselabel^._high_str));
|
||||
end
|
||||
else
|
||||
begin
|
||||
getmem(hcaselabel^._low_str, strlen(l) + 1);
|
||||
getmem(hcaselabel^._high_str, strlen(h) + 1);
|
||||
strcopy(hcaselabel^._low_str, l);
|
||||
strcopy(hcaselabel^._high_str, h);
|
||||
hcaselabel^._low_str[strlen(l)] := #0;
|
||||
hcaselabel^._high_str[strlen(h)] := #0;
|
||||
end;
|
||||
hcaselabel^._low_str := tstringconstnode(l.getcopy);
|
||||
hcaselabel^._high_str := tstringconstnode(h.getcopy);
|
||||
|
||||
hcaselabel^._str_type := str_type;
|
||||
insertlabel(labels);
|
||||
end;
|
||||
|
||||
|
||||
@ -42,7 +42,7 @@ implementation
|
||||
cutils,cclasses,
|
||||
{ global }
|
||||
globtype,globals,verbose,constexp,
|
||||
strings,systems,
|
||||
systems,
|
||||
{ aasm }
|
||||
cpubase,aasmbase,aasmtai,aasmdata,
|
||||
{ symtable }
|
||||
@ -115,16 +115,12 @@ implementation
|
||||
|
||||
|
||||
function case_statement : tnode;
|
||||
const
|
||||
st2cst : array[tstringtype] of tconststringtype = (
|
||||
cst_shortstring,cst_longstring,cst_ansistring,
|
||||
cst_widestring,cst_unicodestring);
|
||||
var
|
||||
casedef : tdef;
|
||||
caseexpr,p : tnode;
|
||||
blockid : longint;
|
||||
hl1,hl2 : TConstExprInt;
|
||||
sl1,sl2 : TConstString;
|
||||
sl1,sl2 : tstringconstnode;
|
||||
casedeferror, caseofstring : boolean;
|
||||
casenode : tcasenode;
|
||||
begin
|
||||
@ -192,12 +188,10 @@ implementation
|
||||
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 (compare_strings(sl1, sl2) > 0))) then
|
||||
{ we need stringconstnodes, even if expression contains single chars }
|
||||
sl1 := get_string_value(trangenode(p).left, tstringdef(casedef));
|
||||
sl2 := get_string_value(trangenode(p).right, tstringdef(casedef));
|
||||
if sl1.fullcompare(sl2) > 0 then
|
||||
CGMessage(parser_e_case_lower_less_than_upper_bound);
|
||||
end
|
||||
{ type checking for ordinal case statements }
|
||||
@ -219,7 +213,7 @@ implementation
|
||||
CGMessage(parser_e_case_mismatch);
|
||||
|
||||
if caseofstring then
|
||||
casenode.addlabel(blockid,sl1,sl2,st2cst[tstringdef(casedef).stringtype])
|
||||
casenode.addlabel(blockid,sl1,sl2)
|
||||
else
|
||||
casenode.addlabel(blockid,hl1,hl2);
|
||||
end
|
||||
@ -233,8 +227,8 @@ implementation
|
||||
|
||||
if caseofstring then
|
||||
begin
|
||||
sl1:=get_string_value(p, is_wide_or_unicode_string(casedef));
|
||||
casenode.addlabel(blockid,sl1,sl1,st2cst[tstringdef(casedef).stringtype]);
|
||||
sl1:=get_string_value(p, tstringdef(casedef));
|
||||
casenode.addlabel(blockid,sl1,sl1);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -245,29 +239,9 @@ 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;
|
||||
sl1.free;
|
||||
sl2.free;
|
||||
|
||||
if token=_COMMA then
|
||||
consume(_COMMA)
|
||||
else
|
||||
|
||||
37
tests/test/tcase0.pp
Normal file
37
tests/test/tcase0.pp
Normal file
@ -0,0 +1,37 @@
|
||||
{$mode objfpc}{$h+}
|
||||
|
||||
// A basic test for 'case-of-string' with embedded zeroes
|
||||
var
|
||||
s: string;
|
||||
ss: shortstring;
|
||||
ws: widestring;
|
||||
us: unicodestring;
|
||||
i: integer;
|
||||
|
||||
begin
|
||||
i:=15;
|
||||
|
||||
s:='aa'#0'bb';
|
||||
case s of
|
||||
'aa'#0'aa' .. 'aa'#0'cc': i:=i and (not 1);
|
||||
end;
|
||||
|
||||
ss:='aa'#0'bb';
|
||||
case ss of
|
||||
'aa'#0'aa' .. 'aa'#0'cc': i:=i and (not 2);
|
||||
end;
|
||||
|
||||
ws:='aa'#0'bb';
|
||||
case ws of
|
||||
'aa'#0'aa' .. 'aa'#0'cc': i:=i and (not 4);
|
||||
end;
|
||||
|
||||
us:='aa'#0'bb';
|
||||
case us of
|
||||
'aa'#0'aa' .. 'aa'#0'cc': i:=i and (not 8);
|
||||
end;
|
||||
|
||||
if i=0 then
|
||||
writeln('ok');
|
||||
Halt(i);
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user