Fix for Mantis #24651. Allow pointer comparison for internal expressions (in this case check for valid VMT).

nadd.pas, taddnode:
  + add new constructor "create_internal" which adds "nf_internal" to the node's "flags"
  * pass_typecheck_internal: allow pointer comparisons other than "=" and "<>" for nodes which have "nf_internal" set
psub.pas, generate_bodyentry_block:
  * create the addnode using "create_internal" instead of "create" to allow the pointer comparison

+ added test 

git-svn-id: trunk@25069 -

.gitattributes

@@ -13456,6 +13456,7 @@ tests/webtbs/tw2438.pp svneol=native#text/plain
 tests/webtbs/tw2442.pp svneol=native#text/plain
 tests/webtbs/tw2452.pp svneol=native#text/plain
 tests/webtbs/tw2454.pp svneol=native#text/plain
+tests/webtbs/tw24651.pp svneol=native#text/pascal
 tests/webtbs/tw24705.pp svneol=native#text/pascal
 tests/webtbs/tw2473.pp svneol=native#text/plain
 tests/webtbs/tw2480.pp svneol=native#text/plain

compiler/nadd.pas

@@ -38,6 +38,7 @@ interface
        public
           resultrealdef : tdef;
           constructor create(tt : tnodetype;l,r : tnode);override;
+          constructor create_internal(tt:tnodetype;l,r:tnode);
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
@@ -153,6 +154,13 @@ implementation
       end;
 
 
+    constructor taddnode.create_internal(tt: tnodetype; l, r: tnode);
+      begin
+        create(tt,l,r);
+        include(flags,nf_internal);
+      end;
+
+
     constructor taddnode.ppuload(t: tnodetype; ppufile: tcompilerppufile);
       begin
         inherited ppuload(t, ppufile);
@@ -1638,7 +1646,8 @@ implementation
                  end;
                ltn,lten,gtn,gten:
                  begin
-                    if (cs_extsyntax in current_settings.moduleswitches) then
+                    if (cs_extsyntax in current_settings.moduleswitches) or
+                       (nf_internal in flags) then
                      begin
                        if is_voidpointer(right.resultdef) then
                         inserttypeconv(right,left.resultdef)

compiler/psub.pas

@@ -449,7 +449,7 @@ implementation
                       begin
                         { if vmt>1 then newinstance }
                         addstatement(newstatement,cifnode.create(
-                            caddnode.create(gtn,
+                            caddnode.create_internal(gtn,
                                 ctypeconvnode.create_internal(
                                     load_vmt_pointer_node,
                                     voidpointertype),

tests/webtbs/tw24651.pp

@@ -0,0 +1,47 @@
+{ %NORUN }
+
+program tw24651;
+
+//{$mode delphi}{$H+}
+{$modeswitch class}
+{$A+}
+{$B-}
+{$I+}
+{$X-}
+
+uses
+  Classes
+  { you can add units after this };
+
+type
+  o_Class1 = class
+    fString1 : string ;
+    constructor Create ;
+  end ;
+
+  o_Class2 = class (o_Class1)
+    fString2 : string ;
+    constructor Create (aStr : string) ;
+  end ;
+
+constructor o_Class1.Create ;
+//var t_o : pointer ;
+begin
+  {t_o := }inherited Create ;
+  fString1 := 'test value'
+end ;
+
+constructor o_Class2.Create (aStr : string) ;
+//var c_1 : pointer;
+begin
+  {c_1 := }inherited Create ;
+  fstring2 := aStr
+end ;
+
+var
+  C2 : o_Class2 ;
+
+begin
+  C2 := o_Class2.Create ('test param') ;
+  WriteLn (C2.fString1)
+end.