default parameter values: fix crash

Fix crash when declaring default parameter values while current_procinfo
is not yet valid

resolves #40413
This commit is contained in:
Jonas Maebe 2023-09-11 21:08:49 +02:00
parent a6b508b094
commit bcf77c70fd
2 changed files with 71 additions and 2 deletions

View File

@ -492,9 +492,11 @@ implementation
internalerror(2012032102);
def:=ttypenode(left).typedef;
if df_generic in current_procinfo.procdef.defoptions then
if assigned(current_procinfo) and
(df_generic in current_procinfo.procdef.defoptions) then
begin
{ don't allow as a default parameter value }
{ don't allow as a default parameter value, because it may not be valid
when specialising }
if block_type<>bt_const then
result:=cpointerconstnode.create(0,def)
else

67
tests/webtbs/tw40413.pp Normal file
View File

@ -0,0 +1,67 @@
{$mode objfpc}
{$h+}
{$codepage utf8}
program defaulting;
var
a: integer = 0;
b: integer = default(integer);
function c (d: integer = 0): integer;
begin
result := d;
end;
procedure g (h: integer = 0);
var
i: integer = default(integer);
begin
writeln(h, i);
if h<>0 then
halt(1);
if i<>0 then
halt(2);
end;
procedure j (k: integer = default(integer));
var
l: integer = default(integer);
begin
writeln(k, l);
if k<>0 then
halt(3);
if l<>0 then
halt(4);
end;
function e (f: integer = default(integer)): integer;
begin
result := f;
end;
function m (n: string = default(string)): string;
var
o: string = '1';
p: string = default(string);
q: string = '';
r: string = '2';
begin
result := n + o + p + q + r;
end;
begin
writeln(a, b, c);
if a<>0 then
halt(5);
if b<>0 then
halt(6);
if c<>0 then
halt(7);
g;
j;
writeln(m);
if m<>'12' then
halt(8);
end.