mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 19:09:23 +02:00
* fixed message methods
* fixed typo with win32 dll import from implementation * released external check
This commit is contained in:
peter
parent
b6a6e78db1
commit
29d3a94892
@ -306,7 +306,6 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure check_c_para(p:tnamedindexitem;arg:pointer);
|
||||
begin
|
||||
if (tsym(p).typ<>paravarsym) then
|
||||
@ -333,6 +332,23 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure check_msg_para(p:tnamedindexitem;arg:pointer);
|
||||
begin
|
||||
if (tsym(p).typ<>paravarsym) then
|
||||
exit;
|
||||
with tparavarsym(p) do
|
||||
begin
|
||||
{ Count parameters }
|
||||
if (paranr>=10) then
|
||||
inc(plongint(arg)^);
|
||||
{ First parameter must be var }
|
||||
if (paranr=10) and
|
||||
(varspez<>vs_var) then
|
||||
Message(parser_e_ill_msg_param);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure check_inline_para(p:tnamedindexitem;arg:pointer);
|
||||
var
|
||||
pd : tabstractprocdef absolute arg;
|
||||
@ -599,7 +615,7 @@ implementation
|
||||
var
|
||||
orgsp,sp : stringid;
|
||||
sym : tsym;
|
||||
srsym : tsym;
|
||||
srsym : tsym;
|
||||
srsymtable : tsymtable;
|
||||
storepos,
|
||||
procstartfilepos : tfileposinfo;
|
||||
@ -743,10 +759,10 @@ implementation
|
||||
|
||||
{ Check if overloaded is a procsym }
|
||||
if assigned(srsym) then
|
||||
begin
|
||||
if srsym.typ=procsym then
|
||||
aprocsym:=tprocsym(srsym)
|
||||
else
|
||||
begin
|
||||
if srsym.typ=procsym then
|
||||
aprocsym:=tprocsym(srsym)
|
||||
else
|
||||
begin
|
||||
{ when the other symbol is a unit symbol then hide the unit
|
||||
symbol }
|
||||
@ -766,7 +782,7 @@ implementation
|
||||
error when inserting the symbol in the symtable }
|
||||
orgsp:=orgsp+'$'+tostr(aktfilepos.line);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until not searchagain;
|
||||
end;
|
||||
@ -1149,15 +1165,16 @@ end;
|
||||
procedure pd_message(pd:tabstractprocdef);
|
||||
var
|
||||
pt : tnode;
|
||||
paracnt : longint;
|
||||
begin
|
||||
if pd.deftype<>procdef then
|
||||
internalerror(2003042613);
|
||||
if not is_class(tprocdef(pd)._class) then
|
||||
Message(parser_e_msg_only_for_classes);
|
||||
{ check parameter type }
|
||||
if ((pd.minparacount<>1) or
|
||||
(pd.maxparacount<>1) or
|
||||
(tparavarsym(pd.paras[0]).varspez<>vs_var)) then
|
||||
paracnt:=0;
|
||||
pd.parast.foreach_static(@check_msg_para,@paracnt);
|
||||
if paracnt<>1 then
|
||||
Message(parser_e_ill_msg_param);
|
||||
pt:=comp_expr(true);
|
||||
if pt.nodetype=stringconstn then
|
||||
@ -1812,7 +1829,8 @@ const
|
||||
with Delphi and TP7 }
|
||||
if not(
|
||||
assigned(pd.import_dll) and
|
||||
(target_info.system in [system_i386_win32,system_i386_wdosx])
|
||||
(target_info.system in [system_i386_win32,system_i386_wdosx,
|
||||
system_i386_emx,system_i386_os2])
|
||||
) then
|
||||
pd.setmangledname(pd.import_name^);
|
||||
end
|
||||
@ -2177,16 +2195,15 @@ const
|
||||
{ Body declaration is external? }
|
||||
if (po_external in pd.procoptions) then
|
||||
begin
|
||||
{$ifdef EXTDEBUG}
|
||||
{ Win32 supports declaration in interface and external in
|
||||
implementation for dll imports. Support this for backwards
|
||||
compatibility with Tp7 and Delphi }
|
||||
if not(
|
||||
(target_info.system in [system_i386_win32,system_i386_wdosx]) and
|
||||
(target_info.system in [system_i386_win32,system_i386_wdosx,
|
||||
system_i386_emx,system_i386_os2]) and
|
||||
assigned(pd.import_dll)
|
||||
) then
|
||||
MessagePos(pd.fileinfo,parser_e_proc_no_external_allowed);
|
||||
{$endif EXTDEBUG}
|
||||
end;
|
||||
|
||||
{ Check parameters }
|
||||
@ -2242,7 +2259,7 @@ const
|
||||
if assigned(pd.import_dll) then
|
||||
begin
|
||||
stringdispose(hd.import_dll);
|
||||
hd.import_name:=stringdup(pd.import_dll^);
|
||||
hd.import_dll:=stringdup(pd.import_dll^);
|
||||
end;
|
||||
if assigned(pd.import_name) then
|
||||
begin
|
||||
@ -2329,7 +2346,12 @@ const
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.210 2004-11-19 08:17:01 michael
|
||||
Revision 1.211 2004-11-21 16:33:19 peter
|
||||
* fixed message methods
|
||||
* fixed typo with win32 dll import from implementation
|
||||
* released external check
|
||||
|
||||
Revision 1.210 2004/11/19 08:17:01 michael
|
||||
* Split po_public into po_public and po_global (Peter)
|
||||
|
||||
Revision 1.209 2004/11/17 22:41:41 peter
|
||||
|
||||
@ -2888,13 +2888,13 @@ implementation
|
||||
cachedelecount:=elecount;
|
||||
{ prevent overflow, return -1 to indicate overflow }
|
||||
if (cachedelesize <> 0) and
|
||||
(
|
||||
(cachedelecount < 0) or
|
||||
(
|
||||
(cachedelecount < 0) or
|
||||
((high(aint) div cachedelesize) < cachedelecount) or
|
||||
{ also lowrange*elesize must be < high(aint) to prevent overflow when
|
||||
accessing the array, see ncgmem (PFV) }
|
||||
((high(aint) div cachedelesize) < abs(lowrange))
|
||||
) then
|
||||
) then
|
||||
result:=-1
|
||||
else
|
||||
result:=cachedelesize*cachedelecount;
|
||||
@ -4368,19 +4368,11 @@ implementation
|
||||
|
||||
procedure tprocdef.setmangledname(const s : string);
|
||||
begin
|
||||
{$ifdef EXTDEBUG}
|
||||
{ This is not allowed anymore, the forward declaration
|
||||
already needs to create the correct mangledname, no changes
|
||||
afterwards are allowed (PFV) }
|
||||
if assigned(_mangledname) then
|
||||
internalerror(200411171);
|
||||
{$else}
|
||||
if assigned(_mangledname) then
|
||||
begin
|
||||
objectlibrary.renameasmsymbol(_mangledname^,s);
|
||||
stringdispose(_mangledname);
|
||||
end;
|
||||
{$endif EXTDEBUG}
|
||||
{$ifdef compress}
|
||||
_mangledname:=stringdup(minilzw_encode(s));
|
||||
{$else}
|
||||
@ -6142,7 +6134,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.274 2004-11-17 22:41:41 peter
|
||||
Revision 1.275 2004-11-21 16:33:19 peter
|
||||
* fixed message methods
|
||||
* fixed typo with win32 dll import from implementation
|
||||
* released external check
|
||||
|
||||
Revision 1.274 2004/11/17 22:41:41 peter
|
||||
* make some checks EXTDEBUG only for now so linux cycles again
|
||||
|
||||
Revision 1.273 2004/11/17 22:21:35 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user