paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 23:39:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ support for array of widechar typed constants (based on patch by

Browse Source 
Blaise Thorn, mantis #16004)

git-svn-id: trunk@15096 -
This commit is contained in:
Jonas Maebe 2010-03-30 19:45:50 +00:00
parent 67b7762c34
commit 734f9de2a0
5 changed files with 127 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10336,6 +10336,7 @@ tests/webtbs/tw15843.pp svneol=native#text/plain
tests/webtbs/tw15909.pp svneol=native#text/plain
tests/webtbs/tw1592.pp svneol=native#text/plain
tests/webtbs/tw15930.pp svneol=native#text/plain
tests/webtbs/tw16004.pp svneol=native#text/plain
tests/webtbs/tw16040.pp svneol=native#text/plain
tests/webtbs/tw16083.pp svneol=native#text/plain
tests/webtbs/tw1617.pp svneol=native#text/plain

22
compiler/aasmtai.pas
View File

@ -422,6 +422,7 @@ interface
constructor Create_32bit(_value : longint);
constructor Create_16bit(_value : word);
constructor Create_8bit(_value : byte);
constructor Create_char(size: integer; _value: dword);
constructor Create_sleb128bit(_value : int64);
constructor Create_uleb128bit(_value : qword);
constructor Create_aint(_value : aint);
@ -1137,6 +1138,27 @@ implementation
end;
constructor tai_const.Create_char(size: integer; _value: dword);
begin
inherited Create;
typ:=ait_const;
case size of
1:
begin
consttype:=aitconst_8bit;
value:=byte(_value)
end;
2:
begin
consttype:=aitconst_16bit;
value:=word(_value)
end
else
InternalError(2010030701)
end
end;
constructor tai_const.Create_sleb128bit(_value : int64);
begin
inherited Create;

11
compiler/defutil.pas
View File

@ -80,6 +80,9 @@ interface
{# Returns true if definition is a widechar }
function is_widechar(def : tdef) : boolean;
{# Returns true if definition is either an AnsiChar or a WideChar }
function is_anychar(def : tdef) : boolean;
{# Returns true if definition is a void}
function is_void(def : tdef) : boolean;
@ -476,6 +479,14 @@ implementation
end;
{ true if p is a char or wchar }
function is_anychar(def : tdef) : boolean;
begin
result:=(def.typ=orddef) and
(torddef(def).ordtype in [uchar,uwidechar])
end;
{ true if p is signed (integer) }
function is_signed(def : tdef) : boolean;
begin

66
compiler/ptconst.pas
View File

@ -824,8 +824,10 @@ implementation
n : tnode;
i : longint;
len : aint;
ch : char;
ca : pchar;
ch : array[0..1] of char;
ca : pbyte;
int_const: tai_const;
char_size: integer;
begin
{ dynamic array nil }
if is_dynamic_array(def) then
@ -862,22 +864,46 @@ implementation
consume(_RKLAMMER);
end
{ if array of char then we allow also a string }
else if is_char(def.elementdef) then
else if is_anychar(def.elementdef) then
begin
char_size:=def.elementdef.size;
n:=comp_expr(true);
if n.nodetype=stringconstn then
begin
len:=tstringconstnode(n).len;
case char_size of
1:
ca:=pointer(tstringconstnode(n).value_str);
2:
begin
inserttypeconv(n,cwidestringtype);
if n.nodetype<>stringconstn then
internalerror(2010033003);
ca:=pointer(pcompilerwidestring(tstringconstnode(n).value_str)^.data)
end;
else
internalerror(2010033005);
end;
{ For tp7 the maximum lentgh can be 255 }
if (m_tp7 in current_settings.modeswitches) and
(len>255) then
len:=255;
ca:=tstringconstnode(n).value_str;
end
else
if is_constcharnode(n) then
else if is_constcharnode(n) then
begin
ch:=chr(tordconstnode(n).value.uvalue and $ff);
case char_size of
1:
ch[0]:=chr(tordconstnode(n).value.uvalue and $ff);
2:
begin
inserttypeconv(n,cwidechartype);
if not is_constwidecharnode(n) then
internalerror(2010033001);
widechar(ch):=widechar(tordconstnode(n).value.uvalue and $ffff);
end;
else
internalerror(2010033002);
end;
ca:=@ch;
len:=1;
end
@ -888,16 +914,24 @@ implementation
end;
if len>(def.highrange-def.lowrange+1) then
Message(parser_e_string_larger_array);
for i:=def.lowrange to def.highrange do
for i:=0 to def.highrange-def.lowrange do
begin
if i+1-def.lowrange<=len then
begin
hr.list.concat(Tai_const.Create_8bit(byte(ca^)));
inc(ca);
end
else
{Fill the remaining positions with #0.}
hr.list.concat(Tai_const.Create_8bit(0));
if i<len then
begin
case char_size of
1:
int_const:=Tai_const.Create_char(char_size,pbyte(ca)^);
2:
int_const:=Tai_const.Create_char(char_size,pword(ca)^);
else
internalerror(2010033004);
end;
inc(ca, char_size);
end
else
{Fill the remaining positions with #0.}
int_const:=Tai_const.Create_char(char_size,0);
hr.list.concat(int_const)
end;
n.free;
end

43
tests/webtbs/tw16004.pp Normal file
View File

@ -0,0 +1,43 @@
{$apptype console}
{$mode Delphi}
{$assertions on}
{$codepage cp1251}
function verify(const p; const size: integer; const z: array of byte): boolean;
begin
assert( size = length(z)*sizeof(z[0]) );
result := CompareByte(p, z[0], size) = 0;
writeln(result)
end;
procedure foo;
var a: array[0..5] of char = 'willow';
const b: array[0..2] of WideChar = 'èâà';
begin
assert( verify(a, sizeof(a), [ord('w'), ord('i'), ord('l'), ord('l'), ord('o'), ord('w')]) );
{$ifdef endian_big}
assert( verify(b, sizeof(b), [$04,$38,$04,$32,$04,$30]) )
{$else}
assert( verify(b, sizeof(b), [$38,$04,$32,$04,$30,$04]) )
{$endif}
end;
const c: array[0..10] of char = 'rosenberg';
var d: array[0..10] of WideChar = 'ðîçåíáåðã';
z: array[0..1] of WideChar = 'û';
x: array[0..0] of char = 'x';
begin
assert( verify(c, sizeof(c), [114, 111, 115, 101, 110, 98, 101, 114, 103, 0, 0]) );
{$ifdef endian_big}
assert( verify(d, sizeof(d), [$04,$40,$04,$3E,$04,$37,$04,$35,$04,$3D,$04,$31,$04,$35,$04,$40,$04,$33,0,0,0,0]) );
{$else}
assert( verify(d, sizeof(d), [$40,$04,$3E,$04,$37,$04,$35,$04,$3D,$04,$31,$04,$35,$04,$40,$04,$33,$04,0,0,0,0]) );
{$endif}
foo;
{$ifdef endian_big}
assert( verify(z, sizeof(z), [$04,$4B,0,0]) );
{$else}
assert( verify(z, sizeof(z), [$4B,$04,0,0]) );
{$endif}
assert( verify(x, sizeof(x), [120]) )
end.