mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 22:49:17 +02:00
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:
parent
727e25e93e
commit
b1f85792d7
@ -1121,17 +1121,26 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
|
|||||||
|
|
||||||
|
|
||||||
procedure tasmlisttypedconstbuilder.tc_emit_enumdef(def: tenumdef; var node: tnode);
|
procedure tasmlisttypedconstbuilder.tc_emit_enumdef(def: tenumdef; var node: tnode);
|
||||||
|
var
|
||||||
|
equal: boolean;
|
||||||
begin
|
begin
|
||||||
if node.nodetype=ordconstn then
|
if node.nodetype=ordconstn then
|
||||||
begin
|
begin
|
||||||
if equal_defs(node.resultdef,def) or
|
equal:=equal_defs(node.resultdef,def);
|
||||||
|
if equal or
|
||||||
is_subequal(node.resultdef,def) then
|
is_subequal(node.resultdef,def) then
|
||||||
begin
|
begin
|
||||||
|
{ 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);
|
adaptrange(def,tordconstnode(node).value,false,false,cs_check_range in current_settings.localswitches);
|
||||||
case longint(node.resultdef.size) of
|
case node.resultdef.size of
|
||||||
1 : ftcb.emit_tai(Tai_const.Create_8bit(Byte(tordconstnode(node).value.svalue)),def);
|
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);
|
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);
|
4 : ftcb.emit_tai(Tai_const.Create_32bit(Longint(tordconstnode(node).value.svalue)),def);
|
||||||
|
else
|
||||||
|
internalerror(2022040301);
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
30
tests/tbs/tb0693a.pp
Normal file
30
tests/tbs/tb0693a.pp
Normal 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
32
tests/tbs/tb0693b.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user