paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-20 13:09:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

* disallow widechar sets (Delphi 7 compatible, and were handled wrongly

Browse Source 
by FPC previously)
  * tbs/tb0474 now fails -> renamed to tbf/tb0201 (+ new test tbf/tb0202)

git-svn-id: trunk@8284 -
This commit is contained in:
Jonas Maebe 2007-08-14 14:27:59 +00:00
parent eec25e454d
commit eddc507a13
5 changed files with 33 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -5820,6 +5820,8 @@ tests/tbf/tb0198.pp svneol=native#text/plain
tests/tbf/tb0199.pp -text tests/tbf/tb0199.pp -text
tests/tbf/tb0199a.pp -text tests/tbf/tb0199a.pp -text
tests/tbf/tb0200.pp svneol=native#text/x-pascal tests/tbf/tb0200.pp svneol=native#text/x-pascal
tests/tbf/tb0201.pp svneol=native#text/plain
tests/tbf/tb0202.pp svneol=native#text/plain
tests/tbf/ub0115.pp svneol=native#text/plain tests/tbf/ub0115.pp svneol=native#text/plain
tests/tbf/ub0149.pp svneol=native#text/plain tests/tbf/ub0149.pp svneol=native#text/plain
tests/tbf/ub0158a.pp svneol=native#text/plain tests/tbf/ub0158a.pp svneol=native#text/plain
@ -6286,7 +6288,6 @@ tests/tbs/tb0470.pp svneol=native#text/plain
tests/tbs/tb0471.pp svneol=native#text/plain tests/tbs/tb0471.pp svneol=native#text/plain
tests/tbs/tb0472.pp svneol=native#text/plain tests/tbs/tb0472.pp svneol=native#text/plain
tests/tbs/tb0473.pp svneol=native#text/plain tests/tbs/tb0473.pp svneol=native#text/plain
tests/tbs/tb0474.pp svneol=native#text/plain
tests/tbs/tb0475.pp svneol=native#text/plain tests/tbs/tb0475.pp svneol=native#text/plain
tests/tbs/tb0476.pp svneol=native#text/plain tests/tbs/tb0476.pp svneol=native#text/plain
tests/tbs/tb0477.pp svneol=native#text/plain tests/tbs/tb0477.pp svneol=native#text/plain

21
compiler/ncnv.pas
View File

@ -386,13 +386,31 @@ implementation
end; end;
if codegenerror then if codegenerror then
break; break;
current_filepos:=p2.fileinfo;
case p2.resultdef.typ of case p2.resultdef.typ of
enumdef, enumdef,
orddef: orddef:
begin begin
{ widechars are not yet supported }
if is_widechar(p2.resultdef) then
begin
inserttypeconv(p2,cchartype);
if (p2.nodetype<>ordconstn) then
incompatibletypes(cwidechartype,cchartype);
end;
getrange(p2.resultdef,lr,hr); getrange(p2.resultdef,lr,hr);
if assigned(p3) then if assigned(p3) then
begin begin
if is_widechar(p3.resultdef) then
begin
inserttypeconv(p3,cchartype);
if (p3.nodetype<>ordconstn) then
begin
current_filepos:=p3.fileinfo;
incompatibletypes(cwidechartype,cchartype);
end;
end;
{ this isn't good, you'll get problems with { this isn't good, you'll get problems with
type t010 = 0..10; type t010 = 0..10;
ts = set of t010; ts = set of t010;
@ -405,8 +423,7 @@ implementation
} }
if assigned(hdef) and not(equal_defs(hdef,p3.resultdef)) then if assigned(hdef) and not(equal_defs(hdef,p3.resultdef)) then
begin begin
current_filepos:=p3.fileinfo; CGMessagePos(p3.fileinfo,type_e_typeconflict_in_set);
CGMessage(type_e_typeconflict_in_set);
end end
else else
begin begin

1
compiler/ptype.pas
View File

@ -450,6 +450,7 @@ implementation
orddef : orddef :
begin begin
if (torddef(tt2).ordtype<>uvoid) and if (torddef(tt2).ordtype<>uvoid) and
(torddef(tt2).ordtype<>uwidechar) and
(torddef(tt2).low>=0) then (torddef(tt2).low>=0) then
// !! def:=tsetdef.create(tt2,torddef(tt2.def).low,torddef(tt2.def).high)) // !! def:=tsetdef.create(tt2,torddef(tt2.def).low,torddef(tt2.def).high))
if Torddef(tt2).high>int64(high(longint)) then if Torddef(tt2).high>int64(high(longint)) then

4
tests/tbs/tb0474.pp → tests/tbf/tb0201.pp
View File

@ -1,4 +1,6 @@
{ $mode objfpc} { %fail }
{$mode delphi}
const const
WideNull = widechar(#0); WideNull = widechar(#0);
WideSpace = widechar(#32); WideSpace = widechar(#32);

8
tests/tbf/tb0202.pp Normal file
View File

@ -0,0 +1,8 @@
{ %fail }
{$mode delphi}
var
s: set of widechar;
begin
end.