paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 21:29:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed various crashes

Browse Source
This commit is contained in:
peter 2003-05-13 15:18:49 +00:00
parent 5e40220d67
commit a467b84faa
3 changed files with 235 additions and 195 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/ncal.pas
View File

@ -2163,7 +2163,8 @@ type
else
begin
{ When this is method the methodpointer must be available }
if procdefinition.owner.symtabletype=objectsymtable then
if (right=nil) and
(procdefinition.owner.symtabletype=objectsymtable) then
internalerror(200305061);
end;
@ -2729,7 +2730,10 @@ begin
end.
{
$Log$
Revision 1.151 2003-05-11 21:37:03 peter
Revision 1.152 2003-05-13 15:18:49 peter
* fixed various crashes
Revision 1.151 2003/05/11 21:37:03 peter
* moved implicit exception frame from ncgutil to psub
* constructor/destructor helpers moved from cobj/ncgutil to psub

57
compiler/pdecsub.pas
View File

@ -796,7 +796,19 @@ implementation
begin
consume(_FUNCTION);
pd:=parse_proc_head(aclass,potype_none);
if token<>_COLON then
if assigned(pd) then
begin
if try_to_consume(_COLON) then
begin
inc(testcurobject);
single_type(pd.rettype,hs,false);
pd.test_if_fpu_result;
if (pd.rettype.def.deftype=stringdef) and
(tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
include(current_procinfo.flags,pi_needs_implicit_finally);
dec(testcurobject);
end
else
begin
if (
not(is_interface(pd._class)) and
@ -807,37 +819,37 @@ implementation
consume(_COLON);
consume_all_until(_SEMICOLON);
end;
end
else
begin
consume(_COLON);
inc(testcurobject);
single_type(pd.rettype,hs,false);
pd.test_if_fpu_result;
if (pd.rettype.def.deftype=stringdef) and
(tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
include(current_procinfo.flags,pi_needs_implicit_finally);
dec(testcurobject);
end;
if isclassmethod then
include(pd.procoptions,po_classmethod);
end
else
begin
{ recover }
consume(_COLON);
consume_all_until(_SEMICOLON);
end;
end;
_PROCEDURE :
begin
consume(_PROCEDURE);
pd:=parse_proc_head(aclass,potype_none);
if assigned(pd) then
begin
pd.rettype:=voidtype;
if isclassmethod then
include(pd.procoptions,po_classmethod);
end;
end;
_CONSTRUCTOR :
begin
consume(_CONSTRUCTOR);
pd:=parse_proc_head(aclass,potype_constructor);
if not assigned(pd._class) then
internalerror(200304263);
if assigned(pd) and
assigned(pd._class) then
begin
{ Set return type, class constructors return the
created instance, object constructors return boolean }
if is_class(pd._class) then
@ -845,11 +857,13 @@ implementation
else
pd.rettype:=booltype;
end;
end;
_DESTRUCTOR :
begin
consume(_DESTRUCTOR);
pd:=parse_proc_head(aclass,potype_destructor);
if assigned(pd) then
pd.rettype:=voidtype;
end;
@ -869,6 +883,8 @@ implementation
end;
consume(token);
pd:=parse_proc_head(aclass,potype_operator);
if assigned(pd) then
begin
if pd.parast.symtablelevel>normal_function_level then
Message(parser_e_no_local_operator);
if token<>_ID then
@ -902,6 +918,14 @@ implementation
else if not isoperatoracceptable(pd,optoken) then
Message(parser_e_overload_impossible);
end;
end
else
begin
{ recover }
try_to_consume(_ID);
consume(_COLON);
consume_all_until(_SEMICOLON);
end;
end;
end;
{ support procedure proc;stdcall export; in Delphi mode only }
@ -2200,7 +2224,10 @@ const
end.
{
$Log$
Revision 1.122 2003-05-09 17:47:03 peter
Revision 1.123 2003-05-13 15:18:49 peter
* fixed various crashes
Revision 1.122 2003/05/09 17:47:03 peter
* self moved to hidden parameter
* removed hdisposen,hnewn,selfn

11
compiler/psub.pas
View File

@ -234,6 +234,8 @@ implementation
begin
generate_entry_block:=internalstatements(newstatement,true);
if assigned(current_procdef._class) then
begin
{ a constructor needs a help procedure }
if (current_procdef.proctypeoption=potype_constructor) then
begin
@ -318,6 +320,7 @@ implementation
internalerror(200305104);
end;
end;
end;
function generate_exit_block:tblocknode;
@ -328,6 +331,8 @@ implementation
begin
generate_exit_block:=internalstatements(newstatement,true);
if assigned(current_procdef._class) then
begin
{ maybe call AfterConstruction for classes }
if (current_procdef.proctypeoption=potype_constructor) and
is_class(current_procdef._class) then
@ -398,6 +403,7 @@ implementation
internalerror(200305105);
end;
end;
end;
function generate_except_block:tblocknode;
@ -1098,7 +1104,10 @@ implementation
end.
{
$Log$
Revision 1.109 2003-05-11 21:37:03 peter
Revision 1.110 2003-05-13 15:18:49 peter
* fixed various crashes
Revision 1.109 2003/05/11 21:37:03 peter
* moved implicit exception frame from ncgutil to psub
* constructor/destructor helpers moved from cobj/ncgutil to psub