Browse Source

--- Merging r43186 into '.':
U compiler/ngtcon.pas
A tests/webtbs/tw36156.pp
--- Recording mergeinfo for merge of r43186 into '.':
U .
--- Merging r43594 into '.':
U compiler/ncnv.pas
A tests/test/units/cocoaall/tw36362.pp
--- Recording mergeinfo for merge of r43594 into '.':
G .
--- Merging r44788 into '.':
U packages/fpmkunit/src/fpmkunit.pp
--- Recording mergeinfo for merge of r44788 into '.':
G .
--- Merging r45380 into '.':
G packages/fpmkunit/src/fpmkunit.pp
--- Recording mergeinfo for merge of r45380 into '.':
G .
--- Merging r45673 into '.':
U compiler/pinline.pas
A tests/webtbs/tw37228.pp
--- Recording mergeinfo for merge of r45673 into '.':
G .

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

Jonas Maebe 5 years ago
parent
commit
bd4f2057e5

+ 3 - 0
.gitattributes

@@ -15242,6 +15242,7 @@ tests/test/units/classes/tstringlistexchange.pp svneol=native#text/pascal
 tests/test/units/classes/ttbits.pp svneol=native#text/pascal
 tests/test/units/classes/ttbits.pp svneol=native#text/pascal
 tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain
 tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain
 tests/test/units/cocoaall/tw35994.pp svneol=native#text/plain
 tests/test/units/cocoaall/tw35994.pp svneol=native#text/plain
+tests/test/units/cocoaall/tw36362.pp svneol=native#text/plain
 tests/test/units/cpu/tcpu1.pp svneol=native#text/pascal
 tests/test/units/cpu/tcpu1.pp svneol=native#text/pascal
 tests/test/units/crt/tcrt.pp svneol=native#text/plain
 tests/test/units/crt/tcrt.pp svneol=native#text/plain
 tests/test/units/crt/tctrlc.pp svneol=native#text/plain
 tests/test/units/crt/tctrlc.pp svneol=native#text/plain
@@ -17604,6 +17605,7 @@ tests/webtbs/tw3594.pp svneol=native#text/plain
 tests/webtbs/tw3595.pp svneol=native#text/plain
 tests/webtbs/tw3595.pp svneol=native#text/plain
 tests/webtbs/tw35955.pp svneol=native#text/pascal
 tests/webtbs/tw35955.pp svneol=native#text/pascal
 tests/webtbs/tw3612.pp svneol=native#text/plain
 tests/webtbs/tw3612.pp svneol=native#text/plain
+tests/webtbs/tw36156.pp svneol=native#text/plain
 tests/webtbs/tw3617.pp svneol=native#text/plain
 tests/webtbs/tw3617.pp svneol=native#text/plain
 tests/webtbs/tw36179.pp svneol=native#text/pascal
 tests/webtbs/tw36179.pp svneol=native#text/pascal
 tests/webtbs/tw3619.pp svneol=native#text/plain
 tests/webtbs/tw3619.pp svneol=native#text/plain
@@ -17636,6 +17638,7 @@ tests/webtbs/tw37095.pp svneol=native#text/plain
 tests/webtbs/tw37095d/uw37095.pp svneol=native#text/plain
 tests/webtbs/tw37095d/uw37095.pp svneol=native#text/plain
 tests/webtbs/tw3719.pp svneol=native#text/plain
 tests/webtbs/tw3719.pp svneol=native#text/plain
 tests/webtbs/tw3721.pp svneol=native#text/plain
 tests/webtbs/tw3721.pp svneol=native#text/plain
+tests/webtbs/tw37228.pp svneol=native#text/plain
 tests/webtbs/tw3742.pp svneol=native#text/plain
 tests/webtbs/tw3742.pp svneol=native#text/plain
 tests/webtbs/tw3751.pp svneol=native#text/plain
 tests/webtbs/tw3751.pp svneol=native#text/plain
 tests/webtbs/tw3758.pp svneol=native#text/plain
 tests/webtbs/tw3758.pp svneol=native#text/plain

