mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 13:29:24 +02:00
Merged revisions 3578 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk r3578 (florian) + parse packed set, fixes #6735 git-svn-id: branches/fixes_2_0@3579 -
This commit is contained in:
parent
304fc72b67
commit
779403b126
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -6486,6 +6486,7 @@ tests/webtbs/tw4950.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw4999.pp svneol=native#text/plain
|
tests/webtbs/tw4999.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw5036.pp svneol=native#text/plain
|
tests/webtbs/tw5036.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw5082.pp -text svneol=unset#text/plain
|
tests/webtbs/tw5082.pp -text svneol=unset#text/plain
|
||||||
|
tests/webtbs/tw6735.pp svneol=native#text/plain
|
||||||
tests/webtbs/ub1873.pp svneol=native#text/plain
|
tests/webtbs/ub1873.pp svneol=native#text/plain
|
||||||
tests/webtbs/ub1883.pp svneol=native#text/plain
|
tests/webtbs/ub1883.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw0555.pp svneol=native#text/plain
|
tests/webtbs/uw0555.pp svneol=native#text/plain
|
||||||
|
@ -331,7 +331,41 @@ implementation
|
|||||||
pt1.free;
|
pt1.free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure array_dec;
|
|
||||||
|
procedure set_dec;
|
||||||
|
begin
|
||||||
|
consume(_SET);
|
||||||
|
consume(_OF);
|
||||||
|
read_anon_type(tt2,true);
|
||||||
|
if assigned(tt2.def) then
|
||||||
|
begin
|
||||||
|
case tt2.def.deftype of
|
||||||
|
{ don't forget that min can be negativ PM }
|
||||||
|
enumdef :
|
||||||
|
if tenumdef(tt2.def).min>=0 then
|
||||||
|
// !! tt.setdef(tsetdef.create(tt2,tenumdef(tt2.def).min,tenumdef(tt2.def).max))
|
||||||
|
tt.setdef(tsetdef.create(tt2,tenumdef(tt2.def).max))
|
||||||
|
else
|
||||||
|
Message(sym_e_ill_type_decl_set);
|
||||||
|
orddef :
|
||||||
|
begin
|
||||||
|
if (torddef(tt2.def).typ<>uvoid) and
|
||||||
|
(torddef(tt2.def).low>=0) then
|
||||||
|
// !! tt.setdef(tsetdef.create(tt2,torddef(tt2.def).low,torddef(tt2.def).high))
|
||||||
|
tt.setdef(tsetdef.create(tt2,torddef(tt2.def).high))
|
||||||
|
else
|
||||||
|
Message(sym_e_ill_type_decl_set);
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
Message(sym_e_ill_type_decl_set);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
tt:=generrortype;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure array_dec;
|
||||||
var
|
var
|
||||||
lowval,
|
lowval,
|
||||||
highval : aint;
|
highval : aint;
|
||||||
@ -542,34 +576,7 @@ implementation
|
|||||||
end;
|
end;
|
||||||
_SET:
|
_SET:
|
||||||
begin
|
begin
|
||||||
consume(_SET);
|
set_dec;
|
||||||
consume(_OF);
|
|
||||||
read_type(tt2,'',true);
|
|
||||||
if assigned(tt2.def) then
|
|
||||||
begin
|
|
||||||
case tt2.def.deftype of
|
|
||||||
{ don't forget that min can be negativ PM }
|
|
||||||
enumdef :
|
|
||||||
if tenumdef(tt2.def).min>=0 then
|
|
||||||
// !! tt.setdef(tsetdef.create(tt2,tenumdef(tt2.def).min,tenumdef(tt2.def).max))
|
|
||||||
tt.setdef(tsetdef.create(tt2,tenumdef(tt2.def).max))
|
|
||||||
else
|
|
||||||
Message(sym_e_ill_type_decl_set);
|
|
||||||
orddef :
|
|
||||||
begin
|
|
||||||
if (torddef(tt2.def).typ<>uvoid) and
|
|
||||||
(torddef(tt2.def).low>=0) then
|
|
||||||
// !! tt.setdef(tsetdef.create(tt2,torddef(tt2.def).low,torddef(tt2.def).high))
|
|
||||||
tt.setdef(tsetdef.create(tt2,torddef(tt2.def).high))
|
|
||||||
else
|
|
||||||
Message(sym_e_ill_type_decl_set);
|
|
||||||
end;
|
|
||||||
else
|
|
||||||
Message(sym_e_ill_type_decl_set);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
tt:=generrortype;
|
|
||||||
end;
|
end;
|
||||||
_CARET:
|
_CARET:
|
||||||
begin
|
begin
|
||||||
@ -586,6 +593,8 @@ implementation
|
|||||||
consume(_PACKED);
|
consume(_PACKED);
|
||||||
if token=_ARRAY then
|
if token=_ARRAY then
|
||||||
array_dec
|
array_dec
|
||||||
|
else if token=_SET then
|
||||||
|
set_dec
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
oldaktpackrecords:=aktpackrecords;
|
oldaktpackrecords:=aktpackrecords;
|
||||||
|
5
tests/webtbs/tw6735.pp
Normal file
5
tests/webtbs/tw6735.pp
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
type
|
||||||
|
t=packed set of 0..7;
|
||||||
|
|
||||||
|
begin
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user