* crash preventions

This commit is contained in:
peter 1998-10-05 13:57:13 +00:00
parent 4f30ea05b8
commit 166faa64f6
3 changed files with 73 additions and 42 deletions

View File

@ -1581,7 +1581,6 @@ unit pdecl;
pt1,pt2 : ptree; pt1,pt2 : ptree;
begin begin
p:=nil;
{ use of current parsed object ? } { use of current parsed object ? }
if (token=ID) and (testcurobject=2) and (curobjectname=pattern) then if (token=ID) and (testcurobject=2) and (curobjectname=pattern) then
begin begin
@ -1742,6 +1741,7 @@ unit pdecl;
end; end;
begin begin
p:=nil;
case token of case token of
_STRING,_FILE: _STRING,_FILE:
p:=single_type(hs); p:=single_type(hs);
@ -1787,14 +1787,16 @@ unit pdecl;
consume(_SET); consume(_SET);
consume(_OF); consume(_OF);
hp1:=read_type(''); hp1:=read_type('');
case hp1^.deftype of if assigned(hp1) then
{ don't forget that min can be negativ PM } begin
enumdef : if penumdef(hp1)^.min>=0 then case hp1^.deftype of
{ don't forget that min can be negativ PM }
enumdef : if penumdef(hp1)^.min>=0 then
p:=new(psetdef,init(hp1,penumdef(hp1)^.max)) p:=new(psetdef,init(hp1,penumdef(hp1)^.max))
else else
Message(sym_e_ill_type_decl_set); Message(sym_e_ill_type_decl_set);
orddef : begin orddef : begin
case porddef(hp1)^.typ of case porddef(hp1)^.typ of
uchar : p:=new(psetdef,init(hp1,255)); uchar : p:=new(psetdef,init(hp1,255));
u8bit,s8bit,u16bit,s16bit,s32bit : u8bit,s8bit,u16bit,s16bit,s32bit :
begin begin
@ -1806,7 +1808,10 @@ unit pdecl;
end; end;
end; end;
else Message(sym_e_ill_type_decl_set); else Message(sym_e_ill_type_decl_set);
end; end;
end
else
p:=generrordef;
end; end;
CARET: CARET:
begin begin
@ -1879,6 +1884,8 @@ unit pdecl;
else else
expr_type; expr_type;
end; end;
if p=nil then
p:=generrordef;
read_type:=p; read_type:=p;
end; end;
@ -2048,7 +2055,10 @@ unit pdecl;
end. end.
{ {
$Log$ $Log$
Revision 1.62 1998-10-02 17:06:02 peter Revision 1.63 1998-10-05 13:57:13 peter
* crash preventions
Revision 1.62 1998/10/02 17:06:02 peter
* better error message for unresolved forward types * better error message for unresolved forward types
Revision 1.61 1998/10/02 09:23:24 peter Revision 1.61 1998/10/02 09:23:24 peter

View File

@ -1031,16 +1031,10 @@ unit pexpr;
while true do while true do
begin begin
p1:=comp_expr(true); p1:=comp_expr(true);
do_firstpass(p1);
if codegenerror then
break;
if token=POINTPOINT then if token=POINTPOINT then
begin begin
consume(POINTPOINT); consume(POINTPOINT);
p2:=comp_expr(true); p2:=comp_expr(true);
do_firstpass(p2);
if codegenerror then
break;
p1:=gennode(arrayconstructrangen,p1,p2); p1:=gennode(arrayconstructrangen,p1,p2);
end; end;
{ insert at the end of the tree, to get the correct order } { insert at the end of the tree, to get the correct order }
@ -1093,7 +1087,27 @@ unit pexpr;
begin begin
{ prevent crashes with unknown types } { prevent crashes with unknown types }
if not assigned(pd) then if not assigned(pd) then
exit; begin
{ try to recover }
repeat
case token of
CARET : consume(CARET);
POINT : begin
consume(POINT);
consume(ID);
end;
LECKKLAMMER : begin
repeat
consume(token);
until token in [RECKKLAMMER,SEMICOLON];
end;
else
break;
end;
until false;
exit;
end;
{ handle token }
case token of case token of
CARET : begin CARET : begin
consume(CARET); consume(CARET);
@ -1329,8 +1343,12 @@ unit pexpr;
consume(LKLAMMER); consume(LKLAMMER);
p1:=factor(false); p1:=factor(false);
if p1^.treetype<>typen then if p1^.treetype<>typen then
Message(type_e_type_id_expected); begin
pd:=p1^.resulttype; Message(type_e_type_id_expected);
pd:=generrordef;
end
else
pd:=p1^.resulttype;
pd2:=pd; pd2:=pd;
if (pd^.deftype<>pointerdef) or if (pd^.deftype<>pointerdef) or
(ppointerdef(pd)^.definition^.deftype<>objectdef) then (ppointerdef(pd)^.definition^.deftype<>objectdef) then
@ -1825,7 +1843,10 @@ unit pexpr;
end. end.
{ {
$Log$ $Log$
Revision 1.60 1998-10-05 12:32:46 peter Revision 1.61 1998-10-05 13:57:15 peter
* crash preventions
Revision 1.60 1998/10/05 12:32:46 peter
+ assert() support + assert() support
Revision 1.59 1998/10/01 14:56:24 peter Revision 1.59 1998/10/01 14:56:24 peter

View File

@ -50,30 +50,30 @@ compiler version and your short cut.
- andn optimization - andn optimization
- muladdn optimization - muladdn optimization
- comparisations - comparisations
- open strings
- $P
- range checking for open arrays
- array of const as subroutine parameter
- open array with call by value ............................ 0.99.6 (FK)
- subrange types of enumerations ........................... 0.99.7 (PFV)
- method pointers (procedure of object)
- code generation for exceptions ........................... 0.99.7 (FK)
- assertation
- sysutils unit for go32v2 (excpetions!)
- initialisation/finalization for units
- fixed data type
- add abstract virtual method runtime
error checking (210) ................................... 0.99.1 (FK)
- add alignment $A switch
- add debug info $D switch ............................... 0.99.1 (FK)
- add strict var strings check $V switch ................. 0.99.1 (FK)
- $B
- fix all bugs of the bug directory
- include/exclude
- make dec/inc internal................................... 0.99.6 (PFV)
- make length internal.................................... 0.99.7 (PFV)
* Delphi 4 support * Delphi 4 support
- overloaded directive - overloaded directive
- default parameters - default parameters
- dynamic arrays - dynamic arrays
- 64 bit int - 64 bit int
* Misc
- array of const as subroutine parameter ................ 0.99.9 (PFV)
- open array with call by value ......................... 0.99.6 (FK)
- subrange types of enumerations ........................ 0.99.7 (PFV)
- code generation for exceptions ........................ 0.99.7 (FK)
- assertation ........................................... 0.99.9 (PFV)
- add abstract virtual method runtime error (210) ....... 0.99.1 (FK)
- add debug info $D switch .............................. 0.99.1 (FK)
- add strict var strings check $V switch ................ 0.99.1 (FK)
- make dec/inc internal.................................. 0.99.6 (PFV)
- make length internal................................... 0.99.7 (PFV)
- fix all bugs of the bug directory
- range checking for open arrays
- method pointers (procedure of object)
- sysutils unit for go32v2 (excpetions!)
- initialisation/finalization for units
- fixed data type
- add alignment $A switch
- $B
- open strings, $P
- include/exclude