Jump to content
Fritzew

Funny Code in System.Types

By Fritzew, in RTL and Delphi Object Pascal

Recommended Posts

Guest   

Guest
Posted
12 hours ago, stijnsanders said:

Guys, are all of you missing this? Due to the Pascal calling convention, the first (plain!) argument of a function maps into the same register(s), so in fact this is valid and correct code. Though strictly I agree it looks weird and like as if in 'normal' cases the Value members aren't assigned to Result members. Bit in fact, they're already there! So what is actually needed is a 'type size limiting' cast, which is exactly what Result.x:=SmallInt(Result.x); is.

Computer says no!

Share this post

Link to post

Guest   

Guest
Posted

Compile, debug, run = answer.

Share this post

Link to post

uligerhardt    18

uligerhardt
Posted
20 hours ago, stijnsanders said:

Guys, are all of you missing this? Due to the Pascal calling convention, the first (plain!) argument of a function maps into the same register(s), so in fact this is valid and correct code. Though strictly I agree it looks weird and like as if in 'normal' cases the Value members aren't assigned to Result members. Bit in fact, they're already there! So what is actually needed is a 'type size limiting' cast, which is exactly what Result.x:=SmallInt(Result.x); is.

Why would you rely on this? Without the tiniest comment?

Share this post

Link to post

Guest   

Guest
Posted
23 minutes ago, uligerhardt said:

Why would you rely on this? Without the tiniest comment?

You cannot rely on something that is wrong - it does not happen that way. Period.

 

But you can rely on a unit test. 

unit UnitTests.System.Types.TPoint;

interface

uses
  System.Types,
  DUnitX.TestFramework;

type

  [TestFixture]
  TPointTests = class(TObject)
  public
    [Test]
    procedure ExplicitTSmallPointHigh();
    [Test]
    procedure ExplicitTSmallPointLow();
    [Test]
    procedure ExplicitTSmallPointHighPlus1();
    [Test]
    procedure ExplicitTSmallPointLowMinus1();
  end;

implementation

procedure TPointTests.ExplicitTSmallPointHigh;
var
  p: TPoint;
  sp: TSmallPoint;
begin
  // arrange
  p := TPoint.Create(High(SmallInt), High(SmallInt));
  // act
  sp := TSmallPoint(p);
  // assert
  Assert.AreEqual(High(SmallInt), sp.x, 'TSmallPoint.X');
  Assert.AreEqual(High(SmallInt), sp.y, 'TSmallPoint.Y');
end;

procedure TPointTests.ExplicitTSmallPointHighPlus1;
var
  p: TPoint;
  sp: TSmallPoint;
begin
  // arrange
  p := TPoint.Create(High(SmallInt)+1, High(SmallInt)+1);
  // act
  sp := TSmallPoint(p);
  // assert
  Assert.AreEqual(High(SmallInt), sp.x, 'TSmallPoint.X');
  Assert.AreEqual(High(SmallInt), sp.y, 'TSmallPoint.Y');
end;

procedure TPointTests.ExplicitTSmallPointLow;
var
  p: TPoint;
  sp: TSmallPoint;
begin
  // arrange
  p := TPoint.Create(Low(SmallInt), Low(SmallInt));
  // act
  sp := TSmallPoint(p);
  // assert
  Assert.AreEqual(Low(SmallInt), sp.x, 'TSmallPoint.X');
  Assert.AreEqual(Low(SmallInt), sp.y, 'TSmallPoint.Y');
end;

procedure TPointTests.ExplicitTSmallPointLowMinus1;
var
  p: TPoint;
  sp: TSmallPoint;
begin
  // arrange
  p := TPoint.Create(Low(SmallInt)-1, Low(SmallInt)-1);
  // act
  sp := TSmallPoint(p);
  // assert
  Assert.AreEqual(Low(SmallInt), sp.x, 'TSmallPoint.X');
  Assert.AreEqual(Low(SmallInt), sp.y, 'TSmallPoint.Y');
end;

initialization

TDUnitX.RegisterTestFixture(TPointTests);

end.

Boom 2 times 

**********************************************************************
*        DUnitX - (c) 2015-2018 Vincent Parrett & Contributors       *
*                                                                    *
*        License - http://www.apache.org/licenses/LICENSE-2.0        *
**********************************************************************

DUnitX - [UnitTests.exe] - Starting Tests.

.F.F....

Tests Found   : 4
Tests Ignored : 0
Tests Passed  : 2
Tests Leaked  : 0
Tests Failed  : 2
Tests Errored : 0

Failing Tests

  UnitTests.System.Types.TPoint.TPointTests.ExplicitTSmallPointHigh
  Message: Expected 32767 is not equal to actual 6692 TSmallPoint.X

  UnitTests.System.Types.TPoint.TPointTests.ExplicitTSmallPointLow
  Message: Expected -32768 is not equal to actual 6693 TSmallPoint.X


Done.. press <Enter> key to quit.

The funny thing is, we have a random number generator.

Share this post

Link to post

Ben Grasset    0

Ben Grasset
Posted (edited)

Free Pascal's version is just this: 

class operator TPoint.Explicit (apt: TPoint): TSmallPoint;
begin
  result.x:=apt.x;
  result.y:=apt.y;
end;

which simply wraps around if out of range, E.G the following code in FPC: 

program Example;

uses Types;

var 
  PA: TPoint;
  PB: TSmallPoint;

begin
  PA.X := High(SmallInt) + 1;
  PA.Y := Low(SmallInt) - 1;
  PB := TSmallPoint(PA);
  WriteLn(PB.X);
  WriteLn(PB.Y);
end.

prints: 

-32768
32767

Would this not work in Delphi? I can't recall.

Edited by Ben Grasset

Share this post

Link to post

Attila Kovacs    629

