From 1bbcc08a8b9ff6fde03e9f8193c71a3854a580ee Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Fri, 6 Jun 2014 13:26:21 +0000
Subject: [PATCH] Fix for Mantis #26176. Don't handle "type helper" as unique.

ptype.pas:
  * read_named_type: change hadtypetoken from a value to a var parameter and set it to false if a type helper is parsed so that calling code does not handle it as unique
  * read_anon_type: handle that hadtypetoken is now a var parameter

pgenutil.pas, generate_specialization:
  * handle that hadtypetoken of read_named_type is now a var parameter

+ added test

git-svn-id: trunk@27870 -
---
 .gitattributes          |  1 +
 compiler/pgenutil.pas   |  4 +++-
 compiler/ptype.pas      | 12 +++++++++---
 tests/webtbf/tw26176.pp | 16 ++++++++++++++++
 4 files changed, 29 insertions(+), 4 deletions(-)
 create mode 100644 tests/webtbf/tw26176.pp

diff --git a/.gitattributes b/.gitattributes
index 86f88e3497..8f5ef0926b 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -12747,6 +12747,7 @@ tests/webtbf/tw25861.pp svneol=native#text/plain
 tests/webtbf/tw25862.pp svneol=native#text/plain
 tests/webtbf/tw25915.pp svneol=native#text/pascal
 tests/webtbf/tw25951.pp svneol=native#text/pascal
+tests/webtbf/tw26176.pp svneol=native#text/pascal
 tests/webtbf/tw26193.pp svneol=native#text/pascal
 tests/webtbf/tw2657.pp svneol=native#text/plain
 tests/webtbf/tw2670.pp svneol=native#text/plain
diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas
index 40e0fa86ba..5b12b97ff7 100644
--- a/compiler/pgenutil.pas
+++ b/compiler/pgenutil.pas
@@ -384,6 +384,7 @@ uses
         st  : TSymtable;
         srsym : tsym;
         pt2 : tnode;
+        hadtypetoken,
         errorrecovery,
         found,
         first,
@@ -824,7 +825,8 @@ uses
                 else
                   recordbuf:=nil;
                 current_scanner.startreplaytokens(genericdef.generictokenbuf);
-                read_named_type(tt,srsym,genericdef,generictypelist,false,false);
+                hadtypetoken:=false;
+                read_named_type(tt,srsym,genericdef,generictypelist,false,hadtypetoken);
                 current_filepos:=oldcurrent_filepos;
                 ttypesym(srsym).typedef:=tt;
                 tt.typesym:=srsym;
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index f57574141a..9c3269e46f 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -44,7 +44,7 @@ interface
     procedure single_type(var def:tdef;options:TSingleTypeOptions);
 
     { reads any type declaration, where the resulting type will get name as type identifier }
-    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;hadtypetoken:boolean);
+    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;var hadtypetoken:boolean);
 
     { reads any type declaration }
     procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
@@ -946,7 +946,7 @@ implementation
 
 
     { reads a type definition and returns a pointer to it }
-    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;hadtypetoken:boolean);
+    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;var hadtypetoken:boolean);
       var
         pt : tnode;
         tt2 : tdef;
@@ -1802,6 +1802,9 @@ implementation
                     ([m_delphi,m_type_helpers]*current_settings.modeswitches=[m_type_helpers]) and
                     (token=_ID) and (idtoken=_HELPER) then
                   begin
+                    { reset hadtypetoken, so that calling code knows that it should not be handled
+                      as a "unique" type }
+                    hadtypetoken:=false;
                     consume(_HELPER);
                     def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
                   end
@@ -1815,8 +1818,11 @@ implementation
 
 
     procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
+      var
+        hadtypetoken : boolean;
       begin
-        read_named_type(def,nil,nil,nil,parseprocvardir,false);
+        hadtypetoken:=false;
+        read_named_type(def,nil,nil,nil,parseprocvardir,hadtypetoken);
       end;
 
 
diff --git a/tests/webtbf/tw26176.pp b/tests/webtbf/tw26176.pp
new file mode 100644
index 0000000000..850e510345
--- /dev/null
+++ b/tests/webtbf/tw26176.pp
@@ -0,0 +1,16 @@
+{ %fail }
+
+program tw26176;
+
+{$MODE OBJFPC}
+{$MODESWITCH TYPEHELPERS}
+
+type
+  TIH = type helper for Int32
+    // NO (!) error - Forward declaration not solved "Foo(TObject);"
+    procedure Foo(Sender: TObject);
+  end;
+
+begin
+end.
+