mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-10 05:46:14 +02:00
* turn openstring value parameters into regular shortstring parameters
(mantis #14940 and #14941) * only turn var/our shortstring parameters with a length of 255 into openstring parameters with {$p+} (new tbf/tb0217.pp) git-svn-id: trunk@14602 -
This commit is contained in:
parent
d6b2b55d41
commit
a1bcc1c8d2
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -7708,6 +7708,7 @@ tests/tbf/tb0215c.pp svneol=native#text/plain
|
||||
tests/tbf/tb0215d.pp svneol=native#text/plain
|
||||
tests/tbf/tb0215e.pp svneol=native#text/plain
|
||||
tests/tbf/tb0216.pp svneol=native#text/plain
|
||||
tests/tbf/tb0217.pp svneol=native#text/plain
|
||||
tests/tbf/ub0115.pp svneol=native#text/plain
|
||||
tests/tbf/ub0149.pp svneol=native#text/plain
|
||||
tests/tbf/ub0158a.pp svneol=native#text/plain
|
||||
@ -10176,6 +10177,8 @@ tests/webtbs/tw14812.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14841.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1485.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1489.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14941.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14941a.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14958a.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14958b.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14992a.pp svneol=native#text/pascal
|
||||
|
@ -571,11 +571,29 @@ implementation
|
||||
end;
|
||||
|
||||
{ open string ? }
|
||||
if (varspez in [vs_out,vs_var]) and
|
||||
(cs_openstring in current_settings.moduleswitches) and
|
||||
is_shortstring(hdef) then
|
||||
hdef:=openshortstringtype;
|
||||
|
||||
if is_shortstring(hdef) then
|
||||
begin
|
||||
case varspez of
|
||||
vs_var,vs_out:
|
||||
begin
|
||||
{ not 100% Delphi-compatible: type xstr=string[255] cannot
|
||||
become an openstring there, while here it can }
|
||||
if (cs_openstring in current_settings.moduleswitches) and
|
||||
(tstringdef(hdef).len=255) then
|
||||
hdef:=openshortstringtype
|
||||
end;
|
||||
vs_value:
|
||||
begin
|
||||
{ value "openstring" parameters don't make sense (the
|
||||
original string can never be modified, so there's no
|
||||
use in passing its original length), so change these
|
||||
into regular shortstring parameters (seems to be what
|
||||
Delphi also does) }
|
||||
if is_open_string(hdef) then
|
||||
hdef:=cshortstringtype;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then
|
||||
begin
|
||||
if (idtoken=_LOCATION) then
|
||||
|
17
tests/tbf/tb0217.pp
Normal file
17
tests/tbf/tb0217.pp
Normal file
@ -0,0 +1,17 @@
|
||||
{ %fail }
|
||||
|
||||
{$p+}
|
||||
{$v+}
|
||||
type
|
||||
tstr = string[8];
|
||||
|
||||
{ FPC used to convert the following parameter into an openstring }
|
||||
procedure test(var str: tstr);
|
||||
begin
|
||||
end;
|
||||
|
||||
var
|
||||
s: string[20];
|
||||
begin
|
||||
test(s);
|
||||
end.
|
21
tests/webtbs/tw14941.pp
Normal file
21
tests/webtbs/tw14941.pp
Normal file
@ -0,0 +1,21 @@
|
||||
program StringTest5;
|
||||
{$V+}
|
||||
var
|
||||
s :String;
|
||||
|
||||
procedure P( s: OpenString);
|
||||
begin
|
||||
writeln(s);
|
||||
if (high(s)<>255) or
|
||||
(s<>'12345') then
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
begin
|
||||
P('12345');
|
||||
s:='12345';
|
||||
p(s);
|
||||
{Won't compile.
|
||||
FPC or Turbo Pascal mode: Internal error 200405241
|
||||
Delphi mode: Signal 291. Save files and restart IDE. (Can't save.)}
|
||||
end.
|
24
tests/webtbs/tw14941a.pp
Normal file
24
tests/webtbs/tw14941a.pp
Normal file
@ -0,0 +1,24 @@
|
||||
program StringTest5;
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$V+}
|
||||
var
|
||||
s :String;
|
||||
|
||||
procedure P( s: OpenString);
|
||||
begin
|
||||
writeln(s);
|
||||
if (high(s)<>255) or
|
||||
(s<>'12345') then
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
begin
|
||||
P('12345');
|
||||
s:='12345';
|
||||
p(s);
|
||||
{Won't compile.
|
||||
FPC or Turbo Pascal mode: Internal error 200405241
|
||||
Delphi mode: Signal 291. Save files and restart IDE. (Can't save.)}
|
||||
end.
|
Loading…
Reference in New Issue
Block a user