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

* support string constants > 255 chars

Browse Source 
* don't cut off anymore string constants silently at 255 chars

git-svn-id: trunk@14789 -
This commit is contained in:
florian 2010-01-24 09:28:46 +00:00
parent fe6a0d27a1
commit c6ffbe9eda
19 changed files with 503 additions and 424 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -7595,7 +7595,6 @@ tests/tbf/tb0109.pp svneol=native#text/plain
tests/tbf/tb0110.pp svneol=native#text/plain tests/tbf/tb0110.pp svneol=native#text/plain
tests/tbf/tb0111.pp svneol=native#text/plain tests/tbf/tb0111.pp svneol=native#text/plain
tests/tbf/tb0112.pp svneol=native#text/plain tests/tbf/tb0112.pp svneol=native#text/plain
tests/tbf/tb0113.pp svneol=native#text/plain
tests/tbf/tb0114.pp svneol=native#text/plain tests/tbf/tb0114.pp svneol=native#text/plain
tests/tbf/tb0115.pp svneol=native#text/plain tests/tbf/tb0115.pp svneol=native#text/plain
tests/tbf/tb0116.pp svneol=native#text/plain tests/tbf/tb0116.pp svneol=native#text/plain
@ -7712,6 +7711,7 @@ tests/tbf/tb0215d.pp svneol=native#text/plain
tests/tbf/tb0215e.pp svneol=native#text/plain tests/tbf/tb0215e.pp svneol=native#text/plain
tests/tbf/tb0216.pp svneol=native#text/plain tests/tbf/tb0216.pp svneol=native#text/plain
tests/tbf/tb0217.pp svneol=native#text/plain tests/tbf/tb0217.pp svneol=native#text/plain
tests/tbf/tb0218.pp svneol=native#text/plain
tests/tbf/ub0115.pp svneol=native#text/plain tests/tbf/ub0115.pp svneol=native#text/plain
tests/tbf/ub0149.pp svneol=native#text/plain tests/tbf/ub0149.pp svneol=native#text/plain
tests/tbf/ub0158a.pp svneol=native#text/plain tests/tbf/ub0158a.pp svneol=native#text/plain
@ -8274,6 +8274,7 @@ tests/tbs/tb0564.pp svneol=native#text/plain
tests/tbs/tb0565.pp svneol=native#text/plain tests/tbs/tb0565.pp svneol=native#text/plain
tests/tbs/tb0566.pp svneol=native#text/plain tests/tbs/tb0566.pp svneol=native#text/plain
tests/tbs/tb0567.pp svneol=native#text/plain tests/tbs/tb0567.pp svneol=native#text/plain
tests/tbs/tb0568.pp svneol=native#text/plain
tests/tbs/tb205.pp svneol=native#text/plain tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/ub0060.pp svneol=native#text/plain tests/tbs/ub0060.pp svneol=native#text/plain
tests/tbs/ub0069.pp svneol=native#text/plain tests/tbs/ub0069.pp svneol=native#text/plain
@ -8913,6 +8914,8 @@ tests/test/tclassinfo1.pp svneol=native#text/pascal
tests/test/tclrprop.pp svneol=native#text/plain tests/test/tclrprop.pp svneol=native#text/plain
tests/test/tcmp.pp svneol=native#text/plain tests/test/tcmp.pp svneol=native#text/plain
tests/test/tcmp0.pp svneol=native#text/plain tests/test/tcmp0.pp svneol=native#text/plain
tests/test/tcstring1.pp svneol=native#text/pascal
tests/test/tcstring2.pp svneol=native#text/pascal
tests/test/tdel1.pp svneol=native#text/plain tests/test/tdel1.pp svneol=native#text/plain
tests/test/tdispinterface1a.pp svneol=native#text/pascal tests/test/tdispinterface1a.pp svneol=native#text/pascal
tests/test/tdispinterface1b.pp svneol=native#text/pascal tests/test/tdispinterface1b.pp svneol=native#text/pascal

3
compiler/msg/errore.msg
View File

