paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-30 07:40:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* workaround for default property constant value limitations

Browse Source 
git-svn-id: trunk@10575 -
This commit is contained in:
Jonas Maebe 2008-03-28 10:15:33 +00:00
parent 03de1511ab
commit 7e4750ac50
3 changed files with 24 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6830,6 +6830,7 @@ tests/tbs/tb0543.pp svneol=native#text/plain
tests/tbs/tb0544.pp svneol=native#text/plain
tests/tbs/tb0545.pp svneol=native#text/plain
tests/tbs/tb0546.pp svneol=native#text/plain
tests/tbs/tb0547.pp svneol=native#text/plain
tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/ub0060.pp svneol=native#text/plain
tests/tbs/ub0069.pp svneol=native#text/plain

4
compiler/pdecvar.pas
View File

@ -605,8 +605,8 @@ implementation
setconstn :
p.default:=plongint(tsetconstnode(pt).value_set)^;
ordconstn :
if (Tordconstnode(pt).value<int64(low(p.default))) or
(Tordconstnode(pt).value>int64(high(p.default))) then
if (Tordconstnode(pt).value<int64(low(longint))) or
(Tordconstnode(pt).value>int64(high(cardinal))) then
message(parser_e_range_check_error)
else
p.default:=longint(tordconstnode(pt).value.svalue);

21
tests/tbs/tb0547.pp Normal file
View File

@ -0,0 +1,21 @@
{ %norun }
program rangeerror;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
{$ifdef mswindows}{$apptype console}{$endif}
uses
{$ifdef FPC}{$ifdef linux}cthreads,{$endif}{$endif}
sysutils;
type
colorty = type longword;
const
cl_mapped = colorty($90000000);
type
ttestclass = class
private
fcolor: colorty;
published
property color: colorty read fcolor write fcolor default cl_mapped; //<<--
end;
begin
end.