Browse Source

* fix FindUnitSymtable for exception symtables, resolves #24801 and #39974
* more consistent naming of exceptsymtable enumeration symbol

florian 2 years ago
parent
commit
0eee70ac81
6 changed files with 41 additions and 6 deletions
  1. 1 1
      compiler/symconst.pas
  2. 1 1
      compiler/symdef.pas
  3. 2 2
      compiler/symtable.pas
  4. 3 2
      compiler/symtype.pas
  5. 12 0
      tests/webtbs/tw24801.pp
  6. 22 0
      tests/webtbs/uw24801.pp

+ 1 - 1
compiler/symconst.pas

@@ -682,7 +682,7 @@ type
     localsymtable,         { subroutine symtable             }
     localsymtable,         { subroutine symtable             }
     parasymtable,          { arguments symtable              }
     parasymtable,          { arguments symtable              }
     withsymtable,          { with operator symtable          }
     withsymtable,          { with operator symtable          }
-    stt_excepTSymtable,    { try/except symtable             }
+    exceptsymtable,        { try/except symtable             }
     exportedmacrosymtable, { }
     exportedmacrosymtable, { }
     localmacrosymtable,    { }
     localmacrosymtable,    { }
     enumsymtable,          { symtable for enum members       }
     enumsymtable,          { symtable for enum members       }

+ 1 - 1
compiler/symdef.pas

@@ -2643,7 +2643,7 @@ implementation
              the module is compiled, so we can get crashes on high level targets
              the module is compiled, so we can get crashes on high level targets
              if they still need it while e.g. writing assembler code }
              if they still need it while e.g. writing assembler code }
            while assigned(insertstack) and
            while assigned(insertstack) and
-                 (insertstack^.symtable.symtabletype in [stt_exceptsymtable,withsymtable]) do
+                 (insertstack^.symtable.symtabletype in [exceptsymtable,withsymtable]) do
              insertstack:=insertstack^.next;
              insertstack:=insertstack^.next;
            if not assigned(insertstack) then
            if not assigned(insertstack) then
              internalerror(200602044);
              internalerror(200602044);

+ 2 - 2
compiler/symtable.pas

@@ -277,7 +277,7 @@ interface
           procedure insertdef(def:TDefEntry);override;
           procedure insertdef(def:TDefEntry);override;
         end;
         end;
 
 
-       tstt_excepTSymtable = class(TSymtable)
+       tstt_exceptsymtable = class(TSymtable)
        public
        public
           constructor create;
           constructor create;
        end;
        end;
@@ -2828,7 +2828,7 @@ implementation
     constructor tstt_excepTSymtable.create;
     constructor tstt_excepTSymtable.create;
       begin
       begin
         inherited create('');
         inherited create('');
-        symtabletype:=stt_excepTSymtable;
+        symtabletype:=exceptsymtable;
       end;
       end;
 
 
 
 

+ 3 - 2
compiler/symtype.pas

@@ -263,6 +263,7 @@ implementation
                 result:=st;
                 result:=st;
                 exit;
                 exit;
               end;
               end;
+            exceptsymtable,
             recordsymtable,
             recordsymtable,
             enumsymtable,
             enumsymtable,
             arraysymtable,
             arraysymtable,
@@ -528,12 +529,12 @@ implementation
           won't be saved to the ppu and as a result we can get unreachable
           won't be saved to the ppu and as a result we can get unreachable
           defs when reloading the derived ones from the ppu }
           defs when reloading the derived ones from the ppu }
         origowner:=owner;
         origowner:=owner;
-        while not(origowner.symtabletype in [localsymtable,staticsymtable,globalsymtable,stt_excepTSymtable]) do
+        while not(origowner.symtabletype in [localsymtable,staticsymtable,globalsymtable,exceptsymtable]) do
           origowner:=origowner.defowner.owner;
           origowner:=origowner.defowner.owner;
         { if the def is in an exceptionsymtable, we can't create a reusable
         { if the def is in an exceptionsymtable, we can't create a reusable
           def because the original one will be freed when the (always
           def because the original one will be freed when the (always
           temprary) exceptionsymtable is freed }
           temprary) exceptionsymtable is freed }
-        if origowner.symtabletype=stt_excepTSymtable then
+        if origowner.symtabletype=exceptsymtable then
           internalerror(2015111701)
           internalerror(2015111701)
         else if origowner.symtabletype=localsymtable then
         else if origowner.symtabletype=localsymtable then
           result:=origowner
           result:=origowner

+ 12 - 0
tests/webtbs/tw24801.pp

@@ -0,0 +1,12 @@
+program ErrorSample;
+{$mode objfpc}{$H+}
+uses
+    {$IFDEF UNIX}
+    cThreads,
+    {$ENDIF}
+  Classes,
+  uw24801;
+begin
+  if f<>'asdfasdf' then
+    halt(1);
+end.         

+ 22 - 0
tests/webtbs/uw24801.pp

@@ -0,0 +1,22 @@
+unit uw24801;
+{$MODE objfpc}{$H+}
+interface
+uses
+  Classes,sysutils;
+  function f: string; inline;   //causing internal error
+implementation
+
+function f: string;
+var msg : string;
+begin
+//***** this is the block causing internal error
+      try
+        raise exception.create('asdfasdf');
+      except
+        on E: exception do begin
+          msg := E.Message;
+          result:=msg;
+        end;
+      end;
+end;
+end.