paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-27 19:10:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ utf-8 support for string constants added

Browse Source 
git-svn-id: trunk@428 -
This commit is contained in:
florian 2005-06-16 20:16:37 +00:00
parent ac544edd50
commit ec6d5ff211
9 changed files with 2782 additions and 2691 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -5074,6 +5074,8 @@ tests/test/tsubdecl.pp svneol=native#text/plain
tests/test/tunit1.pp svneol=native#text/plain
tests/test/tunit2.pp svneol=native#text/plain
tests/test/tunit3.pp svneol=native#text/plain
tests/test/tutf81.pp svneol=native#text/plain%3Bcharset%3Dutf-8
tests/test/tutf82.pp svneol=native#text/plain%3Bcharset%3Dutf-8
tests/test/twide1.pp svneol=native#text/plain
tests/test/twide2.pp svneol=native#text/plain
tests/test/uabstrcl.pp svneol=native#text/plain

4745
compiler/msg/errore.msg
View File

File diff suppressed because it is too large Load Diff

7
compiler/msgidx.inc
View File

@ -84,6 +84,9 @@ const
scan_e_wrong_switch_toggle_default=02066;
scan_e_mode_switch_not_allowed=02067;
scan_e_error_macro_undefined=02068;
scan_e_utf8_bigger_than_65535=02069;
scan_e_utf8_malformed=02070;
scan_c_switching_to_utf8=02071;
parser_e_syntax_error=03000;
parser_e_dont_nest_interrupt=03004;
parser_w_proc_directive_ignored=03005;
@ -653,9 +656,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 38455;
MsgTxtSize = 38582;
MsgIdxMax : array[1..20] of longint=(
19,69,214,59,59,46,100,20,35,60,
19,72,214,59,59,46,100,20,35,60,
40,1,1,1,1,1,1,1,1,1
);

638
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

4
compiler/options.pas
View File

@ -682,7 +682,9 @@ begin
autoloadunits:=more;
'c' :
begin
if not(cpavailable(more)) then
if (upper(more)='UTF8') or (upper(more)='UTF-8') then
initsourcecodepage:='utf8'
else if not(cpavailable(more)) then
Message1(option_code_page_not_available,more)
else
initsourcecodepage:=more;

4
compiler/scandir.pas
View File

@ -1060,7 +1060,9 @@ implementation
begin
current_scanner.skipspace;
s:=current_scanner.readcomment;
if not(cpavailable(s)) then
if (upper(s)='UTF8') or (upper(s)='UTF-8') then
aktsourcecodepage:='utf8'
else if not(cpavailable(s)) then
Message1(option_code_page_not_available,s)
else
aktsourcecodepage:=s;

57
compiler/scanner.pas
View File

@ -1434,6 +1434,17 @@ implementation
{ first line? }
if line_no=0 then
begin
c:=inputpointer^;
{ eat utf-8 signature? }
if (ord(inputpointer^)=$ef) and
(ord((inputpointer+1)^)=$bb) and
(ord((inputpointer+2)^)=$bf) then
begin
inc(inputpointer,3);
message(scan_c_switching_to_utf8);
aktsourcecodepage:='utf8';
end;
line_no:=1;
if cs_asm_source in aktglobalswitches then
inputfile.setline(line_no,bufstart);
@ -2412,6 +2423,7 @@ implementation
code : integer;
len,
low,high,mid : longint;
w : word;
m : longint;
mac : tmacro;
asciinr : string[6];
@ -2928,7 +2940,50 @@ implementation
break;
end;
end;
if iswidestring then
{ interpret as utf-8 string? }
if (ord(c)>=$80) and (aktsourcecodepage='utf8') then
begin
{ convert existing string to an utf-8 string }
if not iswidestring then
begin
ascii2unicode(@pattern[1],len,patternw);
iswidestring:=true;
len:=0;
end;
{ four or more chars aren't handled }
if (ord(c) and $f0)=$f0 then
message(scan_e_utf8_bigger_than_65535)
{ three chars }
else if (ord(c) and $e0)=$e0 then
begin
w:=ord(c) and $f;
readchar;
if (ord(c) and $c0)<>$80 then
message(scan_e_utf8_malformed);
w:=(w shl 6) or (ord(c) and $3f);
readchar;
if (ord(c) and $c0)<>$80 then
message(scan_e_utf8_malformed);
w:=(w shl 6) or (ord(c) and $3f);
concatwidestringchar(patternw,w);
end
{ two chars }
else if (ord(c) and $c0)<>0 then
begin
w:=ord(c) and $1f;
readchar;
if (ord(c) and $c0)<>$80 then
message(scan_e_utf8_malformed);
w:=(w shl 6) or (ord(c) and $3f);
concatwidestringchar(patternw,w);
end
{ illegal }
else if (ord(c) and $80)<>0 then
message(scan_e_utf8_malformed)
else
concatwidestringchar(patternw,tcompilerwidechar(c))
end
else if iswidestring then
concatwidestringchar(patternw,asciichar2unicode(c))
else
begin

6
tests/test/tutf81.pp Normal file
View File

@ -0,0 +1,6 @@
var
w : widestring;
begin
w:='äüö';
writeln(w);
end.

10
tests/test/tutf82.pp Normal file
View File

@ -0,0 +1,10 @@
var
w : widestring;
begin
w:='äüö';
if (ord(w[1])<>$e4) or
(ord(w[2])<>$fc) or
(ord(w[3])<>$f6) then
halt(1);
writeln('ok');
end.