Browse Source

--- Merging r13521 into '.':
A tests\webtbs\tw14236.pp
--- Merging r13522 into '.':
U rtl\win\sysfile.inc
--- Merging r13523 into '.':
U compiler\symtype.pas
U compiler\symtable.pas
U compiler\symsym.pas
--- Merging r13524 into '.':
U rtl\win64\system.pp
U rtl\win\sysutils.pp
U rtl\win32\system.pp

git-svn-id: branches/fixes_2_4@13525 -

florian 16 years ago
parent
commit
e0efb42226

+ 1 - 0
.gitattributes

@@ -9224,6 +9224,7 @@ tests/webtbs/tw14149.pp svneol=native#text/plain
 tests/webtbs/tw14155.pp svneol=native#text/plain
 tests/webtbs/tw14155.pp svneol=native#text/plain
 tests/webtbs/tw1416.pp svneol=native#text/plain
 tests/webtbs/tw1416.pp svneol=native#text/plain
 tests/webtbs/tw14174.pp svneol=native#text/plain
 tests/webtbs/tw14174.pp svneol=native#text/plain
+tests/webtbs/tw14236.pp svneol=native#text/plain
 tests/webtbs/tw1430.pp svneol=native#text/plain
 tests/webtbs/tw1430.pp svneol=native#text/plain
 tests/webtbs/tw14307.pp svneol=native#text/plain
 tests/webtbs/tw14307.pp svneol=native#text/plain
 tests/webtbs/tw1433.pp svneol=native#text/plain
 tests/webtbs/tw1433.pp svneol=native#text/plain

+ 2 - 2
compiler/symsym.pas

@@ -1743,8 +1743,8 @@ implementation
     constructor ttypesym.create(const n : string;def:tdef);
     constructor ttypesym.create(const n : string;def:tdef);
 
 
       begin
       begin
-         inherited create(typesym,n);
-         typedef:=def;
+        inherited create(typesym,n);
+        typedef:=def;
         { register the typesym for the definition }
         { register the typesym for the definition }
         if assigned(typedef) and
         if assigned(typedef) and
            (typedef.typ<>errordef) and
            (typedef.typ<>errordef) and

+ 51 - 48
compiler/symtable.pas

@@ -563,70 +563,73 @@ implementation
          if (tsym(sym).typ in [staticvarsym,localvarsym,paravarsym,fieldvarsym]) and
          if (tsym(sym).typ in [staticvarsym,localvarsym,paravarsym,fieldvarsym]) and
             ((tsym(sym).owner.symtabletype in
             ((tsym(sym).owner.symtabletype in
              [parasymtable,localsymtable,ObjectSymtable,staticsymtable])) then
              [parasymtable,localsymtable,ObjectSymtable,staticsymtable])) then