@ -1288,6 +1288,9 @@ parser_e_operator_not_overloaded_3=03284_E_Operator is not overloaded: "$1" $2 "
% this type. % this type.
parser_e_more_array_elements_expected=03285_E_Expected another $1 array elements parser_e_more_array_elements_expected=03285_E_Expected another $1 array elements
% When declaring a typed constant array, you provided to few elements to initialize the array % When declaring a typed constant array, you provided to few elements to initialize the array
parser_e_string_const_too_long=03286_E_String constant too long while ansistrings are disabled
% Only when a piece of code is compiled with ansistrings enabled (\var{\{\$H+\}}), string constants
% longer than 255 characters are allowed.
% \end{description} % \end{description}
# #
# Type Checking # Type Checking

5
compiler/msgidx.inc
View File

@ -373,6 +373,7 @@ const
parser_e_operator_not_overloaded_2=03283; parser_e_operator_not_overloaded_2=03283;
parser_e_operator_not_overloaded_3=03284; parser_e_operator_not_overloaded_3=03284;
parser_e_more_array_elements_expected=03285; parser_e_more_array_elements_expected=03285;
parser_e_string_const_too_long=03286;
type_e_mismatch=04000; type_e_mismatch=04000;
type_e_incompatible_types=04001; type_e_incompatible_types=04001;
type_e_not_equal_types=04002; type_e_not_equal_types=04002;
@ -850,9 +851,9 @@ const
option_info=11024; option_info=11024;
option_help_pages=11025; option_help_pages=11025;
MsgTxtSize = 55693; MsgTxtSize = 55757;
MsgIdxMax : array[1..20] of longint=( MsgIdxMax : array[1..20] of longint=(
24,87,286,95,80,51,110,22,202,63, 24,87,287,95,80,51,110,22,202,63,
49,20,1,1,1,1,1,1,1,1 49,20,1,1,1,1,1,1,1,1
); );

689
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

3
compiler/ncon.pas
View File

@ -300,7 +300,10 @@ implementation
begin begin
len:=p.value.len; len:=p.value.len;
if not(cs_ansistrings in current_settings.localswitches) and (len>255) then if not(cs_ansistrings in current_settings.localswitches) and (len>255) then
begin
message(parser_e_string_const_too_long);
len:=255; len:=255;
end;
getmem(pc,len+1); getmem(pc,len+1);
move(pchar(p.value.valueptr)^,pc^,len); move(pchar(p.value.valueptr)^,pc^,len);
pc[len]:=#0; pc[len]:=#0;

9
compiler/parser.pas
View File