+ 5 - 3
compiler/ncnv.pas

@@ -840,10 +840,12 @@ implementation
               if iscvarargs then
               if iscvarargs then
                 p:=ctypeconvnode.create(p,voidpointertype);
                 p:=ctypeconvnode.create(p,voidpointertype);
             objectdef :
             objectdef :
-              if (iscvarargs and
-                  not is_objc_class_or_protocol(p.resultdef)) or
+              if is_objc_class_or_protocol(p.resultdef) then
+                p:=ctypeconvnode.create(p,voidpointertype)
+              else if iscvarargs or
                  is_object(p.resultdef) then
                  is_object(p.resultdef) then
-                CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename);
+                CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename)
+              else
             else
             else
               CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename);
               CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename);
           end;
           end;

+ 18 - 5
compiler/ngtcon.pas

@@ -340,20 +340,33 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         if (target_info.endian=endian_big) then
         if (target_info.endian=endian_big) then
           begin
           begin
             { bitpacked format: left-aligned (i.e., "big endian bitness") }
             { bitpacked format: left-aligned (i.e., "big endian bitness") }
-            bp.curval:=bp.curval or ((value shl (AIntBits-bp.packedbitsize)) shr bp.curbitoffset);
+            { work around broken x86 shifting }
+            if (AIntBits<>bp.packedbitsize) and
+               (bp.curbitoffset<AIntBits) then
+              bp.curval:=bp.curval or ((value shl (AIntBits-bp.packedbitsize)) shr bp.curbitoffset);
             shiftcount:=((AIntBits-bp.packedbitsize)-bp.curbitoffset);
             shiftcount:=((AIntBits-bp.packedbitsize)-bp.curbitoffset);
             { carry-over to the next element? }
             { carry-over to the next element? }
             if (shiftcount<0) then
             if (shiftcount<0) then
-              bp.nextval:=(value and ((aword(1) shl (-shiftcount))-1)) shl
-                          (AIntBits+shiftcount)
+              begin
+                if shiftcount>=AIntBits then
+                  bp.nextval:=(value and ((aword(1) shl (-shiftcount))-1)) shl
+                              (AIntBits+shiftcount)
+                else
+                  bp.nextval:=0
+              end
           end
           end
         else
         else
           begin
           begin
             { bitpacked format: right aligned (i.e., "little endian bitness") }
             { bitpacked format: right aligned (i.e., "little endian bitness") }
-            bp.curval:=bp.curval or (value shl bp.curbitoffset);
+            { work around broken x86 shifting }
+            if bp.curbitoffset<AIntBits then
+              bp.curval:=bp.curval or (value shl bp.curbitoffset);
             { carry-over to the next element? }
             { carry-over to the next element? }
             if (bp.curbitoffset+bp.packedbitsize>AIntBits) then
             if (bp.curbitoffset+bp.packedbitsize>AIntBits) then
-              bp.nextval:=value shr (AIntBits-bp.curbitoffset)
+              if bp.curbitoffset>0 then
+                bp.nextval:=value shr (AIntBits-bp.curbitoffset)
+              else
+                bp.nextval:=0;
           end;
           end;
         inc(bp.curbitoffset,bp.packedbitsize);
         inc(bp.curbitoffset,bp.packedbitsize);
       end;
       end;

+ 17 - 3
compiler/pinline.pas

@@ -53,7 +53,7 @@ implementation
        symbase,symconst,symdef,symsym,symtable,defutil,
        symbase,symconst,symdef,symsym,symtable,defutil,
        { pass 1 }
        { pass 1 }
        pass_1,htypechk,
        pass_1,htypechk,
-       ncal,nmem,ncnv,ninl,ncon,nld,nbas,ngenutil,
+       ncal,nmem,ncnv,ninl,ncon,nld,nbas,ngenutil,nutils,
        { parser }
        { parser }
        scanner,
        scanner,
        pbase,pexpr;
        pbase,pexpr;