-          begin
-           { unused symbol should be reported only if no }
-           { error is reported                     }
-           { if the symbol is in a register it is used   }
-           { also don't count the value parameters which have local copies }
-           { also don't claim for high param of open parameters (PM) }
-           if (Errorcount<>0) or
-              ([vo_is_hidden_para,vo_is_funcret] * tabstractvarsym(sym).varoptions = [vo_is_hidden_para]) then
-             exit;
-           if (tstoredsym(sym).refs=0) then
-             begin
-                if (vo_is_funcret in tabstractvarsym(sym).varoptions) then
-                  begin
-                    { don't warn about the result of constructors }
-                    if ((tsym(sym).owner.symtabletype<>localsymtable) or
-                       (tprocdef(tsym(sym).owner.defowner).proctypeoption<>potype_constructor)) and
-                       not(cs_opt_nodedfa in current_settings.optimizerswitches) then
-                      MessagePos(tsym(sym).fileinfo,sym_w_function_result_not_set)
-                  end
-                else if (tsym(sym).owner.symtabletype=parasymtable) then
-                  MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_not_used,tsym(sym).realname)
-                else if (tsym(sym).owner.symtabletype=ObjectSymtable) then
-                  MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_not_used,tsym(sym).owner.realname^,tsym(sym).realname)
-                else
-                  MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_not_used,tsym(sym).realname);
-             end
-           else if tabstractvarsym(sym).varstate in [vs_written,vs_initialised] then
-             begin
-                if (tsym(sym).owner.symtabletype=parasymtable) then
-                  begin
-                    if not(tabstractvarsym(sym).varspez in [vs_var,vs_out]) and
-                       not(vo_is_funcret in tabstractvarsym(sym).varoptions) then
-                      MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_only_set,tsym(sym).realname)
-                  end
-                else if (tsym(sym).owner.symtabletype=ObjectSymtable) then
-                  MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_only_set,tsym(sym).owner.realname^,tsym(sym).realname)
-                else if tabstractvarsym(sym).varoptions*[vo_is_funcret,vo_is_public,vo_is_external]=[] then
-                  MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_only_set,tsym(sym).realname);
-             end
-           else if (tabstractvarsym(sym).varstate = vs_read_not_warned) and
-                   ([vo_is_public,vo_is_external] * tabstractvarsym(sym).varoptions = []) then
-             MessagePos1(tsym(sym).fileinfo,sym_w_identifier_only_read,tsym(sym).realname)
-         end
-      else if ((tsym(sym).owner.symtabletype in
+           begin
+            { unused symbol should be reported only if no }
+            { error is reported                     }
+            { if the symbol is in a register it is used   }
+            { also don't count the value parameters which have local copies }
+            { also don't claim for high param of open parameters (PM) }
+            if (Errorcount<>0) or
+               ([vo_is_hidden_para,vo_is_funcret] * tabstractvarsym(sym).varoptions = [vo_is_hidden_para]) then
+              exit;
+            if (tstoredsym(sym).refs=0) then
+              begin
+                 if (vo_is_funcret in tabstractvarsym(sym).varoptions) then
+                   begin
+                     { don't warn about the result of constructors }
+                     if ((tsym(sym).owner.symtabletype<>localsymtable) or
+                        (tprocdef(tsym(sym).owner.defowner).proctypeoption<>potype_constructor)) and
+                        not(cs_opt_nodedfa in current_settings.optimizerswitches) then
+                       MessagePos(tsym(sym).fileinfo,sym_w_function_result_not_set)
+                   end
+                 else if (tsym(sym).owner.symtabletype=parasymtable) then
+                   MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_not_used,tsym(sym).prettyname)
+                 else if (tsym(sym).owner.symtabletype=ObjectSymtable) then
+                   MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_not_used,tsym(sym).owner.realname^,tsym(sym).prettyname)
+                 else
+                   MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_not_used,tsym(sym).prettyname);
+              end
+            else if tabstractvarsym(sym).varstate in [vs_written,vs_initialised] then
+              begin
+                 if (tsym(sym).owner.symtabletype=parasymtable) then
+                   begin
+                     if not(tabstractvarsym(sym).varspez in [vs_var,vs_out]) and
+                        not(vo_is_funcret in tabstractvarsym(sym).varoptions) then
+                       MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_only_set,tsym(sym).prettyname)
+                   end
+                 else if (tsym(sym).owner.symtabletype=ObjectSymtable) then
+                   MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_only_set,tsym(sym).owner.realname^,tsym(sym).prettyname)
+                 else if tabstractvarsym(sym).varoptions*[vo_is_funcret,vo_is_public,vo_is_external]=[] then
+                   MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_only_set,tsym(sym).prettyname);
+              end
+            else if (tabstractvarsym(sym).varstate = vs_read_not_warned) and
+                    ([vo_is_public,vo_is_external] * tabstractvarsym(sym).varoptions = []) then
+              MessagePos1(tsym(sym).fileinfo,sym_w_identifier_only_read,tsym(sym).prettyname)
+          end
+        else if ((tsym(sym).owner.symtabletype in
               [ObjectSymtable,parasymtable,localsymtable,staticsymtable])) then
               [ObjectSymtable,parasymtable,localsymtable,staticsymtable])) then
           begin
           begin
            if (Errorcount<>0) or
            if (Errorcount<>0) or
               (sp_internal in tsym(sym).symoptions) then
               (sp_internal in tsym(sym).symoptions) then
              exit;
              exit;
            { do not claim for inherited private fields !! }
            { do not claim for inherited private fields !! }
-           if (Tsym(sym).refs=0) and (tsym(sym).owner.symtabletype=ObjectSymtable) then
-             MessagePos2(tsym(sym).fileinfo,sym_n_private_method_not_used,tsym(sym).owner.realname^,tsym(sym).realname)
+           if (tsym(sym).refs=0) and (tsym(sym).owner.symtabletype=ObjectSymtable) then
+             MessagePos2(tsym(sym).fileinfo,sym_n_private_method_not_used,tsym(sym).owner.realname^,tsym(sym).prettyname)
            { units references are problematic }
            { units references are problematic }
            else
            else
             begin
             begin
-              if (Tsym(sym).refs=0) and
+              if (tsym(sym).refs=0) and
                  not(tsym(sym).typ in [enumsym,unitsym]) and
                  not(tsym(sym).typ in [enumsym,unitsym]) and
                  not(is_funcret_sym(tsym(sym))) and
                  not(is_funcret_sym(tsym(sym))) and
