* fixed local check, fixes #7242

git-svn-id: trunk@5760 -
This commit is contained in:
florian 2006-12-30 23:47:21 +00:00
parent 7d9314d5e8
commit 475664acf5
3 changed files with 70 additions and 2 deletions

1
.gitattributes vendored
View File

@ -7968,6 +7968,7 @@ tests/webtbs/tw7173.pp svneol=native#text/plain
tests/webtbs/tw7195.pp svneol=native#text/plain
tests/webtbs/tw7200.pp svneol=native#text/plain
tests/webtbs/tw7227.pp svneol=native#text/plain
tests/webtbs/tw7242.pp svneol=native#text/plain
tests/webtbs/tw7276.pp svneol=native#text/plain
tests/webtbs/tw7281.pp svneol=native#text/plain
tests/webtbs/tw7285.pp svneol=native#text/plain

View File

@ -2459,7 +2459,7 @@ const
paracompopt:=[cpo_ignorehidden,cpo_comparedefaultvalue]
else
paracompopt:=[cpo_comparedefaultvalue];
{ Check calling convention }
if (fwpd.proccalloption<>currpd.proccalloption) then
begin
@ -2586,7 +2586,7 @@ const
fwpd.procoptions:=fwpd.procoptions+currpd.procoptions;
{ marked as local but exported from unit? }
if (fwpd.procoptions*[po_global,po_kylixlocal])=[po_global,po_kylixlocal] then
if (po_kylixlocal in fwpd.procoptions) and (fwpd.owner.symtabletype=globalsymtable) then
MessagePos(fwpd.fileinfo,type_e_cant_export_local);
if fwpd.extnumber=$ffff then

67
tests/webtbs/tw7242.pp Normal file
View File

@ -0,0 +1,67 @@
unit TestLibMain;
interface
function _tl_get_str( input: PChar ): PChar; CDecl;
implementation
uses
Classes, SysUtils;
//=============================================================================
// forward declarations of internal routines
//-----------------------------------------------------------------------------
function __GetStr( const input: string; var error: integer ): string; local; forward;
//=============================================================================
function _tl_get_str( input: PChar ): PChar; CDecl;
//-----------------------------------------------------------------------------
// Called by : -
// Purpose : -
// Arguments : -
// Returns : -
// ToDo : -
// Remarks : -
//-----------------------------------------------------------------------------
var
retval: string;
error : integer;
begin
result := nil;
error := 0;
retval := __GetStr( input, error );
if (error = 0) and (retval <> '') then try
GetMem( result, Length( retval ) + 1 );
StrPCopy( result, retval );
except
error := 1;
end;
end;
//-----------------------------------------------------------------------------
//=============================================================================
// INTERNAL ROUTINES ( without usage of PChar to avoid memory leaks! )
//=============================================================================
//=============================================================================
function __GetStr( const input: string; var error: integer ): string; local;
//-----------------------------------------------------------------------------
// Called by : -
// Purpose : -
// Arguments : -
// Returns : -
// ToDo : -
// Remarks : -
//----------------------------------------------------------------------------
begin
error := 0;
result := input;
end;
//-----------------------------------------------------------------------------
end.
//= END OF FILE ===============================================================