paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 01:39:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: implement IN operator which was known by compiler but was not supported. + test

Browse Source 
git-svn-id: trunk@16622 -
This commit is contained in:
paul 2010-12-24 02:25:22 +00:00
parent 9c4675def5
commit d97cf8ed9d
5 changed files with 46 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9602,6 +9602,7 @@ tests/test/toperator5.pp svneol=native#text/plain
tests/test/toperator6.pp svneol=native#text/plain
tests/test/toperator7.pp svneol=native#text/plain
tests/test/toperator8.pp svneol=native#text/pascal
tests/test/toperator9.pp svneol=native#text/pascal
tests/test/tover1.pp svneol=native#text/plain
tests/test/tover2.pp svneol=native#text/plain
tests/test/tover3.pp svneol=native#text/plain

4
compiler/htypechk.pas
View File

@ -109,7 +109,7 @@ interface
(tok:_SYMDIF ;nod:symdifn;op_overloading_supported:true), { binary overloading supported }
(tok:_STARSTAR ;nod:starstarn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_AS ;nod:asn;op_overloading_supported:false), { binary overloading NOT supported }
(tok:_OP_IN ;nod:inn;op_overloading_supported:false), { binary overloading NOT supported }
(tok:_OP_IN ;nod:inn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_IS ;nod:isn;op_overloading_supported:false), { binary overloading NOT supported }
(tok:_OP_OR ;nod:orn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_AND ;nod:andn;op_overloading_supported:true), { binary overloading supported }
@ -685,6 +685,8 @@ implementation
optoken:=_OP_SHL;
shrn :
optoken:=_OP_SHR;
inn :
optoken:=_OP_IN;
else
begin
CGMessage(parser_e_operator_not_overloaded);

19
compiler/nset.pas
View File

@ -229,12 +229,6 @@ implementation
exit;
end;
if right.resultdef.typ<>setdef then
CGMessage(sym_e_set_expected);
if codegenerror then
exit;
if (right.nodetype=typen) then
begin
{ we need to create a setconstn }
@ -254,6 +248,19 @@ implementation
if not assigned(left.resultdef) then
internalerror(20021126);
t:=self;
if isbinaryoverloaded(t) then
begin
result:=t;
exit;
end;
if right.resultdef.typ<>setdef then
CGMessage(sym_e_set_expected);
if codegenerror then
exit;
if (m_tp7 in current_settings.modeswitches) then
begin
{ insert a hint that a range check error might occur on non-byte

2
compiler/pdecsub.pas
View File

@ -1315,7 +1315,7 @@ implementation
else
begin
single_type(pd.returndef,false,false);
if (optoken in [_EQ,_NE,_GT,_LT,_GTE,_LTE]) and
if (optoken in [_EQ,_NE,_GT,_LT,_GTE,_LTE,_OP_IN]) and
((pd.returndef.typ<>orddef) or
(torddef(pd.returndef).ordtype<>pasbool)) then
Message(parser_e_comparative_operator_return_boolean);

28
tests/test/toperator9.pp Normal file
View File

@ -0,0 +1,28 @@
program toperator9;
// Check IN operator support
{$mode objfpc}{$H+}
{$apptype console}
type
TFoo = record
F: Integer;
end;
operator in(const I: Integer; const Foo: TFoo): Boolean;
begin
Result := Foo.F = I;
end;
var
Foo: TFoo;
begin
Foo.F := 1;
if not (1 in Foo) then
halt(1);
if 2 in Foo then
halt(2);
WriteLn('ok');
end.