From 2ad3c6dd97d08494ba0406b59868a5fd1198cbb9 Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Sun, 16 Feb 2020 09:53:37 +0000
Subject: [PATCH] * fix global generic functions with constraints in mode
Delphi by handling implementations with defines outside of
parse_generic_parameters + added tests
git-svn-id: trunk@44189 -
---
.gitattributes | 3 +++
compiler/pdecsub.pas | 7 ++++++-
compiler/pparautl.pas | 15 +++++++++++----
tests/test/tgenfunc20.pp | 35 +++++++++++++++++++++++++++++++++++
tests/test/tgenfunc21.pp | 35 +++++++++++++++++++++++++++++++++++
tests/test/tgenfunc22.pp | 19 +++++++++++++++++++
6 files changed, 109 insertions(+), 5 deletions(-)
create mode 100644 tests/test/tgenfunc20.pp
create mode 100644 tests/test/tgenfunc21.pp
create mode 100644 tests/test/tgenfunc22.pp
diff --git a/.gitattributes b/.gitattributes
index 66deef6aa7..0f81e59b24 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -14768,6 +14768,9 @@ tests/test/tgenfunc17.pp svneol=native#text/pascal
tests/test/tgenfunc18.pp svneol=native#text/pascal
tests/test/tgenfunc19.pp svneol=native#text/pascal
tests/test/tgenfunc2.pp svneol=native#text/pascal
+tests/test/tgenfunc20.pp svneol=native#text/pascal
+tests/test/tgenfunc21.pp svneol=native#text/pascal
+tests/test/tgenfunc22.pp svneol=native#text/pascal
tests/test/tgenfunc3.pp svneol=native#text/pascal
tests/test/tgenfunc4.pp svneol=native#text/pascal
tests/test/tgenfunc5.pp svneol=native#text/pascal
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 011677fc8e..b3f6d4e5f7 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -664,7 +664,7 @@ implementation
message(type_e_type_id_expected)
else
begin
- genericparams:=parse_generic_parameters(not(m_delphi in current_settings.modeswitches) or parse_only);
+ genericparams:=parse_generic_parameters(true);
if not assigned(genericparams) then
internalerror(2015061201);
if genericparams.count=0 then
@@ -835,6 +835,11 @@ implementation
messagepos1(decltype.fileinfo,sym_e_generic_type_param_decl,decltype.realname);
result:=false;
end;
+ if df_genconstraint in impltype.typedef.defoptions then
+ begin
+ messagepos(tstoreddef(impltype.typedef).genconstraintdata.fileinfo,parser_e_generic_constraints_not_allowed_here);
+ result:=false;
+ end;
end;
end;
diff --git a/compiler/pparautl.pas b/compiler/pparautl.pas
index f18ca3a515..73f4ef3e4b 100644
--- a/compiler/pparautl.pas
+++ b/compiler/pparautl.pas
@@ -644,6 +644,11 @@ implementation
messagepos1(fwtype.fileinfo,sym_e_generic_type_param_decl,fwtype.realname);
result:=false;
end;
+ if (fwpd.interfacedef or assigned(fwpd.struct)) and (df_genconstraint in currtype.typedef.defoptions) then
+ begin
+ messagepos(tstoreddef(currtype.typedef).genconstraintdata.fileinfo,parser_e_generic_constraints_not_allowed_here);
+ result:=false;
+ end;
end;
end;
@@ -664,15 +669,17 @@ implementation
- proc declared in interface of unit (or in class/record/object)
and defined in implementation; here the fwpd might contain
constraints while currpd must only contain undefineddefs
- - forward declaration in implementation }
+ - forward declaration in implementation: here constraints must be
+ repeated }
foundretdef:=false;
for i:=0 to fwpd.genericparas.count-1 do
begin
fwtype:=ttypesym(fwpd.genericparas[i]);
currtype:=ttypesym(currpd.genericparas[i]);
- { if the type in the currpd isn't a pure undefineddef, then we can
- stop right there }
- if (currtype.typedef.typ<>undefineddef) or (df_genconstraint in currtype.typedef.defoptions) then
+ { if the type in the currpd isn't a pure undefineddef (thus there
+ are constraints and the fwpd was declared in the interface, then
+ we can stop right there }
+ if fwpd.interfacedef and ((currtype.typedef.typ<>undefineddef) or (df_genconstraint in currtype.typedef.defoptions)) then
exit;
if not foundretdef then
begin
diff --git a/tests/test/tgenfunc20.pp b/tests/test/tgenfunc20.pp
new file mode 100644
index 0000000000..834ad7c7a0
--- /dev/null
+++ b/tests/test/tgenfunc20.pp
@@ -0,0 +1,35 @@
+unit tgenfunc20;
+
+{$mode objfpc}{$H+}
+
+interface
+
+{generic procedure TestProc1<T: class>;
+
+type
+ TTest = class
+ generic procedure Test<T: class>;
+ end;}
+
+implementation
+
+generic procedure TestProc2<T: class>; forward;
+
+{generic procedure TestProc1<T>;
+begin
+end;
+
+generic procedure TestProc1<T: class>(aArg1: T);
+begin
+end;}
+
+generic procedure TestProc2<T: class>;
+begin
+end;
+
+{generic procedure TTest.Test<T>;
+begin
+end;}
+
+end.
+
diff --git a/tests/test/tgenfunc21.pp b/tests/test/tgenfunc21.pp
new file mode 100644
index 0000000000..f6879823ed
--- /dev/null
+++ b/tests/test/tgenfunc21.pp
@@ -0,0 +1,35 @@
+unit tgenfunc21;
+
+{$mode delphi}
+
+interface
+
+procedure TestProc1<T: class>; overload;
+
+type
+ TTest = class
+ procedure Test<T: class>;
+ end;
+
+implementation
+
+procedure TestProc2<T: class>; forward;
+
+procedure TestProc1<T>;
+begin
+end;
+
+procedure TestProc1<T: class>(aArg1: T); overload;
+begin
+end;
+
+procedure TestProc2<T: class>;
+begin
+end;
+
+procedure TTest.Test<T>;
+begin
+end;
+
+end.
+
diff --git a/tests/test/tgenfunc22.pp b/tests/test/tgenfunc22.pp
new file mode 100644
index 0000000000..acb01c8c1e
--- /dev/null
+++ b/tests/test/tgenfunc22.pp
@@ -0,0 +1,19 @@
+{ %FAIL }
+
+unit tgenfunc22;
+
+{$mode delphi}
+
+interface
+
+procedure Test<T: class>;
+
+implementation
+
+procedure Test<T: class>;
+begin
+
+end;
+
+end.
+