@ -85,6 +85,7 @@ implementation
c:=#0; c:=#0;
pattern:=''; pattern:='';
orgpattern:=''; orgpattern:='';
cstringpattern:='';
current_scanner:=nil; current_scanner:=nil;
switchesstatestackpos:=0; switchesstatestackpos:=0;
@ -211,16 +212,16 @@ implementation
_CSTRING : _CSTRING :
begin begin
i:=0; i:=0;
while (i<length(pattern)) do while (i<length(cstringpattern)) do
begin begin
inc(i); inc(i);
if pattern[i]='''' then if cstringpattern[i]='''' then
begin begin
insert('''',pattern,i); insert('''',cstringpattern,i);
inc(i); inc(i);
end; end;
end; end;
preprocfile^.Add(''''+pattern+''''); preprocfile^.Add(''''+cstringpattern+'''');
end; end;
_CCHAR : _CCHAR :
begin begin

3
compiler/pbase.pas
View File

@ -327,6 +327,9 @@ implementation
begin begin
if deprecatedmsg<>nil then if deprecatedmsg<>nil then
internalerror(200910181); internalerror(200910181);
if token=_CSTRING then
deprecatedmsg:=stringdup(cstringpattern)
else
deprecatedmsg:=stringdup(pattern); deprecatedmsg:=stringdup(pattern);
consume(token); consume(token);
include(symopt,sp_has_deprecated_msg); include(symopt,sp_has_deprecated_msg);

11
compiler/pdecsub.pas
View File

@ -599,7 +599,7 @@ implementation
if (idtoken=_LOCATION) then if (idtoken=_LOCATION) then
begin begin
consume(_LOCATION); consume(_LOCATION);
locationstr:=pattern; locationstr:=cstringpattern;
consume(_CSTRING); consume(_CSTRING);
end end
else else
@ -1036,7 +1036,7 @@ implementation
if po_explicitparaloc in pd.procoptions then if po_explicitparaloc in pd.procoptions then
begin begin
consume(_LOCATION); consume(_LOCATION);
locationstr:=pattern; locationstr:=cstringpattern;
consume(_CSTRING); consume(_CSTRING);
end end
else else
@ -1276,11 +1276,16 @@ procedure pd_asmname(pd:tabstractprocdef);
begin begin
if pd.typ<>procdef then if pd.typ<>procdef then
internalerror(200304267); internalerror(200304267);
tprocdef(pd).aliasnames.insert(target_info.Cprefix+pattern);
if token=_CCHAR then if token=_CCHAR then
begin
tprocdef(pd).aliasnames.insert(target_info.Cprefix+pattern);
consume(_CCHAR) consume(_CCHAR)
end
else else
begin
tprocdef(pd).aliasnames.insert(target_info.Cprefix+cstringpattern);
consume(_CSTRING); consume(_CSTRING);
end;
{ we don't need anything else } { we don't need anything else }
tprocdef(pd).forwarddef:=false; tprocdef(pd).forwarddef:=false;
end; end;

2
compiler/pexports.pas
View File

@ -164,9 +164,7 @@ implementation
if pt.nodetype=stringconstn then if pt.nodetype=stringconstn then
hpname:=strpas(tstringconstnode(pt).value_str) hpname:=strpas(tstringconstnode(pt).value_str)
else else
begin
consume(_CSTRING); consume(_CSTRING);
end;
options:=options or eo_name; options:=options or eo_name;
pt.free; pt.free;
DefString:=hpname+'='+InternalProcName; DefString:=hpname+'='+InternalProcName;

2
compiler/pexpr.pas
View File

@ -2508,7 +2508,7 @@ implementation
_CSTRING : _CSTRING :
begin begin
p1:=cstringconstnode.createstr(pattern); p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern));
consume(_CSTRING); consume(_CSTRING);
end; end;

3
compiler/pmodules.pas
View File

@ -990,6 +990,9 @@ implementation
begin begin
if deprecatedmsg<>nil then if deprecatedmsg<>nil then
internalerror(201001221); internalerror(201001221);
if token=_CSTRING then
deprecatedmsg:=stringdup(cstringpattern)
else
deprecatedmsg:=stringdup(pattern); deprecatedmsg:=stringdup(pattern);
consume(token); consume(token);
include(moduleopt,mo_has_deprecated_msg); include(moduleopt,mo_has_deprecated_msg);

2
compiler/pstatmnt.pas
View File

@ -975,7 +975,7 @@ implementation
Message(parser_w_register_list_ignored); Message(parser_w_register_list_ignored);
repeat repeat
{ it's possible to specify the modified registers } { it's possible to specify the modified registers }
reg:=std_regnum_search(lower(pattern)); reg:=std_regnum_search(lower(cstringpattern));
if reg<>NR_NO then if reg<>NR_NO then
begin begin
if (getregtype(reg)=R_INTREGISTER) and not(po_assembler in current_procinfo.procdef.procoptions) then if (getregtype(reg)=R_INTREGISTER) and not(po_assembler in current_procinfo.procdef.procoptions) then

85
compiler/scanner.pas
View File

