QualityCentral

Public Report

Report From: Delphi-BCB/Compiler/Delphi/RTTI [ Add a report in this area ]

Report #: 102627

Status: Open

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: 3/20/2012 2:24:39 AM

Platform: All platforms

Internal Tracking #: 289491

Resolution: None (Resolution Comments)

Resolved in Build: : None

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

Developer Tools

Database Tools