Răsfoiți Sursa

* fixed local check, fixes #7242

git-svn-id: trunk@5760 -
florian 18 ani în urmă
părinte
comite
475664acf5
3 a modificat fișierele cu 70 adăugiri și 2 ștergeri
  1. 1 0
      .gitattributes
  2. 2 2
      compiler/pdecsub.pas
  3. 67 0
      tests/webtbs/tw7242.pp

+ 1 - 0
.gitattributes

@@ -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

+ 2 - 2
compiler/pdecsub.pas

@@ -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 - 0
tests/webtbs/tw7242.pp

@@ -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 ===============================================================
+