2
0
Эх сурвалжийг харах

* fix for Mantis #35533: when searching for helpers on types that usually don't support a point operator, don't use automatic dereferentiation
+ added tests

git-svn-id: trunk@42036 -

svenbarth 6 жил өмнө
parent
commit
251c559662

+ 3 - 0
.gitattributes

@@ -14083,6 +14083,8 @@ tests/test/tthlp25.pp svneol=native#text/pascal
 tests/test/tthlp26a.pp -text svneol=native#text/pascal
 tests/test/tthlp26a.pp -text svneol=native#text/pascal
 tests/test/tthlp26b.pp -text svneol=native#text/pascal
 tests/test/tthlp26b.pp -text svneol=native#text/pascal
 tests/test/tthlp26c.pp -text svneol=native#text/pascal
 tests/test/tthlp26c.pp -text svneol=native#text/pascal
+tests/test/tthlp27.pp svneol=native#text/pascal
+tests/test/tthlp28.pp svneol=native#text/pascal
 tests/test/tthlp3.pp svneol=native#text/pascal
 tests/test/tthlp3.pp svneol=native#text/pascal
 tests/test/tthlp4.pp svneol=native#text/pascal
 tests/test/tthlp4.pp svneol=native#text/pascal
 tests/test/tthlp5.pp svneol=native#text/pascal
 tests/test/tthlp5.pp svneol=native#text/pascal
@@ -16612,6 +16614,7 @@ tests/webtbs/tw3533.pp svneol=native#text/plain
 tests/webtbs/tw3534.pp svneol=native#text/plain
 tests/webtbs/tw3534.pp svneol=native#text/plain
 tests/webtbs/tw3540.pp svneol=native#text/plain
 tests/webtbs/tw3540.pp svneol=native#text/plain
 tests/webtbs/tw3546.pp svneol=native#text/plain
 tests/webtbs/tw3546.pp svneol=native#text/plain
+tests/webtbs/tw35533.pp svneol=native#text/pascal
 tests/webtbs/tw3554.pp svneol=native#text/plain
 tests/webtbs/tw3554.pp svneol=native#text/plain
 tests/webtbs/tw3564.pp svneol=native#text/plain
 tests/webtbs/tw3564.pp svneol=native#text/plain
 tests/webtbs/tw3567.pp svneol=native#text/plain
 tests/webtbs/tw3567.pp svneol=native#text/plain

+ 17 - 1
compiler/pexpr.pas

@@ -2003,6 +2003,7 @@ implementation
      { shouldn't be used that often, so the extra overhead is ok to save
      { shouldn't be used that often, so the extra overhead is ok to save
        stack space }
        stack space }
      dispatchstring : ansistring;
      dispatchstring : ansistring;
+     autoderef,
      erroroutp1,
      erroroutp1,
      allowspecialize,
      allowspecialize,
      isspecialize,
      isspecialize,
@@ -2229,6 +2230,7 @@ implementation
                  end
                  end
                else
                else
                  isspecialize:=false;
                  isspecialize:=false;
+               autoderef:=false;
                if (p1.resultdef.typ=pointerdef) and
                if (p1.resultdef.typ=pointerdef) and
                   (m_autoderef in current_settings.modeswitches) and
                   (m_autoderef in current_settings.modeswitches) and
                   { don't auto-deref objc.id, because then the code
                   { don't auto-deref objc.id, because then the code
@@ -2237,6 +2239,7 @@ implementation
                  begin
                  begin
                    p1:=cderefnode.create(p1);
                    p1:=cderefnode.create(p1);
                    do_typecheckpass(p1);
                    do_typecheckpass(p1);
+                   autoderef:=true;
                  end;
                  end;
                { procvar.<something> can never mean anything so always
                { procvar.<something> can never mean anything so always
                  try to call it in case it returns a record/object/... }
                  try to call it in case it returns a record/object/... }
@@ -2660,7 +2663,20 @@ implementation
                     end;
                     end;
                   else
                   else
                     begin
                     begin
-                      found:=try_type_helper(p1,nil);
+                      if autoderef then
+                        begin
+                          { always try with the not dereferenced node }
+                          p2:=tderefnode(p1).left;
+                          found:=try_type_helper(p2,nil);
+                          if found then
+                            begin
+                              tderefnode(p1).left:=nil;
+                              p1.destroy;
+                              p1:=p2;
+                            end;
+                        end
+                      else
+                        found:=try_type_helper(p1,nil);
                       if not found then
                       if not found then
                         begin
                         begin
                           if p1.resultdef.typ<>undefineddef then
                           if p1.resultdef.typ<>undefineddef then

+ 21 - 0
tests/test/tthlp27.pp

@@ -0,0 +1,21 @@
+{ %FAIL }
+
+program tthlp27;
+
+{$mode delphi}
+
+type
+  TLongIntHelper = record helper for LongInt
+    procedure Test;
+  end;
+
+procedure TLongIntHelper.Test;
+begin
+
+end;
+
+var
+  p: PLongInt;
+begin
+  p.Test;
+end.

+ 21 - 0
tests/test/tthlp28.pp

@@ -0,0 +1,21 @@
+{ %NORUN }
+
+program tthlp28;
+
+{$mode delphi}
+
+type
+  TPLongIntHelper = record helper for PLongInt
+    procedure Test;
+  end;
+
+procedure TPLongIntHelper.Test;
+begin
+
+end;
+
+var
+  p: PLongInt;
+begin
+  p.Test;
+end.

+ 30 - 0
tests/webtbs/tw35533.pp

@@ -0,0 +1,30 @@
+{ %NORUN }
+
+program tw35533;
+{$mode delphiunicode}
+
+type
+  TPointerHelper = record helper for pointer
+    function AsNativeUint: nativeuint;
+    function PCharLen: uint32;
+  end;
+
+function TPointerHelper.AsNativeUint: nativeuint;
+begin
+  Result := nativeuint(self);
+end;
+
+function TPointerHelper.PCharLen: uint32;
+begin
+  Result := 5; //- Just here to illustrate the issue.
+end;
+
+var
+  P: pointer;
+
+begin
+  P := @ParamStr(0); //- Just a nonsense pointer.
+  Writeln( P.AsNativeUInt );
+  Writeln( P.PCharLen );
+  Readln;
+end.