mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 08:06:07 +02:00
compiler: allow comparative operators to have result other than Boolean. Reasons:
1. It allows to use comparative operators in some unusual cases (issue #25004). 2. Regular type checking does not allow to use other than Boolean types in IF expressions anyway. 3. Delphi compatibility (although Delphi documentation states otherwise). git-svn-id: trunk@25494 -
This commit is contained in:
parent
93f1ba4493
commit
99dadf2998
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -13573,6 +13573,7 @@ tests/webtbs/tw24871.pp svneol=native#text/pascal
|
|||||||
tests/webtbs/tw2492.pp svneol=native#text/plain
|
tests/webtbs/tw2492.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2494.pp svneol=native#text/plain
|
tests/webtbs/tw2494.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw24953.pp svneol=native#text/pascal
|
tests/webtbs/tw24953.pp svneol=native#text/pascal
|
||||||
|
tests/webtbs/tw25004.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw2503.pp svneol=native#text/plain
|
tests/webtbs/tw2503.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2504.pp svneol=native#text/plain
|
tests/webtbs/tw2504.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2514.pp svneol=native#text/plain
|
tests/webtbs/tw2514.pp svneol=native#text/plain
|
||||||
|
@ -1286,10 +1286,6 @@ implementation
|
|||||||
else
|
else
|
||||||
MessagePos(pd.fileinfo,type_e_type_id_expected);
|
MessagePos(pd.fileinfo,type_e_type_id_expected);
|
||||||
end;
|
end;
|
||||||
if (optoken in [_EQ,_NE,_GT,_LT,_GTE,_LTE,_OP_IN]) and
|
|
||||||
((pd.returndef.typ<>orddef) or
|
|
||||||
(torddef(pd.returndef).ordtype<>pasbool8)) then
|
|
||||||
Message(parser_e_comparative_operator_return_boolean);
|
|
||||||
if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and
|
if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and
|
||||||
equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and
|
equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and
|
||||||
(pd.returndef.typ<>undefineddef) and (tparavarsym(pd.parast.SymList[0]).vardef.typ<>undefineddef) then
|
(pd.returndef.typ<>undefineddef) and (tparavarsym(pd.parast.SymList[0]).vardef.typ<>undefineddef) then
|
||||||
|
151
tests/webtbs/tw25004.pp
Normal file
151
tests/webtbs/tw25004.pp
Normal file
@ -0,0 +1,151 @@
|
|||||||
|
program tw25004;
|
||||||
|
|
||||||
|
{$MODE DELPHI}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
TExpression = class(TObject)
|
||||||
|
end;
|
||||||
|
|
||||||
|
TLiteralInteger = class(TExpression)
|
||||||
|
public
|
||||||
|
Value: integer;
|
||||||
|
|
||||||
|
constructor Create(Value: integer); virtual;
|
||||||
|
function ToString(): string; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TVariableReference = class(TExpression)
|
||||||
|
public
|
||||||
|
Identifier: string;
|
||||||
|
|
||||||
|
constructor Create(const Identifier: string); virtual;
|
||||||
|
function ToString(): string; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TBinaryOperator = (boAdd, boGreaterThan);
|
||||||
|
|
||||||
|
TBinaryOperatorExpression = class(TExpression)
|
||||||
|
protected
|
||||||
|
function OperatorToString(Operator_: TBinaryOperator): string;
|
||||||
|
public
|
||||||
|
Operator_: TBinaryOperator;
|
||||||
|
Left: TExpression;
|
||||||
|
Right: TExpression;
|
||||||
|
|
||||||
|
constructor Create(Operator_: TBinaryOperator; Left: TExpression; Right: TExpression); virtual;
|
||||||
|
destructor Destroy(); override;
|
||||||
|
function ToString(): string; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TExpressionBuilder = record
|
||||||
|
public
|
||||||
|
Expression: TExpression;
|
||||||
|
|
||||||
|
class operator Implicit(Operand: TExpression): TExpressionBuilder;
|
||||||
|
class operator Implicit(Value: integer): TExpressionBuilder;
|
||||||
|
class operator Add(const Left: TExpressionBuilder; const Right: TExpressionBuilder): TExpressionBuilder;
|
||||||
|
class operator GreaterThan(const Left: TExpressionBuilder; const Right: TExpressionBuilder): TExpressionBuilder;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TLiteralInteger }
|
||||||
|
|
||||||
|
constructor TLiteralInteger.Create(Value: integer);
|
||||||
|
begin
|
||||||
|
inherited Create();
|
||||||
|
|
||||||
|
Self.Value := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TLiteralInteger.ToString(): string;
|
||||||
|
begin
|
||||||
|
Result := IntToStr(Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TVariableReference }
|
||||||
|
|
||||||
|
constructor TVariableReference.Create(const Identifier: string);
|
||||||
|
begin
|
||||||
|
inherited Create();
|
||||||
|
|
||||||
|
Self.Identifier := Identifier;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TVariableReference.ToString(): string;
|
||||||
|
begin
|
||||||
|
Result := Identifier;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TBinaryOperatorExpression }
|
||||||
|
|
||||||
|
constructor TBinaryOperatorExpression.Create(Operator_: TBinaryOperator; Left, Right: TExpression);
|
||||||
|
begin
|
||||||
|
inherited Create();
|
||||||
|
|
||||||
|
Self.Operator_ := Operator_;
|
||||||
|
Self.Left := Left;
|
||||||
|
Self.Right := Right;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TBinaryOperatorExpression.Destroy();
|
||||||
|
begin
|
||||||
|
Left.Free();
|
||||||
|
Right.Free();
|
||||||
|
|
||||||
|
inherited Destroy();
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBinaryOperatorExpression.OperatorToString(Operator_: TBinaryOperator): string;
|
||||||
|
begin
|
||||||
|
case Operator_ of
|
||||||
|
boAdd:
|
||||||
|
Result := '+';
|
||||||
|
boGreaterThan:
|
||||||
|
Result := '>';
|
||||||
|
else
|
||||||
|
raise Exception.Create('Unknown operator');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBinaryOperatorExpression.ToString(): string;
|
||||||
|
begin
|
||||||
|
Result := Left.ToString() + ' ' + OperatorToString(Operator_) + ' ' + Right.ToString();
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TExpressionBuilder }
|
||||||
|
|
||||||
|
class operator TExpressionBuilder.Add(const Left: TExpressionBuilder; const Right: TExpressionBuilder): TExpressionBuilder;
|
||||||
|
begin
|
||||||
|
Result := TBinaryOperatorExpression.Create(boAdd, Left.Expression, Right.Expression);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class operator TExpressionBuilder.Implicit(Operand: TExpression): TExpressionBuilder;
|
||||||
|
begin
|
||||||
|
Result.Expression := Operand;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class operator TExpressionBuilder.GreaterThan(const Left: TExpressionBuilder; const Right: TExpressionBuilder): TExpressionBuilder;
|
||||||
|
begin
|
||||||
|
Result := TBinaryOperatorExpression.Create(boGreaterThan, Left.Expression,
|
||||||
|
Right.Expression);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class operator TExpressionBuilder.Implicit(Value: integer): TExpressionBuilder;
|
||||||
|
begin
|
||||||
|
Result := TLiteralInteger.Create(Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Variable1: TExpressionBuilder;
|
||||||
|
Variable2: TExpressionBuilder;
|
||||||
|
Formula: TExpressionBuilder;
|
||||||
|
begin
|
||||||
|
Variable1 := TVariableReference.Create('a');
|
||||||
|
Variable2 := TVariableReference.Create('b');
|
||||||
|
Formula := Variable1 + 1 > 5 + Variable2;
|
||||||
|
if Formula.Expression.ToString() <> 'a + 1 > 5 + b' then
|
||||||
|
halt(1);
|
||||||
|
Formula.Expression.Free();
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user