Symbolic constants: don't range check on in use in typed constants

Same as 3da54dcf9f, but this type when used in type constant definitions
like record fiels
This commit is contained in:
Jonas Maebe 2022-04-03 11:12:27 +02:00
parent 727e25e93e
commit b1f85792d7
3 changed files with 74 additions and 3 deletions

View File

@ -1121,17 +1121,26 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
procedure tasmlisttypedconstbuilder.tc_emit_enumdef(def: tenumdef; var node: tnode);
var
equal: boolean;
begin
if node.nodetype=ordconstn then
begin
if equal_defs(node.resultdef,def) or
equal:=equal_defs(node.resultdef,def);
if equal or
is_subequal(node.resultdef,def) then
begin
adaptrange(def,tordconstnode(node).value,false,false,cs_check_range in current_settings.localswitches);
case longint(node.resultdef.size) of
{ if equal, the necessary range checking has already been
performed; needed for handling hacks like
const x = tenum(255); }
if not equal then
adaptrange(def,tordconstnode(node).value,false,false,cs_check_range in current_settings.localswitches);
case node.resultdef.size of
1 : ftcb.emit_tai(Tai_const.Create_8bit(Byte(tordconstnode(node).value.svalue)),def);
2 : ftcb.emit_tai(Tai_const.Create_16bit(Word(tordconstnode(node).value.svalue)),def);
4 : ftcb.emit_tai(Tai_const.Create_32bit(Longint(tordconstnode(node).value.svalue)),def);
else
internalerror(2022040301);
end;
end
else

30
tests/tbs/tb0693a.pp Normal file
View File

@ -0,0 +1,30 @@
{ %norun }
program T001;
{$MODE DELPHI}
{$R-}
type
TLanguages = (
lOne,
lTwo,
lThree,
lFour
);
const
LANGUAGE_NONE = TLanguages(255);
type
TLanguage = record
Index : TLanguages;
end;
var
Lang: TLanguages;
CurrentLanguage: TLanguage = (
Index: LANGUAGE_NONE
);
begin
Lang := LANGUAGE_NONE;
end.

32
tests/tbs/tb0693b.pp Normal file
View File

@ -0,0 +1,32 @@
{ %fail }
program T001;
{$MODE DELPHI}
{$R-}
type
TLanguages = (
lOne,
lTwo,
lThree,
lFour
);
TLanguagesSub = lOne..lTwo;
const
LANGUAGE_NONE = TLanguages(255);
type
TLanguage = record
Index : TLanguagesSub;
end;
var
Lang: TLanguages;
CurrentLanguage: TLanguage = (
Index: LANGUAGE_NONE
);
begin
Lang := LANGUAGE_NONE;
end.