Selaa lähdekoodia

--- Merging r39711 into '.':
U compiler/symtable.pas
--- Recording mergeinfo for merge of r39711 into '.':
U .
--- Merging r39728 into '.':
G compiler/symtable.pas
--- Recording mergeinfo for merge of r39728 into '.':
G .
--- Merging r39692 into '.':
U compiler/psub.pas
A tests/test/tgeneric104.pp
A tests/test/ugeneric104.pp
--- Recording mergeinfo for merge of r39692 into '.':
G .
--- Merging r39699 into '.':
U packages/libffi/src/ffi.manager.pp
--- Recording mergeinfo for merge of r39699 into '.':
G .

# revisions: 39711,39728,39692,39699

git-svn-id: branches/fixes_3_2@39810 -

marco 6 vuotta sitten
vanhempi
commit
ee7090b118

+ 2 - 0
.gitattributes

@@ -13074,6 +13074,7 @@ tests/test/tgeneric100.pp svneol=native#text/pascal
 tests/test/tgeneric101.pp svneol=native#text/pascal
 tests/test/tgeneric102.pp svneol=native#text/pascal
 tests/test/tgeneric103.pp svneol=native#text/pascal
+tests/test/tgeneric104.pp -text svneol=native#text/pascal
 tests/test/tgeneric11.pp svneol=native#text/plain
 tests/test/tgeneric12.pp svneol=native#text/plain
 tests/test/tgeneric13.pp svneol=native#text/plain
@@ -13889,6 +13890,7 @@ tests/test/ugenconstraints.pas svneol=native#text/pascal
 tests/test/ugeneric.test75.pp svneol=native#text/pascal
 tests/test/ugeneric10.pp svneol=native#text/plain
 tests/test/ugeneric102.pp svneol=native#text/pascal
+tests/test/ugeneric104.pp -text svneol=native#text/pascal
 tests/test/ugeneric14.pp svneol=native#text/plain
 tests/test/ugeneric3.pp svneol=native#text/plain
 tests/test/ugeneric4.pp svneol=native#text/plain

+ 5 - 0
compiler/psub.pas

@@ -2242,6 +2242,10 @@ implementation
              if df_specialization in old_current_procinfo.procdef.defoptions then
                begin
                  include(pd.defoptions,df_specialization);
+                 { the procdefs encountered here are nested procdefs of which
+                   their complete definition also resides inside the current token
+                   stream, thus access to their genericdef is not required }
+                 {$ifdef genericdef_for_nested}
                  { find the corresponding routine in the generic routine }
                  if not assigned(old_current_procinfo.procdef.genericdef) then
                    internalerror(2016121701);
@@ -2265,6 +2269,7 @@ implementation
                    end;
                  if not assigned(pd.genericdef) then
                    internalerror(2016121703);
+                 {$endif}
                end;
            end;
 

+ 27 - 3
compiler/symtable.pas

@@ -1175,21 +1175,44 @@ implementation
 
 
     destructor tabstractrecordsymtable.destroy;
+
+      { for some reason a compiler built with 3.3.1 fails building the libxml2
+        package if the below define is not defined and thus the code snippet is
+        part of the destructor itself and not a nested procedure; until that bug
+        is fixed this is used as a workaround :/ }
+{$define codegen_workaround}
+{$ifdef codegen_workaround}
+      procedure free_mop_list(mop:tmanagementoperator);
+        var
+          i : longint;
+        begin
+          if assigned(mop_list[mop]) then
+            for i:=0 to mop_list[mop].count-1 do
+              dispose(pmanagementoperator_offset_entry(mop_list[mop][i]));
+          mop_list[mop].free;
+        end;
+{$endif codegen_workaround}
+
       var
         mop : tmanagementoperator;
-        mopofs : pmanagementoperator_offset_entry;
+{$ifndef codegen_workaround}
         i : longint;
+{$endif codegen_workaround}
       begin
 {$ifdef llvm}
         if refcount=1 then
           fllvmst.free;
 {$endif llvm}
-        for mop in tmanagementoperator do
+        for mop:=low(tmanagementoperator) to high(tmanagementoperator) do
           begin
+{$ifdef codegen_workaround}
+            free_mop_list(mop);
+{$else codegen_workaround}
             if assigned(mop_list[mop]) then
               for i:=0 to mop_list[mop].count-1 do
                 dispose(pmanagementoperator_offset_entry(mop_list[mop][i]));
             mop_list[mop].free;
+{$endif codegen_workaround}
           end;
         inherited destroy;
       end;
@@ -1648,7 +1671,7 @@ implementation
       var
         sym : tsym absolute data;
         fsym : tfieldvarsym absolute data;
-        mop : tmanagementoperator absolute arg;
+        mop : tmanagementoperator;
         entry : pmanagementoperator_offset_entry;
         sublist : tfplist;
         i : longint;
@@ -1657,6 +1680,7 @@ implementation
           exit;
         if not is_record(fsym.vardef) and not is_object(fsym.vardef) and not is_cppclass(fsym.vardef) then
           exit;
+        mop:=tmanagementoperator(ptruint(arg));
         if not assigned(mop_list[mop]) then
           internalerror(2018082303);
 

+ 3 - 1
packages/libffi/src/ffi.manager.pp

@@ -76,8 +76,10 @@ begin
   SetLength(elements, td^.TotalFieldCount);
   for i := 0 to td^.TotalFieldCount - 1 do begin
     { ToDo: what about fields that are larger that what we have currently? }
-    if field^.FldOffset < curoffset then
+    if field^.FldOffset < curoffset then begin
+      Inc(field);
       Continue;
+    end;
     remoffset := field^.FldOffset - curoffset;
     { insert padding elements }
     while remoffset >= SizeOf(QWord) do begin

+ 16 - 0
tests/test/tgeneric104.pp

@@ -0,0 +1,16 @@
+{ %RECOMPILE }
+{ %NORUN }
+
+{ ensure that nested routines inside generics are handled correctly }
+
+program tgeneric104;
+
+uses
+  ugeneric104;
+
+type
+  TTest = specialize TGeneric<LongInt>;
+
+begin
+  specialize TestProc<LongInt>;
+end.

+ 41 - 0
tests/test/ugeneric104.pp

@@ -0,0 +1,41 @@
+unit ugeneric104;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  generic TGeneric<T> = class
+    procedure Test;
+  end;
+
+generic procedure TestProc<T>;
+
+implementation
+
+{ TGeneric }
+
+procedure TGeneric.Test;
+
+  procedure SubTest;
+  begin
+
+  end;
+
+begin
+  SubTest;
+end;
+
+generic procedure TestProc<T>;
+
+  procedure SubTest;
+  begin
+
+  end;
+
+begin
+  SubTest;
+end;
+
+end.
+