@@ -393,13 +393,27 @@ implementation
                    end
                    end
                   else
                   else
                    begin
                    begin
+                     temp:=nil;
                      { create call to fpc_finalize }
                      { create call to fpc_finalize }
                      if is_managed_type(tpointerdef(p.resultdef).pointeddef) then
                      if is_managed_type(tpointerdef(p.resultdef).pointeddef) then
-                       addstatement(newstatement,cnodeutils.finalize_data_node(cderefnode.create(p.getcopy)));
+                       if might_have_sideeffects(p) then
+                         begin
+                           { ensure that p gets evaluated only once, in case it is e.g. a call }
+                           temp:=ctempcreatenode.create_value(p.resultdef,p.resultdef.size,tt_persistent,true,p);
+                           addstatement(newstatement,temp);
+                           addstatement(newstatement,cnodeutils.finalize_data_node(cderefnode.create(ctemprefnode.create(temp))));
+                         end
+                       else
+                         addstatement(newstatement,cnodeutils.finalize_data_node(cderefnode.create(p.getcopy)));
 
 
                      { create call to fpc_freemem }
                      { create call to fpc_freemem }
-                     para := ccallparanode.create(p,nil);
+                     if not assigned(temp) then
+                       para := ccallparanode.create(p,nil)
+                     else
+                       para := ccallparanode.create(ctemprefnode.create(temp),nil);
                      addstatement(newstatement,ccallnode.createintern('fpc_freemem',para));
                      addstatement(newstatement,ccallnode.createintern('fpc_freemem',para));
+                     if assigned(temp) then
+                       addstatement(newstatement,ctempdeletenode.create(temp));
                    end;
                    end;
                end;
                end;
           end;
           end;

+ 32 - 20
packages/fpmkunit/src/fpmkunit.pp

@@ -3174,8 +3174,8 @@ begin
     RTLeventWaitFor(FNotifyStartTask,500);
     RTLeventWaitFor(FNotifyStartTask,500);
     if not FDone then
     if not FDone then
       begin
       begin
-      { synchronise with WriteBarrier in mainthread for same reason as above }
-      ReadBarrier;
+      { synchronise with ReadWriteBarrier in mainthread for same reason as above }
+      ReadWriteBarrier;
       FBuildEngine.log(vlInfo,'Compiling: '+APackage.Name);
       FBuildEngine.log(vlInfo,'Compiling: '+APackage.Name);
       FCompilationOK:=false;
       FCompilationOK:=false;
       try
       try
@@ -6777,27 +6777,37 @@ begin
   // libc-linker path
   // libc-linker path
   if APackage.NeedLibC then
   if APackage.NeedLibC then
     begin
     begin
-    if FCachedlibcPath='' then
-      begin
-      s:=GetDefaultLibGCCDir(Defaults.CPU, Defaults.OS,ErrS);
-      if s='' then
-        Log(vlWarning, SWarngcclibpath +' '+ErrS)
-      else
+      if FCachedlibcPath='' then
         begin
         begin
+          s:=GetDefaultLibGCCDir(Defaults.CPU, Defaults.OS,ErrS);
+          if s='' then
+            Log(vlWarning, SWarngcclibpath +' '+ErrS)
+          else
+            begin
 {$ifndef NO_THREADING}
 {$ifndef NO_THREADING}
-        EnterCriticalsection(FGeneralCriticalSection);
-        try
+              EnterCriticalsection(FGeneralCriticalSection);
+              { prevent FCachedlibcPath getting freed by thread 2 while thread 1 is
+                concatenating it to -Fl below }
+              try
+                if FCachedlibcPath='' then
+                  begin
 {$endif NO_THREADING}
 {$endif NO_THREADING}
-          FCachedlibcPath:=s;
+                    FCachedlibcPath:=s;
 {$ifndef NO_THREADING}
 {$ifndef NO_THREADING}
