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

* fix #41062: correctly handle atomic intrinsics inside generics

Browse Source 
+ added test
This commit is contained in:
Sven/Sarah Barth 2024-12-13 21:29:20 +01:00
parent 0265d5d0c9
commit 6828da9c6c
2 changed files with 119 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/ninl.pas
View File

@ -4211,10 +4211,6 @@ implementation
in_atomic_inc,
in_atomic_xchg,
in_atomic_cmp_xchg:
begin
begin
resultdef:=voidtype;
if not(df_generic in current_procinfo.procdef.defoptions) then
begin
{ first parameter must exist for all }
if not assigned(left) or (left.nodetype<>callparan) then
@ -4296,16 +4292,13 @@ implementation
end
else if is_typeparam(tcallparanode(left).left.resultdef) then
begin
result:=cnothingnode.create;
exit;
resultdef:=tcallparanode(left).left.resultdef;
end
else if (inlinenumber=in_atomic_xchg) or (inlinenumber=in_atomic_cmp_xchg) then
CGMessagePos(tcallparanode(left).left.fileinfo,type_e_ordinal_or_pointer_expr_expected)
else
CGMessagePos(tcallparanode(left).left.fileinfo,type_e_ordinal_expr_expected);
end;
end;
end;
else
result:=pass_typecheck_cpu;
end;

35
tests/webtbs/tw41062.pp Normal file
View File

@ -0,0 +1,35 @@
{ %NORUN }
program tw41062;
{$mode delphi}{$H+}
type
{ TTest }
TTest = class
public
class procedure Test; static;
class function Test2<T>: T; static;
end;
class procedure TTest.Test;
var
Obj1, Obj2: TObject;
begin
if (AtomicCmpExchange(Pointer(Obj1), Pointer(Obj2), nil) <> nil) then; // It's ok
end;
class function TTest.Test2<T>: T;
var
Obj1, Obj2: TObject;
begin
AtomicCmpExchange(Pointer(Obj1), Pointer(Obj2), nil); // It's ok
if (AtomicCmpExchange(Pointer(Obj1), Pointer(Obj2), nil) <> nil) then; // Error: Operator is not overloaded: "untyped" = "^untyped"
end;
begin
end.