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

* fixed message methods

Browse Source 
* fixed typo with win32 dll import from implementation
  * released external check
This commit is contained in:
peter 2004-11-21 16:33:19 +00:00
parent b6a6e78db1
commit 29d3a94892
2 changed files with 47 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
compiler/pdecsub.pas
View File

@ -306,7 +306,6 @@ implementation
end; end;
end; end;
procedure check_c_para(p:tnamedindexitem;arg:pointer); procedure check_c_para(p:tnamedindexitem;arg:pointer);
begin begin
if (tsym(p).typ<>paravarsym) then if (tsym(p).typ<>paravarsym) then
@ -333,6 +332,23 @@ implementation
end; 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); procedure check_inline_para(p:tnamedindexitem;arg:pointer);
var var
pd : tabstractprocdef absolute arg; pd : tabstractprocdef absolute arg;
@ -1149,15 +1165,16 @@ end;
procedure pd_message(pd:tabstractprocdef); procedure pd_message(pd:tabstractprocdef);
var var
pt : tnode; pt : tnode;
paracnt : longint;
begin begin
if pd.deftype<>procdef then if pd.deftype<>procdef then
internalerror(2003042613); internalerror(2003042613);
if not is_class(tprocdef(pd)._class) then if not is_class(tprocdef(pd)._class) then
Message(parser_e_msg_only_for_classes); Message(parser_e_msg_only_for_classes);
{ check parameter type } { check parameter type }
if ((pd.minparacount<>1) or paracnt:=0;
(pd.maxparacount<>1) or pd.parast.foreach_static(@check_msg_para,@paracnt);
(tparavarsym(pd.paras[0]).varspez<>vs_var)) then if paracnt<>1 then
Message(parser_e_ill_msg_param); Message(parser_e_ill_msg_param);
pt:=comp_expr(true); pt:=comp_expr(true);
if pt.nodetype=stringconstn then if pt.nodetype=stringconstn then
@ -1812,7 +1829,8 @@ const
with Delphi and TP7 } with Delphi and TP7 }
if not( if not(
assigned(pd.import_dll) and 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 ) then
pd.setmangledname(pd.import_name^); pd.setmangledname(pd.import_name^);
end end
@ -2177,16 +2195,15 @@ const
{ Body declaration is external? } { Body declaration is external? }
if (po_external in pd.procoptions) then if (po_external in pd.procoptions) then
begin begin
{$ifdef EXTDEBUG}
{ Win32 supports declaration in interface and external in { Win32 supports declaration in interface and external in
implementation for dll imports. Support this for backwards implementation for dll imports. Support this for backwards
compatibility with Tp7 and Delphi } compatibility with Tp7 and Delphi }
if not( 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) assigned(pd.import_dll)
) then ) then
MessagePos(pd.fileinfo,parser_e_proc_no_external_allowed); MessagePos(pd.fileinfo,parser_e_proc_no_external_allowed);
{$endif EXTDEBUG}
end; end;
{ Check parameters } { Check parameters }
@ -2242,7 +2259,7 @@ const
if assigned(pd.import_dll) then if assigned(pd.import_dll) then
begin begin
stringdispose(hd.import_dll); stringdispose(hd.import_dll);
hd.import_name:=stringdup(pd.import_dll^); hd.import_dll:=stringdup(pd.import_dll^);
end; end;
if assigned(pd.import_name) then if assigned(pd.import_name) then
begin begin
@ -2329,7 +2346,12 @@ const
end. end.
{ {
$Log$ $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) * Split po_public into po_public and po_global (Peter)
Revision 1.209 2004/11/17 22:41:41 peter Revision 1.209 2004/11/17 22:41:41 peter

15
compiler/symdef.pas
View File

@ -4368,19 +4368,11 @@ implementation
procedure tprocdef.setmangledname(const s : string); procedure tprocdef.setmangledname(const s : string);
begin begin
{$ifdef EXTDEBUG}
{ This is not allowed anymore, the forward declaration { This is not allowed anymore, the forward declaration
already needs to create the correct mangledname, no changes already needs to create the correct mangledname, no changes
afterwards are allowed (PFV) } afterwards are allowed (PFV) }
if assigned(_mangledname) then if assigned(_mangledname) then
internalerror(200411171); internalerror(200411171);
{$else}
if assigned(_mangledname) then
begin
objectlibrary.renameasmsymbol(_mangledname^,s);
stringdispose(_mangledname);
end;
{$endif EXTDEBUG}
{$ifdef compress} {$ifdef compress}
_mangledname:=stringdup(minilzw_encode(s)); _mangledname:=stringdup(minilzw_encode(s));
{$else} {$else}
@ -6142,7 +6134,12 @@ implementation
end. end.
{ {
$Log$ $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 * make some checks EXTDEBUG only for now so linux cycles again
Revision 1.273 2004/11/17 22:21:35 peter Revision 1.273 2004/11/17 22:21:35 peter