-        finally
-          LeaveCriticalsection(FGeneralCriticalSection);
-        end;
+                  end;
+              finally
+                LeaveCriticalsection(FGeneralCriticalSection);
+              end;
 {$endif NO_THREADING}
 {$endif NO_THREADING}
-        end;
-      end;
+            end;
+        end
+      else
+        { make sure we don't access the contents of the string before they've been
+          synchronised from the thread that wrote them; the critical section there
+          acts as a read/write barrier }
+        ReadBarrier;
 
 
-    Args.Add('-Fl'+FCachedlibcPath);
+      Args.Add('-Fl'+FCachedlibcPath);
     end;
     end;
 
 
   // Custom options which are added by dependencies
   // Custom options which are added by dependencies
@@ -7075,7 +7085,7 @@ begin
         end
         end
       else
       else
         begin
         begin
-          S:=GetCompilerCommand(APackage,ATarget,Env);
+          S:=GetCompilerCommand(APackage,ATarget,nil);
           ExecuteCommand(GetCompiler,S,nil);
           ExecuteCommand(GetCompiler,S,nil);
         end;
         end;
       If Assigned(ATarget.AfterCompile) then
       If Assigned(ATarget.AfterCompile) then
@@ -8175,8 +8185,10 @@ Var
   begin
   begin
     if AThread.Done then
     if AThread.Done then
       begin
       begin
-        { synchronise with the WriteBarrier in the thread }
-        ReadBarrier;
+        { synchronise with the WriteBarrier in the thread (-> ReadBarrier), and prevent
+          any writes we do here afterwards to be reordered before that (so the compile
+          thread won't see these writes either -> also WriteBarrier) }
+        ReadWriteBarrier;
         if assigned(AThread.APackage) then
         if assigned(AThread.APackage) then
           begin
           begin
             // The thread has completed compiling the package
             // The thread has completed compiling the package

+ 31 - 0
tests/test/units/cocoaall/tw36362.pp

@@ -0,0 +1,31 @@
+{$mode objfpc}
+{$modeswitch objectivec2}
+
+program test;
+uses
+  CocoaAll;
+
+type
+  tc = objcclass(NSObject)
+    a: char;
+  end;
+
+operator := (const right: array of const): NSMutableArray;
+begin
+  if tc(right[0].vPointer).a<>'a' then
+    halt(1);
+  result:=NSMutableArray.alloc.initWithCapacity(1);
+  result.addObject(tc(right[0].vPointer));
+end;
+
+var
+  c: tc;
+  a: NSMutableArray;
+begin
+  c:=tc.alloc.init;
+  c.a:='a';
+  a := [c];
+  for c in a do
+    if c.a<>'a' then
+      halt(2);
+end.

+ 17 - 0
tests/webtbs/tw36156.pp

@@ -0,0 +1,17 @@
+program Project1;
+type
+  TBitSize = -7..7;
+  TFpDbgValueSize = bitpacked record
+    Size: Int64;
+    BitSize: TBitSize;
+  end;
+
+const
+  gcFpDbgValueSize: TFpDbgValueSize = (Size: $7FFFFFFF; BitSize: 2);
+
+begin
+  writeln(hexstr(gcFpDbgValueSize.Size,16));
+  writeln(gcFpDbgValueSize.BitSize);
+  if gcFpDbgValueSize.Size<>$7fffffff then
+    halt(1);
+end.

+ 18 - 0
tests/webtbs/tw37228.pp

@@ -0,0 +1,18 @@
+{$mode objfpc} {$h+}
+var
+  i: longint;
+
+function CreateString: pString;
+begin
+    if i<>0 then
+      halt(1);
+    inc(i);
+    writeln('Creating a string');
+    new(result);
+end;
+
+begin
+    dispose(CreateString); // prints “Creating a string” twice
+    if i<>1 then
+      halt(2);
+end.