+                 { don't complain about compiler generated syms for specializations, see also #13405 }
+                 not((tsym(sym).typ=typesym) and (df_specialization in ttypesym(sym).typedef.defoptions) and
+                    (pos('$',ttypesym(sym).Realname)<>0)) and
                  (
                  (
                   (tsym(sym).typ<>procsym) or
                   (tsym(sym).typ<>procsym) or
                   ((tsym(sym).owner.symtabletype=staticsymtable) and
                   ((tsym(sym).owner.symtabletype=staticsymtable) and
                    not current_module.is_unit)
                    not current_module.is_unit)
                  ) then
                  ) then
-                MessagePos2(tsym(sym).fileinfo,sym_h_local_symbol_not_used,SymTypeName[tsym(sym).typ],tsym(sym).realname);
+                MessagePos2(tsym(sym).fileinfo,sym_h_local_symbol_not_used,SymTypeName[tsym(sym).typ],tsym(sym).prettyname);
             end;
             end;
           end;
           end;
       end;
       end;

+ 7 - 0
compiler/symtype.pas

@@ -105,6 +105,7 @@ interface
          constructor create(st:tsymtyp;const aname:string);
          constructor create(st:tsymtyp;const aname:string);
          destructor  destroy;override;
          destructor  destroy;override;
          function  mangledname:string; virtual;
          function  mangledname:string; virtual;
+         function  prettyname:string; virtual;
          procedure buildderef;virtual;
          procedure buildderef;virtual;
          procedure deref;virtual;
          procedure deref;virtual;
          procedure ChangeOwner(st:TSymtable);
          procedure ChangeOwner(st:TSymtable);
@@ -388,6 +389,12 @@ implementation
       end;
       end;
 
 
 
 
+    function tsym.prettyname : string;
+      begin
+        result:=realname;
+      end;
+
+
     procedure tsym.ChangeOwner(st:TSymtable);
     procedure tsym.ChangeOwner(st:TSymtable);
       begin
       begin
         Owner:=st;
         Owner:=st;

+ 1 - 1
rtl/win/sysfile.inc

@@ -235,7 +235,7 @@ begin
       shflags := file_Share_Write
       shflags := file_Share_Write
   else
   else
     if ((filemode and fmshareDenyNone) = fmshareDenyNone) then
     if ((filemode and fmshareDenyNone) = fmshareDenyNone) then
-      shflags := file_Share_Read + file_Share_Write;
+      shflags := fmShareDenyNoneFlags;
   { convert filemode to filerec modes }
   { convert filemode to filerec modes }
   case (flags and 3) of
   case (flags and 3) of
    0 : begin
    0 : begin

+ 0 - 6
rtl/win/sysutils.pp

@@ -48,12 +48,6 @@ Var
   Win32MinorVersion,
   Win32MinorVersion,
   Win32BuildNumber   : dword;
   Win32BuildNumber   : dword;
   Win32CSDVersion    : ShortString;   // CSD record is 128 bytes only?
   Win32CSDVersion    : ShortString;   // CSD record is 128 bytes only?
-Const
-  { it can be discussed whether fmShareDenyNone means read and write or read, write and delete, see 
-    also http://bugs.freepascal.org/view.php?id=8898, this allows users to configure the used
-	value
-  }
-  fmShareDenyNoneFlags : DWord = 3;  
 
 
 { Compatibility with Delphi }
 { Compatibility with Delphi }
 function Win32Check(res:boolean):boolean;inline;
 function Win32Check(res:boolean):boolean;inline;

+ 7 - 0
rtl/win32/system.pp

@@ -114,6 +114,13 @@ const
   Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
 
 
+Const
+  { it can be discussed whether fmShareDenyNone means read and write or read, write and delete, see 
+    also http://bugs.freepascal.org/view.php?id=8898, this allows users to configure the used
+	value
+  }
+  fmShareDenyNoneFlags : DWord = 3;
+  
 implementation
 implementation
 
 
 var
 var

+ 7 - 0
rtl/win64/system.pp

@@ -106,6 +106,13 @@ const
   Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
   Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
+  
+Const
+  { it can be discussed whether fmShareDenyNone means read and write or read, write and delete, see 
+    also http://bugs.freepascal.org/view.php?id=8898, this allows users to configure the used
+	value
+  }
+  fmShareDenyNoneFlags : DWord = 3;  
 
 
 implementation
 implementation
 
 

+ 43 - 0
tests/webtbs/tw14236.pp

@@ -0,0 +1,43 @@
+
+program project1;
+// Run the following to cause an access violation
+//
+// ./project1 'as.*0' 'ascii_lf1'
+//
+
+{$mode objfpc}{$H+}
+
+uses
+  regex,
+  SysUtils;
+
+var
+  re : TRegexEngine;
+  aErrorPos : integer;
+  aErrorCode: TRegexError;
+  MatchPos : integer;
+  Offset : integer;
+  s1,s2 : string;
+begin
+  s1:='as.*0';
+  s2:='ascii_lf1';
+  try
+    WriteLn('Regex: Trim(s1) = >>'+Trim(s1)+'<<');
+    WriteLn('Test: Trim(s2) = >>'+Trim(s2)+'<<');
+    re := TRegexEngine.Create(Trim(s1));
+    if re.Parse(aErrorPos,aErrorCode) then begin
+      Offset := 1;
+      if re.MatchString(s2,MatchPos,Offset) then begin
+        WriteLn('Match');
+      end else begin
+        WriteLn('No Match');
+      end;
+    end else begin
+      WriteLn('Parse Failed');
+    end;
+  except
+    on E : Exception do begin
+      WriteLn('Exception: '+E.Message);
+    end;
+  end;
+end.