Watch, Follow, &
Connect with Us
Public Report
Report From: Delphi-BCB/Compiler/Delphi/RTTI    [ Add a report in this area ]  
Report #:  102627   Status: Closed
TVirtualMethodInterceptor does not handle const float arguments correctly
Project:  Delphi Build #:  15.0.3953.35171
Version:    15.1 Submitted By:   Stefan Glienke
Report Type:  Crash / Data loss / Total failure Date Reported:  1/16/2012 5:37:18 AM
Severity:    Serious / Highly visible problem Last Updated: 4/15/2014 6:48:44 PM
Platform:    All platforms Internal Tracking #:   24474
Resolution: Fixed (Resolution Comments) Resolved in Build: : XE6
Duplicate of:  None
Voting and Rating
Overall Rating: No Ratings Yet
0.00 out of 5
Total Votes: None
Description
See steps

The problem is in TVirtualMethodInterceptor.RawCallback where const float arguments are handled as ref.

Suggestion: Use the PassArg routine introduced in XE2
Steps to Reproduce:
- compile and run the following program

expected: output is PASS
actual:
XE2 Win32:
FAIL - Exception Error
  ClassName=EInvalidOp
    Message=Invalid floating point operation

XE2 Win64: (this is QC 99028/#287732)
FAIL #1
FAIL

- make Float an alias for Double
- compile and run again

expected: output is PASS
actual:
XE2 Win32:
FAIL #1
(followed by Windows APPCRASH dialog)

XE2 Win64: (this is QC 99028/#287732)
FAIL #1
FAIL

When Float is an alias for Single it passes.


program QC102627;

{$APPTYPE CONSOLE}

uses
  SysUtils, Rtti;

var
  Counter: Integer = 0;

type
  Float = Extended;

  TFoo = class
    procedure Bar(const Value: Float); virtual;
  end;

procedure TFoo.Bar(const Value: Float);
begin
  // wrong value of Value and crash when leaving this method
  if Value = 42 then
    Inc(Counter)
  else
    WriteLn('FAIL #1');
end;

var
  Intercept: TVirtualMethodInterceptor;
  Foo: TFoo;
  F42: Float;
begin
  Foo := TFoo.Create;

  Intercept := TVirtualMethodInterceptor.Create(TFoo);
  Intercept.Proxify(Foo);

  try
    F42 := 42;
    Foo.Bar(F42);
    if Counter = 1 then
      WriteLn('PASS')
    else
      WriteLn('FAIL');
  except
    on E: Exception do
    begin
      Writeln('FAIL - Exception Error');
      WriteLn('  ClassName=', E.ClassName);
      WriteLn('    Message=', E.Message);
    end;
  end;
end.
Workarounds
None
Attachment
None
Comments

None

Server Response from: ETNACODE01