paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 15:59:30 +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.
scan_w_appname_not_support=02060_W_APPNAME is only supported for PalmOS
% 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}
#
# Parser

5
compiler/msgidx.inc
View File

@ -77,6 +77,7 @@ const
scan_e_invalid_interface_type=02058;
scan_w_appid_not_support=02059;
scan_w_appname_not_support=02060;
scan_e_string_exceeds_255_chars=02061;
parser_e_syntax_error=03000;
parser_w_proc_far_ignored=03001;
parser_w_proc_near_ignored=03002;
@ -601,9 +602,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 33610;
MsgTxtSize = 33666;
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
);

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;
var
code : integer;
len,
low,high,mid : longint;
m : longint;
mac : tmacro;
asciinr : string[6];
msgwritten,
iswidestring : boolean;
label
exit_label;
@ -2230,6 +2232,9 @@ implementation
'''','#','^' :
begin
len:=0;
msgwritten:=false;
pattern:='';
iswidestring:=false;
if c='^' then
begin
@ -2244,15 +2249,14 @@ implementation
end
else
begin
inc(len);
if c<#64 then
pattern:=chr(ord(c)+64)
pattern[len]:=chr(ord(c)+64)
else
pattern:=chr(ord(c)-64);
pattern[len]:=chr(ord(c)-64);
readchar;
end;
end
else
pattern:='';
end;
repeat
case c of
'#' :
@ -2284,9 +2288,13 @@ implementation
begin
if (m>=0) and (m<=65535) then
begin
ascii2unicode(@pattern[1],length(pattern),patternw);
concatwidestringchar(patternw,tcompilerwidechar(m));
iswidestring:=true;
if not iswidestring then
begin
ascii2unicode(@pattern[1],len,patternw);
iswidestring:=true;
len:=0;
end;
concatwidestringchar(patternw,tcompilerwidechar(m));
end
else
Message(scan_e_illegal_char_const)
@ -2294,7 +2302,21 @@ implementation
else if iswidestring then
concatwidestringchar(patternw,asciichar2unicode(char(m)))
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;
'''' :
begin
@ -2315,7 +2337,21 @@ implementation
if iswidestring then
concatwidestringchar(patternw,asciichar2unicode(c))
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;
end;
'^' :
@ -2330,7 +2366,21 @@ implementation
if iswidestring then
concatwidestringchar(patternw,asciichar2unicode(c))
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;
end;
@ -2605,7 +2655,11 @@ exit_label:
end.
{
$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
Revision 1.24 2001/10/12 16:02:34 peter

15
tests/webtbs/tw1318.pp
View File

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