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

* give error with string constants longer than 255 chars, this is

Browse Source 
compatible with kylix
This commit is contained in:
peter 2001-10-22 19:55:44 +00:00
parent 2b5619dfd2
commit 5f98096685
5 changed files with 351 additions and 287 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
compiler/msg/errore.msg
View File

@ -301,6 +301,9 @@ scan_w_appid_not_support=02059_W_APPID is only supported for PalmOS
% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. % The \var{\{\$APPID\}} directive is only supported for the PalmOS target.
scan_w_appname_not_support=02060_W_APPNAME is only supported for PalmOS scan_w_appname_not_support=02060_W_APPNAME is only supported for PalmOS
% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. % The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target.
scan_e_string_exceeds_255_chars=02061_E_Constant strings can't be longer than 255 chars
% A single string constant can contain at most 255 chars. Try splitting up the
% string in multiple smaller parts and concatenate them with a + operator.
% \end{description} % \end{description}
# #
# Parser # Parser

5
compiler/msgidx.inc
View File

@ -77,6 +77,7 @@ const
scan_e_invalid_interface_type=02058; scan_e_invalid_interface_type=02058;
scan_w_appid_not_support=02059; scan_w_appid_not_support=02059;
scan_w_appname_not_support=02060; scan_w_appname_not_support=02060;
scan_e_string_exceeds_255_chars=02061;
parser_e_syntax_error=03000; parser_e_syntax_error=03000;
parser_w_proc_far_ignored=03001; parser_w_proc_far_ignored=03001;
parser_w_proc_near_ignored=03002; parser_w_proc_near_ignored=03002;
@ -601,9 +602,9 @@ const
option_info=11024; option_info=11024;
option_help_pages=11025; option_help_pages=11025;
MsgTxtSize = 33610; MsgTxtSize = 33666;
MsgIdxMax : array[1..20] of longint=( MsgIdxMax : array[1..20] of longint=(
17,61,182,38,41,41,98,17,35,42, 17,62,182,38,41,41,98,17,35,42,
30,1,1,1,1,1,1,1,1,1 30,1,1,1,1,1,1,1,1,1
); );

537
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

78
compiler/scanner.pas
View File

@ -1853,10 +1853,12 @@ implementation
procedure tscannerfile.readtoken; procedure tscannerfile.readtoken;
var var
code : integer; code : integer;
len,
low,high,mid : longint; low,high,mid : longint;
m : longint; m : longint;
mac : tmacro; mac : tmacro;
asciinr : string[6]; asciinr : string[6];
msgwritten,
iswidestring : boolean; iswidestring : boolean;
label label
exit_label; exit_label;
@ -2230,6 +2232,9 @@ implementation
'''','#','^' : '''','#','^' :
begin begin
len:=0;
msgwritten:=false;
pattern:='';
iswidestring:=false; iswidestring:=false;
if c='^' then if c='^' then
begin begin
@ -2244,15 +2249,14 @@ implementation
end end
else else
begin begin
inc(len);
if c<#64 then if c<#64 then
pattern:=chr(ord(c)+64) pattern[len]:=chr(ord(c)+64)
else else
pattern:=chr(ord(c)-64); pattern[len]:=chr(ord(c)-64);
readchar; readchar;
end; end;
end end;
else
pattern:='';
repeat repeat
case c of case c of
'#' : '#' :
@ -2284,9 +2288,13 @@ implementation
begin begin
if (m>=0) and (m<=65535) then if (m>=0) and (m<=65535) then
begin begin
ascii2unicode(@pattern[1],length(pattern),patternw); if not iswidestring then
concatwidestringchar(patternw,tcompilerwidechar(m)); begin
iswidestring:=true; ascii2unicode(@pattern[1],len,patternw);
iswidestring:=true;
len:=0;
end;
concatwidestringchar(patternw,tcompilerwidechar(m));
end end
else else
Message(scan_e_illegal_char_const) Message(scan_e_illegal_char_const)
@ -2294,7 +2302,21 @@ implementation
else if iswidestring then else if iswidestring then
concatwidestringchar(patternw,asciichar2unicode(char(m))) concatwidestringchar(patternw,asciichar2unicode(char(m)))
else else
pattern:=pattern+chr(m); begin
if len<255 then
begin
inc(len);
pattern[len]:=chr(m);
end
else
begin
if not msgwritten then
begin
Message(scan_e_string_exceeds_255_chars);
msgwritten:=true;
end;
end;
end;
end; end;
'''' : '''' :
begin begin
@ -2315,7 +2337,21 @@ implementation
if iswidestring then if iswidestring then
concatwidestringchar(patternw,asciichar2unicode(c)) concatwidestringchar(patternw,asciichar2unicode(c))
else else
pattern:=pattern+c; begin
if len<255 then
begin
inc(len);
pattern[len]:=c;
end
else
begin
if not msgwritten then
begin
Message(scan_e_string_exceeds_255_chars);
msgwritten:=true;
end;
end;
end;
until false; until false;
end; end;
'^' : '^' :
@ -2330,7 +2366,21 @@ implementation
if iswidestring then if iswidestring then
concatwidestringchar(patternw,asciichar2unicode(c)) concatwidestringchar(patternw,asciichar2unicode(c))
else else
pattern:=pattern+c; begin
if len<255 then
begin
inc(len);
pattern[len]:=c;
end
else
begin
if not msgwritten then
begin
Message(scan_e_string_exceeds_255_chars);
msgwritten:=true;
end;
end;
end;
readchar; readchar;
end; end;
@ -2605,7 +2655,11 @@ exit_label:
end. end.
{ {
$Log$ $Log$
Revision 1.25 2001-10-17 22:41:05 florian Revision 1.26 2001-10-22 19:55:44 peter
* give error with string constants longer than 255 chars, this is
compatible with kylix
Revision 1.25 2001/10/17 22:41:05 florian
* several widechar fixes, case works now * several widechar fixes, case works now
Revision 1.24 2001/10/12 16:02:34 peter Revision 1.24 2001/10/12 16:02:34 peter

15
tests/webtbs/tw1318.pp
View File

@ -1,18 +1,23 @@
{ %VERSION=1.1 } { %VERSION=1.1 }
{$mode objfpc} {$ifdef fpc}{$mode objfpc}{$endif}
type type
rec = record
ch : char;
end;
TBadObject = class TBadObject = class
a: array[0..0] of char; a: array[0..0,0..0] of array[0..0] of rec;
public public
property a0: char read a[0]; property a0: char read a[0,0][0].ch;
end; end;
var var
BadObject: TBadObject; BadObject: TBadObject;
begin begin
BadObject := TBadObject.Create; BadObject := TBadObject.Create;
BadObject.a[0] := 'a'; BadObject.a[0,0][0].ch := 'a';
if BadObject.a0 = BadObject.a[0] then; if BadObject.a0 = BadObject.a[0,0][0].ch then;
BadObject.Free; BadObject.Free;
end. end.