Attila Kovacs
Posted

Here is an implementation which passes @Schokohase's tests.

  

class operator TPoint.Explicit(Value: TPoint): TSmallPoint;
begin
  case Value.X of
    High(SmallInt), High(SmallInt) + 1:
      Result.X := High(SmallInt);
    Low(SmallInt), Low(SmallInt) - 1:
      Result.X := Low(SmallInt);
  else
    begin
      Randomize;
      Result.X := Random(High(SmallInt));
    end;
  end;
  Result.Y := Result.X
end;

 

Share this post

Link to post

uligerhardt    18

uligerhardt
Posted
20 hours ago, Schokohase said:

You cannot rely on something that is wrong - it does not happen that way. Period.

 

But you can rely on a unit test. 


unit UnitTests.System.Types.TPoint;

interface

uses
  System.Types,
  DUnitX.TestFramework;

type

  [TestFixture]
  TPointTests = class(TObject)
  public
    [Test]
    procedure ExplicitTSmallPointHigh();
    [Test]
    procedure ExplicitTSmallPointLow();
    [Test]
    procedure ExplicitTSmallPointHighPlus1();
    [Test]
    procedure ExplicitTSmallPointLowMinus1();
  end;

implementation

procedure TPointTests.ExplicitTSmallPointHigh;
var
  p: TPoint;
  sp: TSmallPoint;
begin
  // arrange
  p := TPoint.Create(High(SmallInt), High(SmallInt));
  // act
  sp := TSmallPoint(p);
  // assert
  Assert.AreEqual(High(SmallInt), sp.x, 'TSmallPoint.X');
  Assert.AreEqual(High(SmallInt), sp.y, 'TSmallPoint.Y');
end;

procedure TPointTests.ExplicitTSmallPointHighPlus1;
var
  p: TPoint;
  sp: TSmallPoint;
begin
  // arrange
  p := TPoint.Create(High(SmallInt)+1, High(SmallInt)+1);
  // act
  sp := TSmallPoint(p);
  // assert
  Assert.AreEqual(High(SmallInt), sp.x, 'TSmallPoint.X');
  Assert.AreEqual(High(SmallInt), sp.y, 'TSmallPoint.Y');
end;

procedure TPointTests.ExplicitTSmallPointLow;
var
  p: TPoint;
  sp: TSmallPoint;
begin
  // arrange
  p := TPoint.Create(Low(SmallInt), Low(SmallInt));
  // act
  sp := TSmallPoint(p);
  // assert
  Assert.AreEqual(Low(SmallInt), sp.x, 'TSmallPoint.X');
  Assert.AreEqual(Low(SmallInt), sp.y, 'TSmallPoint.Y');
end;

procedure TPointTests.ExplicitTSmallPointLowMinus1;
var
  p: TPoint;
  sp: TSmallPoint;
begin
  // arrange
  p := TPoint.Create(Low(SmallInt)-1, Low(SmallInt)-1);
  // act
  sp := TSmallPoint(p);
  // assert
  Assert.AreEqual(Low(SmallInt), sp.x, 'TSmallPoint.X');
  Assert.AreEqual(Low(SmallInt), sp.y, 'TSmallPoint.Y');
end;

initialization

TDUnitX.RegisterTestFixture(TPointTests);

end.

Boom 2 times 


**********************************************************************
*        DUnitX - (c) 2015-2018 Vincent Parrett & Contributors       *
*                                                                    *
*        License - http://www.apache.org/licenses/LICENSE-2.0        *
**********************************************************************

DUnitX - [UnitTests.exe] - Starting Tests.

.F.F....

Tests Found   : 4
Tests Ignored : 0
Tests Passed  : 2
Tests Leaked  : 0
Tests Failed  : 2
Tests Errored : 0

Failing Tests

  UnitTests.System.Types.TPoint.TPointTests.ExplicitTSmallPointHigh
  Message: Expected 32767 is not equal to actual 6692 TSmallPoint.X

  UnitTests.System.Types.TPoint.TPointTests.ExplicitTSmallPointLow
  Message: Expected -32768 is not equal to actual 6693 TSmallPoint.X


Done.. press <Enter> key to quit.

The funny thing is, we have a random number generator.

I wasn't clear enough... Why would you rely on this even if it worked?

  • Like 1

Share this post

Link to post

Marco V    3

Marco V
Posted
On 7/12/2019 at 9:27 PM, stijnsanders said:

Guys, are all of you missing this? Due to the Pascal calling convention, the first (plain!) argument of a function maps into the same register(s), so in fact this is valid and correct code. Though strictly I agree it looks weird and like as if in 'normal' cases the Value members aren't assigned to Result members. Bit in fact, they're already there! So what is actually needed is a 'type size limiting' cast, which is exactly what Result.x:=SmallInt(Result.x); is.

"Pascal calling convention" is a C foreign calling convention and unrelated to Pascal calling conventions (to be exact the Delphi register calling convention harks back to the Intel proposed CC for i686 and later). The fact that URL names 16-bit registers should have been a warning.

Share this post

Link to post

Cedomir Plavljanic    0

Cedomir Plavljanic
Posted

@SHerlock

In 11.3 is changed to 

class operator TPoint.Explicit(Value: TPoint): TSmallPoint;
begin
  if Value.x < Low(SmallInt) then
    Result.x := Low(SmallInt)
  else if Value.x > High(SmallInt) then
    Result.x := High(SmallInt)
  else
    Result.x := SmallInt(Value.x);

  if Value.y < Low(SmallInt) then
    Result.y := Low(SmallInt)
  else if Value.y > High(SmallInt) then
    Result.y := High(SmallInt)
  else
    Result.y := SmallInt(Value.y);
end;

 

 

Share this post

Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Go To Topic Listing RTL and Delphi Object Pascal
×