@ -201,6 +201,7 @@ interface
c : char; c : char;
orgpattern, orgpattern,
pattern : string; pattern : string;
cstringpattern : ansistring;
patternw : pcompilerwidestring; patternw : pcompilerwidestring;
{ token } { token }
@ -2038,6 +2039,7 @@ In case not, the value returned can be arbitrary.
procedure tscannerfile.recordtoken; procedure tscannerfile.recordtoken;
var var
a : array[0..1] of byte; a : array[0..1] of byte;
len : sizeint;
begin begin
if not assigned(recordtokenbuf) then if not assigned(recordtokenbuf) then
internalerror(200511176); internalerror(200511176);
@ -2088,8 +2090,13 @@ In case not, the value returned can be arbitrary.
recordtokenbuf.write(patternw^.len,sizeof(sizeint)); recordtokenbuf.write(patternw^.len,sizeof(sizeint));
recordtokenbuf.write(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar)); recordtokenbuf.write(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
end; end;
_CSTRING:
begin
len:=length(cstringpattern);
recordtokenbuf.write(len,sizeof(sizeint));
recordtokenbuf.write(pattern[1],length(pattern));
end;
_CCHAR, _CCHAR,
_CSTRING,
_INTCONST, _INTCONST,
_REALNUMBER : _REALNUMBER :
begin begin
@ -2166,10 +2173,19 @@ In case not, the value returned can be arbitrary.
replaytokenbuf.read(wlen,sizeof(SizeInt)); replaytokenbuf.read(wlen,sizeof(SizeInt));
setlengthwidestring(patternw,wlen); setlengthwidestring(patternw,wlen);
replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar)); replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
orgpattern:='';
pattern:='';
cstringpattern:='';
end;
_CSTRING:
begin
replaytokenbuf.read(wlen,sizeof(sizeint));
setlength(cstringpattern,wlen);
replaytokenbuf.read(pattern[1],length(pattern));
orgpattern:='';
pattern:=''; pattern:='';
end; end;
_CCHAR, _CCHAR,
_CSTRING,
_INTCONST, _INTCONST,
_REALNUMBER : _REALNUMBER :
begin begin
@ -3760,7 +3776,7 @@ In case not, the value returned can be arbitrary.
begin begin
len:=0; len:=0;
msgwritten:=false; msgwritten:=false;
pattern:=''; cstringpattern:='';
iswidestring:=false; iswidestring:=false;
if c='^' then if c='^' then
begin begin
@ -3776,10 +3792,11 @@ In case not, the value returned can be arbitrary.
else else
begin begin
inc(len); inc(len);
setlength(cstringpattern,256);
if c<#64 then if c<#64 then
pattern[len]:=chr(ord(c)+64) cstringpattern[len]:=chr(ord(c)+64)
else else
pattern[len]:=chr(ord(c)-64); cstringpattern[len]:=chr(ord(c)-64);
readchar; readchar;
end; end;
end; end;
@ -3838,7 +3855,7 @@ In case not, the value returned can be arbitrary.
begin begin
if not iswidestring then if not iswidestring then
begin begin
ascii2unicode(@pattern[1],len,patternw); ascii2unicode(@cstringpattern[1],len,patternw);
iswidestring:=true; iswidestring:=true;
len:=0; len:=0;
end; end;
@ -3851,19 +3868,10 @@ In case not, the value returned can be arbitrary.
concatwidestringchar(patternw,asciichar2unicode(char(m))) concatwidestringchar(patternw,asciichar2unicode(char(m)))
else else
begin begin
if len<255 then if len>=length(cstringpattern) then
begin setlength(cstringpattern,length(cstringpattern)+256);
inc(len); inc(len);
pattern[len]:=chr(m); cstringpattern[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; end;
'''' : '''' :
@ -3888,7 +3896,7 @@ In case not, the value returned can be arbitrary.
{ convert existing string to an utf-8 string } { convert existing string to an utf-8 string }
if not iswidestring then if not iswidestring then
begin begin
ascii2unicode(@pattern[1],len,patternw); ascii2unicode(@cstringpattern[1],len,patternw);
iswidestring:=true; iswidestring:=true;
len:=0; len:=0;
end; end;
@ -3934,19 +3942,10 @@ In case not, the value returned can be arbitrary.
end end
else else
begin begin
if len<255 then if len>=length(cstringpattern) then
begin setlength(cstringpattern,length(cstringpattern)+256);
inc(len); inc(len);
pattern[len]:=c; cstringpattern[len]:=c;
end
else
begin
if not msgwritten then
begin
Message(scan_e_string_exceeds_255_chars);
msgwritten:=true;
end;
end;
end; end;
until false; until false;
end; end;
@ -3963,19 +3962,10 @@ In case not, the value returned can be arbitrary.
concatwidestringchar(patternw,asciichar2unicode(c)) concatwidestringchar(patternw,asciichar2unicode(c))
else else
begin begin
if len<255 then if len>=length(cstringpattern) then
begin setlength(cstringpattern,length(cstringpattern)+256);
inc(len); inc(len);
pattern[len]:=c; cstringpattern[len]:=c;
end
else
begin
if not msgwritten then
begin
Message(scan_e_string_exceeds_255_chars);
msgwritten:=true;
end;
end;
end; end;
readchar; readchar;
@ -3994,9 +3984,12 @@ In case not, the value returned can be arbitrary.
end end
else else
begin begin
pattern[0]:=chr(len); setlength(cstringpattern,len);
if len=1 then if length(cstringpattern)=1 then
token:=_CCHAR begin
token:=_CCHAR;
pattern:=cstringpattern;
end
else else
token:=_CSTRING; token:=_CSTRING;
end; end;

40
tests/tbf/tb0218.pp Normal file
View File

@ -0,0 +1,40 @@
{ %fail }
{ Old file: tbs0229.pp }
{ consts > 255 are truncated (should work in -S2,-Sd) OK 0.99.11 (PFV) }
{ this is not true anymore because it can lead silently to bugs,
it is allowed now in $H+ mode else it causes an error (FK) }
{$mode objfpc}
{$X-}
const
CRLF = #13#10;
c =
'1-----------------'+CRLF+
'2/PcbDict 200 dict'+CRLF+
'3PcbDicljkljkljk b'+CRLF+
'4PcbDict /DictMaix'+CRLF+
'5% draw a pin-poll'+CRLF+
'6% get x+CRLF+ y s'+CRLF+
'7/thickness exch h'+CRLF+
'8gsave x y transls'+CRLF+
'9---------jljkljkl'+crlf+
'10----------2jkljk'+crlf+
'11----------jkllkk'+crlf+
'eeeeeeeeeeeeeeeeee'+crlf+
'2-----------------'+CRLF+
'2/PcbDict 200 dice'+CRLF+
'END____.XXXXXxjk b'+CRLF+
'4PcbDict /DictMaix'+CRLF+
'5% draw a pin-poll'+CRLF+
'6% get x+CRLF+ y s'+CRLF+
'7/thickness exch h'+CRLF+
'8gsave x y transls'+CRLF+
'9---------jljkljkl'+crlf+
'10----------2jkljk'+crlf+
'11----------jkllkk'+crlf+
'eeeeeeeeeeeeeeeeee12';
begin
write(c);
end.

4
tests/tbs/tb0195.pp
View File

@ -1,5 +1,9 @@
{ Old file: tbs0229.pp } { Old file: tbs0229.pp }
{ consts > 255 are truncated (should work in -S2,-Sd) OK 0.99.11 (PFV) } { consts > 255 are truncated (should work in -S2,-Sd) OK 0.99.11 (PFV) }
{ this is not true anymore because it can lead silently to bugs,
it is allowed now in $H+ mode else it causes an error (FK) }
{$H+}
{$mode objfpc} {$mode objfpc}
{$X-} {$X-}

5
tests/tbf/tb0113.pp → tests/tbs/tb0568.pp
View File

@ -1,8 +1,9 @@
{ %FAIL } { this is allowed now, even in $H- mode because '....' is handled as array in this case (FK) }
var var
i : integer; i : integer;
begin begin
{ String constants can't exceed 255 chars } { String constants can't exceed 255 chars }
i:=length('12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890'); i:=length('12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890');
if i<>280 then
halt(1);
end. end.

9
tests/test/tcstring1.pp Normal file
View File

@ -0,0 +1,9 @@
{$H+}
const
s = 'asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3';
begin
if length(s)<>1804 then
halt(1);
writeln('ok');
end.

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

@ -0,0 +1,10 @@
{ %fail }
{ this works only when ansistrings are enabled }
const
s = 'asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3asdfvkh4vk347vhjvkh7j3';
begin
if length(s)<>1804 then
halt(1);
writeln('ok');
end.

3
tests/webtbs/tw3082.pp
View File

@ -3,6 +3,9 @@
{ %skiptarget = go32v2,macos } { %skiptarget = go32v2,macos }
{ execute this test only on reasonable fast cpus } { execute this test only on reasonable fast cpus }
{ we do not cut off too long strings silently anymore }
{$H+}
{$ifdef darwin} {$ifdef darwin}
{$PIC+} {$PIC+}
{$endif darwin} {$endif darwin}