* fixed interface rtti, fixes bug #4089

git-svn-id: trunk@422 -

.gitattributes

@@ -5933,6 +5933,7 @@ tests/webtbs/tw4038.pp svneol=native#text/plain
 tests/webtbs/tw4055.pp svneol=native#text/plain
 tests/webtbs/tw4058.pp svneol=native#text/plain
 tests/webtbs/tw4078.pp svneol=native#text/plain
+tests/webtbs/tw4089.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

rtl/objpas/typinfo.pp

@@ -45,7 +45,7 @@ unit typinfo;
        TMethodKind = (mkProcedure,mkFunction,mkConstructor,mkDestructor,
                       mkClassProcedure, mkClassFunction);
        TParamFlags    = set of (pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut);
-       TIntfFlag      = (ifHasGuid,ifDispInterface,ifDispatch);
+       TIntfFlag      = (ifHasGuid,ifDispInterface,ifDispatch,ifHasStrGUID);
        TIntfFlags     = set of TIntfFlag;
        TIntfFlagsBase = set of TIntfFlag;
 
@@ -124,14 +124,21 @@ unit typinfo;
               (MinInt64Value, MaxInt64Value: Int64);
             tkQWord:
               (MinQWordValue, MaxQWordValue: QWord);
-            tkInterface,
-            tkInterfaceRaw:
+            tkInterface:
               (
-               IntfParent: PPTypeInfo;
-               IID: PGUID;
-               IIDStr: ShortString;
+               IntfParent: PTypeInfo;
+               IntfFlags : TIntfFlagsBase;
+               GUID: TGUID;
                IntfUnit: ShortString;
               );
+            tkInterfaceRaw:
+              (
+               RawIntfParent: PTypeInfo;
+               RawIntfFlags : TIntfFlagsBase;
+               IID: TGUID;
+               RawIntfUnit: ShortString;
+               IIDStr: ShortString;               
+              );
       end;
 
       // unsed, just for completeness

tests/webtbs/tw4089.pp

@@ -0,0 +1,36 @@
+{ Source provided for Free Pascal Bug Report 4089 }
+{ Submitted by "Martin Schreiber" on  2005-06-14 }
+{ e-mail:  }
+program project1;
+{$ifdef FPC}
+{$mode objfpc}{$H+}
+{$else}
+{$apptype console}
+{$endif}
+
+uses
+  Classes, SysUtils, typinfo;
+
+type
+
+ itest1 = interface
+  procedure test1;
+ end;
+ 
+ itest2 = interface(itest1)['{1A50A4E4-5B46-4C7C-A992-51EFEA1202B8}']
+  procedure test2;
+ end;
+
+var
+ po1: ptypeinfo;
+ po2: ptypedata;
+ 
+begin
+ po1:= typeinfo(itest2);
+ writeln('Kind: ',getenumname(typeinfo(ttypekind),ord(po1^.kind)));
+ writeln('Name: "',po1^.name,'"');
+ po2:= gettypedata(po1);
+ writeln('IntfParent: ',integer(po2^.intfparent));
+ writeln('Guid: ',po2^.guid.d1);
+ writeln('IntfUnit: "',po2^.IntfUnit,'"');
+end.