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

* problem with read access to properties solved

Browse Source 
* correct handling of hidding methods via virtual (COM)
  * correct result type of constructor calls (COM), the resulttype
    depends now on the type of the class reference
This commit is contained in:
florian 1998-04-12 22:39:43 +00:00
parent f966d959ee
commit c2ca131926
6 changed files with 817 additions and 769 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
compiler/cgi386.pas
View File

@ -3050,11 +3050,11 @@ implementation
if (p^.procdefinition^.options and pomethodpointer)<>0 then if (p^.procdefinition^.options and pomethodpointer)<>0 then
begin begin
{ method pointer can't be in a register } { method pointer can't be in a register }
inc(p^.right^.location.reference^.offset,4); inc(p^.right^.location.reference.offset,4);
{ push self pointer } { push self pointer }
exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,newreference(p^.right^.location.reference)))); exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,newreference(p^.right^.location.reference))));
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
dec(p^.right^.location.reference^.offset,4); dec(p^.right^.location.reference.offset,4);
end; end;
case p^.right^.location.loc of case p^.right^.location.loc of
LOC_REGISTER,LOC_CREGISTER: LOC_REGISTER,LOC_CREGISTER:
@ -5725,7 +5725,13 @@ do_jmp:
end. end.
{ {
$Log$ $Log$
Revision 1.9 1998-04-10 21:36:55 florian Revision 1.10 1998-04-12 22:39:43 florian
* problem with read access to properties solved
* correct handling of hidding methods via virtual (COM)
* correct result type of constructor calls (COM), the resulttype
depends now on the type of the class reference
Revision 1.9 1998/04/10 21:36:55 florian
+ some stuff to support method pointers (procedure of object) added + some stuff to support method pointers (procedure of object) added
(declaration, parameter handling) (declaration, parameter handling)

2
compiler/msgidx.inc
View File

@ -151,7 +151,7 @@ parser_e_only_class_methods_via_class_ref,
parser_e_only_class_methods, parser_e_only_class_methods,
parser_e_case_mismatch, parser_e_case_mismatch,
parser_e_illegal_symbol_exported, parser_e_illegal_symbol_exported,
parser_e_must_use_override, parser_w_should_use_override,
parser_e_nothing_to_be_overridden, parser_e_nothing_to_be_overridden,
parser_e_no_procedure_to_access_property, parser_e_no_procedure_to_access_property,
parser_e_ill_property_access_sym, parser_e_ill_property_access_sym,

1422
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

16
compiler/pass_1.pas
View File

@ -2136,6 +2136,7 @@ unit pass_1;
if not assigned(p^.left^.resulttype) then if not assigned(p^.left^.resulttype) then
begin begin
codegenerror:=true; codegenerror:=true;
internalerror(52349);
exit; exit;
end; end;
@ -2988,11 +2989,11 @@ unit pass_1;
end; end;
{$endif} {$endif}
end; { not assigned(p^.procdefinition) } end; { not assigned(p^.procdefinition) }
{ ensure that the result type is set }
p^.resulttype:=p^.procdefinition^.retdef;
{ get a register for the return value } { get a register for the return value }
if (p^.resulttype<>pdef(voiddef)) then if (p^.resulttype<>pdef(voiddef)) then
begin begin
{ the constructor returns the result with the flags }
if (p^.procdefinition^.options and poconstructor)<>0 then if (p^.procdefinition^.options and poconstructor)<>0 then
begin begin
{ extra handling of classes } { extra handling of classes }
@ -3002,7 +3003,10 @@ unit pass_1;
begin begin
p^.location.loc:=LOC_REGISTER; p^.location.loc:=LOC_REGISTER;
p^.registers32:=1; p^.registers32:=1;
{ the result type depends on the classref }
p^.resulttype:=pclassrefdef(p^.methodpointer^.resulttype)^.definition;
end end
{ a object constructor returns the result with the flags }
else else
p^.location.loc:=LOC_FLAGS; p^.location.loc:=LOC_FLAGS;
end end
@ -4496,7 +4500,13 @@ unit pass_1;
end. end.
{ {
$Log$ $Log$
Revision 1.6 1998-04-09 22:16:34 florian Revision 1.7 1998-04-12 22:39:44 florian
* problem with read access to properties solved
* correct handling of hidding methods via virtual (COM)
* correct result type of constructor calls (COM), the resulttype
depends now on the type of the class reference
Revision 1.6 1998/04/09 22:16:34 florian
* problem with previous REGALLOC solved * problem with previous REGALLOC solved
* improved property support * improved property support

15
compiler/todo.txt
View File

@ -6,17 +6,17 @@ Please indent task which are done 8 spaces and add the
compiler version and your short cut. compiler version and your short cut.
* OPOM (Object Pascal Object Modell) * OPOM (Object Pascal Object Modell)
- virtual constructors - virtual constructors ................................... 0.99.6 (FK)
* properties * properties
- save the def and not the sym which - save the def and not the sym which
does read/write access does read/write access ................................. 0.99.6 (FK)
- indexed properties - indexed properties ..................................... 0.99.6 (FK)
- default properties - default properties ..................................... 0.99.6 (FK)
- stored qualifier - stored qualifier
- read/write from/to unit file - read/write from/to unit file ........................... 0.99.6 (FK)
- call of destructor helper routine - call of destructor helper routine
- message qualifier - message qualifier
- correct handling of constructor result type - correct handling of constructor result type ............ 0.99.6 (FK)
- rtti - rtti
- dynamic methods - dynamic methods
- correct handling of access specifiers - correct handling of access specifiers
@ -39,6 +39,9 @@ compiler version and your short cut.
- $P - $P
- range checking for open arrays - range checking for open arrays
- array of const as subroutine parameter - array of const as subroutine parameter
- open array with call by value
- subrange types of enumerations
- method pointers (procedure of object)
- code generation for exceptions - code generation for exceptions
- initialisation/finalization for units - initialisation/finalization for units
- fixed data type - fixed data type

115
compiler/types.pas
View File

@ -669,18 +669,59 @@ unit types;
_name : string; _name : string;
stored : boolean; stored : boolean;
{ creates a new entry in the procsym list }
procedure newentry;
begin begin
{ nur Unterprogrammsymbole werden in die VMT aufgenommen } { if not, generate a new symbol item }
new(symcoll);
symcoll^.name:=stringdup(sym^.name);
symcoll^.next:=wurzel;
symcoll^.data:=nil;
wurzel:=symcoll;
hp:=pprocsym(sym)^.definition;
{ inserts all definitions }
while assigned(hp) do
begin
new(procdefcoll);
procdefcoll^.data:=hp;
procdefcoll^.next:=symcoll^.data;
symcoll^.data:=procdefcoll;
{ if it's a virtual method }
if (hp^.options and povirtualmethod)<>0 then
begin
{ then it gets a number ... }
hp^.extnumber:=nextvirtnumber;
{ and we inc the number }
inc(nextvirtnumber);
has_virtual_method:=true;
end;
if (hp^.options and poconstructor)<>0 then
has_constructor:=true;
{ check, if a method should be overridden }
if (hp^.options and pooverridingmethod)<>0 then
Message1(parser_e_nothing_to_be_overridden,_c^.name^+'.'+_name);
{ next overloaded method }
hp:=hp^.nextoverloaded;
end;
end;
begin
{ put only sub routines into the VMT }
if sym^.typ=procsym then if sym^.typ=procsym then
begin begin
_name:=sym^.name; _name:=sym^.name;
symcoll:=wurzel; symcoll:=wurzel;
while assigned(symcoll) do while assigned(symcoll) do
begin begin
{ wenn das Symbol in der Liste schon existiert } { does the symbol already exist in the list ? }
if _name=symcoll^.name^ then if _name=symcoll^.name^ then
begin begin
{ walk thorugh all defs of the symbol } { walk through all defs of the symbol }
hp:=pprocsym(sym)^.definition; hp:=pprocsym(sym)^.definition;
while assigned(hp) do while assigned(hp) do
begin begin
@ -701,7 +742,22 @@ unit types;
{ Fehler falls nur eine VIRTUAL } { Fehler falls nur eine VIRTUAL }
if (procdefcoll^.data^.options and povirtualmethod)<> if (procdefcoll^.data^.options and povirtualmethod)<>
(hp^.options and povirtualmethod) then (hp^.options and povirtualmethod) then
begin
{ in classes, we hide the old method }
if _c^.isclass then
begin
{ warn only if it is the first time,
we hide the method }
if _c=hp^._class then
Message1(parser_w_should_use_override,_c^.name^+'.'+_name);
newentry;
exit;
end
else
begin
Message1(parser_e_overloaded_are_not_both_virtual,_c^.name^+'.'+_name); Message1(parser_e_overloaded_are_not_both_virtual,_c^.name^+'.'+_name);
end;
end;
{ check, if the overridden directive is set } { check, if the overridden directive is set }
{ (povirtualmethod is set! } { (povirtualmethod is set! }
@ -710,11 +766,14 @@ unit types;
if _c^.isclass and if _c^.isclass and
((hp^.options and pooverridingmethod)=0) then ((hp^.options and pooverridingmethod)=0) then
begin begin
{ this isn't like handled like delphi !!!!! } { warn only if it is the first time,
Message1(parser_e_must_use_override,_c^.name^+'.'+_name); we hide the method }
if _c=hp^._class then
Message1(parser_w_should_use_override,_c^.name^+'.'+_name);
newentry;
exit;
end; end;
{ error, if the return types aren't equal } { error, if the return types aren't equal }
if not(is_equal(procdefcoll^.data^.retdef,hp^.retdef)) then if not(is_equal(procdefcoll^.data^.retdef,hp^.retdef)) then
Message1(parser_e_overloaded_methodes_not_same_ret,_c^.name^+'.'+_name); Message1(parser_e_overloaded_methodes_not_same_ret,_c^.name^+'.'+_name);
@ -759,41 +818,7 @@ unit types;
end; end;
symcoll:=symcoll^.next; symcoll:=symcoll^.next;
end; end;
{ if not, generate a new symbol item } newentry;
new(symcoll);
symcoll^.name:=stringdup(sym^.name);
symcoll^.next:=wurzel;
symcoll^.data:=nil;
wurzel:=symcoll;
hp:=pprocsym(sym)^.definition;
{ inserts all definitions }
while assigned(hp) do
begin
new(procdefcoll);
procdefcoll^.data:=hp;
procdefcoll^.next:=symcoll^.data;
symcoll^.data:=procdefcoll;
{ if it's a virtual method }
if (hp^.options and povirtualmethod)<>0 then
begin
{ then it gets a number ... }
hp^.extnumber:=nextvirtnumber;
{ and we inc the number }
inc(nextvirtnumber);
has_virtual_method:=true;
end;
if (hp^.options and poconstructor)<>0 then
has_constructor:=true;
{ check, if a method should be overridden }
if (hp^.options and pooverridingmethod)<>0 then
Message1(parser_e_nothing_to_be_overridden,_c^.name^+'.'+_name);
{ next overloaded method }
hp:=hp^.nextoverloaded;
end;
end; end;
end; end;
@ -900,7 +925,13 @@ unit types;
end. end.
{ {
$Log$ $Log$
Revision 1.7 1998-04-10 21:36:56 florian Revision 1.8 1998-04-12 22:39:44 florian
* problem with read access to properties solved
* correct handling of hidding methods via virtual (COM)
* correct result type of constructor calls (COM), the resulttype
depends now on the type of the class reference
Revision 1.7 1998/04/10 21:36:56 florian
+ some stuff to support method pointers (procedure of object) added + some stuff to support method pointers (procedure of object) added
(declaration, parameter handling) (declaration, parameter handling)