* synchronized with trunk

git-svn-id: branches/wasm@46336 -

.gitattributes

@@ -18442,6 +18442,7 @@ tests/webtbs/tw37397.pp svneol=native#text/plain
 tests/webtbs/tw37398.pp svneol=native#text/pascal
 tests/webtbs/tw37400.pp svneol=native#text/pascal
 tests/webtbs/tw3742.pp svneol=native#text/plain
+tests/webtbs/tw37423.pp svneol=native#text/plain
 tests/webtbs/tw37427.pp svneol=native#text/pascal
 tests/webtbs/tw37449.pp svneol=native#text/pascal
 tests/webtbs/tw37468.pp svneol=native#text/pascal

compiler/m68k/cgcpu.pas

@@ -2252,14 +2252,11 @@ unit cgcpu;
     function tcg68k.force_to_dataregister(list: TAsmList; size: TCGSize; reg: TRegister): TRegister;
       var
         scratch_reg: TRegister;
-        instr: Taicpu;
       begin
         if isaddressregister(reg) then
           begin
             scratch_reg:=getintregister(list,OS_INT);
-            instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,scratch_reg);
-            add_move_instruction(instr);
-            list.concat(instr);
+            list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg,scratch_reg));
             result:=scratch_reg;
           end
         else

compiler/m68k/rgcpu.pas

@@ -145,7 +145,8 @@ unit rgcpu;
                 (get_alias(getsupreg(instr.oper[0]^.reg))=orgreg) then
                 begin
                   { source can be replaced if dest is register... }
-                  if ((instr.oper[1]^.typ=top_reg) and 
+                  if ((instr.oper[1]^.typ=top_reg) and
+                      (get_alias(getsupreg(instr.oper[1]^.reg))<>orgreg) and
                      ((instr.opcode=A_MOVE) or (instr.opcode=A_ADD) or (instr.opcode=A_SUB) or
                       (instr.opcode=A_AND) or (instr.opcode=A_OR) or (instr.opcode=A_CMP))) or
                     {... or a "simple" reference in case of MOVE }
@@ -158,7 +159,8 @@ unit rgcpu;
                   ((instr.opcode=A_MOVE) or (instr.opcode=A_ADD) or (instr.opcode=A_SUB) or
                    (instr.opcode=A_AND) or (instr.opcode=A_OR)) and
                   (instr.oper[0]^.typ=top_reg) and not
-                  (isaddressregister(instr.oper[0]^.reg))
+                  (isaddressregister(instr.oper[0]^.reg)) and
+                  (get_alias(getsupreg(instr.oper[0]^.reg))<>orgreg)
                 ) or
                 ((instr.opcode=A_ADDQ) or (instr.opcode=A_SUBQ) or (instr.opcode=A_MOV3Q))) then
                 opidx:=1;
@@ -167,11 +169,9 @@ unit rgcpu;
             ;
         end;
 
-        if (opidx<0) then
+        if opidx<0 then
           exit;
-        instr.oper[opidx]^.typ:=top_ref;
-        new(instr.oper[opidx]^.ref);
-        instr.oper[opidx]^.ref^:=spilltemp;
+        instr.loadref(opidx,spilltemp);
         case taicpu(instr).opsize of
           S_B: inc(instr.oper[opidx]^.ref^.offset,3);
           S_W: inc(instr.oper[opidx]^.ref^.offset,2);

packages/fcl-extra/src/daemonapp.pp

@@ -55,7 +55,8 @@ Type
     Function ShutDown : Boolean; virtual;
     Function Install : Boolean; virtual;
     Function UnInstall: boolean; virtual;
-    Function HandleCustomCode(ACode : DWord) : Boolean; Virtual;
+    Function HandleCustomCode(ACode : DWord) : Boolean; virtual;
+    Function HandleCustomCode(ACode, AEventType : DWord; AEventData : Pointer) : Boolean; Virtual;
     procedure DoThreadTerminate(Sender: TObject);virtual;
   Public
     Procedure CheckControlMessages(Wait : Boolean);
@@ -74,6 +75,7 @@ Type
 
   { TDaemon }
   TCustomControlCodeEvent = Procedure(Sender : TCustomDaemon; ACode : DWord; Var Handled : Boolean) of object;
+  TCustomControlCodeEvEvent = Procedure(Sender : TCustomDaemon; ACode, AEventType : DWord; AEventData : Pointer; Var Handled : Boolean) of object;
 
   TDaemon = Class(TCustomDaemon)
   private
@@ -83,6 +85,7 @@ Type
     FBeforeUnInstall: TDaemonEvent;
     FOnContinue: TDaemonOKEvent;
     FOnCustomControl: TCustomControlCodeEvent;
+    FOnCustomControlEvent: TCustomControlCodeEvEvent;
     FOnExecute: TDaemonEvent;
     FOnPause: TDaemonOKEvent;
     FOnShutDown: TDaemonEvent;
@@ -97,6 +100,7 @@ Type
     Function ShutDown : Boolean; override;
     Function Install : Boolean; override;
     Function UnInstall: boolean; override;
+    Function HandleCustomCode(ACode, AEventType : DWord; AEventData : Pointer) : Boolean; override;
     Function HandleCustomCode(ACode : DWord) : Boolean; Override;
   Public
     Property Definition;
@@ -113,6 +117,7 @@ Type
     Property BeforeUnInstall : TDaemonEvent Read FBeforeUnInstall Write FBeforeUnInstall;
     Property AfterUnInstall : TDaemonEvent Read FAfterUnInstall Write FAfterUnInstall;
     Property OnControlCode : TCustomControlCodeEvent Read FOnCustomControl Write FOnCustomControl;
+    Property OnControlCodeEvent : TCustomControlCodeEvEvent Read FOnCustomControlEvent Write FOnCustomControlEvent;
   end;
 
   { TDaemonController }
@@ -175,10 +180,27 @@ Type
   end;
 
 
+  TWinControlCode = (
+    wccNetBindChange,
+    wccParamChange,
+    wccPreShutdown,
+    wccShutdown,
+    wccHardwareProfileChange,
+    wccPowerEvent,
+    wccSessionChange,
+    { Windows 7 + }
+    wccTimeChange,
+    wccTriggerEvent,
+    { Windows 8 + }
+    wccUserModeReboot
+  );
+  TWinControlCodes = set of TWinControlCode;
+
   { TWinBindings }
 
   TWinBindings = class(TPersistent)
   private
+    FAcceptedCodes: TWinControlCodes;
     FDependencies: TDependencies;
     FErrCode: DWord;
     FErrorSeverity: TErrorSeverity;
@@ -207,6 +229,7 @@ Type
     Property IDTag : DWord Read FTagID Write FTagID;
     Property ServiceType : TServiceType Read FServiceType Write FServiceType;
     Property ErrorSeverity : TErrorSeverity Read FErrorSeverity Write FErrorSeverity;
+    Property AcceptedCodes : TWinControlCodes Read FAcceptedCodes Write FAcceptedCodes;
   end;
 
   { TDaemonDef }
@@ -311,7 +334,7 @@ Type
     FDaemon : TCustomDaemon;
   Protected
     procedure StartServiceExecute; virtual;
-    procedure HandleControlCode(ACode : DWord); virtual;
+    procedure HandleControlCode(ACode, AEventType : DWord; AEventData: Pointer); virtual;
   Public
     Constructor Create(ADaemon : TCustomDaemon);
     Procedure Execute; override;
@@ -614,6 +637,15 @@ begin
     FAfterUnInstall(Self)
 end;
 
+function TDaemon.HandleCustomCode(ACode, AEventType : DWord; AEventData : Pointer): Boolean;
+begin
+  Result:=Assigned(FOnCustomControlEvent);
+  If Result then
+    FOnCustomControlEvent(Self,ACode,AEventType,AEventData,Result);
+  If not Result then
+    Result:=HandleCustomCode(ACode);
+end;
+
 function TDaemon.HandleCustomCode(ACode: DWord): Boolean;
 begin
   Result:=Assigned(FOnCustomControl);
@@ -695,6 +727,11 @@ begin
   Result:=False
 end;
 
+function TCustomDaemon.HandleCustomCode(ACode, AEventType: DWord; AEventData: Pointer): Boolean;
+begin
+  Result:=HandleCustomCode(ACode);
+end;
+
 procedure TCustomDaemon.DoThreadTerminate(Sender: TObject);
 begin
   Self.FThread := NIL;
@@ -1252,7 +1289,7 @@ begin
 end;
 
 
-procedure TDaemonThread.HandleControlCode(ACode : DWord);
+procedure TDaemonThread.HandleControlCode(ACode, AEventType : DWord; AEventData : Pointer);
 
 Var
   CS : TCurrentStatus;
@@ -1273,7 +1310,7 @@ begin
       SERVICE_CONTROL_INTERROGATE : OK:=InterrogateDaemon;
     else
       CC:=True;
-      FDaemon.HandleCustomCode(ACode);
+      FDaemon.HandleCustomCode(ACode, AEventType, AEventData);
     end;
     If not OK then
       FDaemon.Status:=CS;

packages/fcl-extra/src/unix/daemonapp.inc

@@ -180,7 +180,7 @@ procedure TDaemonController.Controller(ControlCode, EventType: DWord;
 
 begin
   // Send control code to daemon thread.
-  TDaemonThread(Daemon.DaemonThread).HandleControlCode(ControlCode);
+  TDaemonThread(Daemon.DaemonThread).HandleControlCode(ControlCode, 0, Nil);
 end;
 
 function TDaemonController.ReportStatus: Boolean;

packages/fcl-extra/src/win/daemonapp.inc

@@ -445,6 +445,15 @@ end;
   TDaemonThread
   ---------------------------------------------------------------------}
 
+
+type
+  TMessageRec = record
+    EventType: DWord;
+    EventData: Pointer;
+  end;
+  PMessageRec = ^TMessageRec;
+
+
 procedure TDaemonThread.StartServiceExecute;
 
 Var
@@ -475,8 +484,13 @@ begin
         begin
         If (Msg.hwnd<>0) or (Msg.Message<>CM_SERVICE_CONTROL_CODE) then
           DispatchMessage(Msg)
+        else if (Msg.Message=CM_SERVICE_CONTROL_CODE) then
+        begin
+          HandleControlCode(Msg.wParam, PMessageRec(Msg.lParam)^.EventType, PMessageRec(Msg.lParam)^.EventData);
+          System.Dispose(PMessageRec(Msg.lParam));
+        end
         else
-          HandleControlCode(Msg.wParam);
+          HandleControlCode(Msg.wParam, 0, Nil);
         end;
       end;
   Until StopLoop;
@@ -524,21 +538,36 @@ procedure TDaemonController.Controller(ControlCode, EventType: DWord;
 
 Var
   TID : THandle;
-
+  msg: PMessageRec;
 begin
   if Assigned(FDaemon.FThread) then
     begin
     TID:=FDaemon.FThread.ThreadID;
     If FDaemon.FThread.Suspended then
       FDaemon.FThread.Resume;
-    PostThreadMessage(TID,CM_SERVICE_CONTROL_CODE,ControlCode,EventType);
+    New(msg);
+    msg^.EventType := EventType;
+    msg^.EventData := EventData;
+    PostThreadMessage(TID,CM_SERVICE_CONTROL_CODE,ControlCode,LPARAM(msg));
     end;
 end;
 
 
 function TDaemonController.ReportStatus: Boolean;
 
-  Function GetAcceptedCodes : Integer;
+  Function GetAcceptedCodes(ACodes : TWinControlCodes) : Integer;
+
+    function IsWindows7OrNewer: Boolean; inline;
+    begin
+      Result := (Win32MajorVersion > 6) or
+                ((Win32MajorVersion = 6) and (Win32MinorVersion >= 1));
+    end;
+
+    function IsWindows8OrNewer: Boolean; inline;
+    begin
+      Result := (Win32MajorVersion > 6) or
+                ((Win32MajorVersion = 6) and (Win32MinorVersion >= 2));
+    end;
 
   begin
     Result := SERVICE_ACCEPT_SHUTDOWN;
@@ -546,6 +575,26 @@ function TDaemonController.ReportStatus: Boolean;
       Result := Result or SERVICE_ACCEPT_STOP;
     if doAllowPause in FDAemon.Definition.Options then
       Result := Result or SERVICE_ACCEPT_PAUSE_CONTINUE;
+    if wccNetBindChange in ACodes then
+      Result := Result or SERVICE_ACCEPT_NETBINDCHANGE;
+    if wccParamChange in ACodes then
+      Result := Result or SERVICE_ACCEPT_PARAMCHANGE;
+    if wccPreShutdown in ACodes then
+      Result := Result or SERVICE_ACCEPT_PRESHUTDOWN;
+    if wccShutdown in ACodes then
+      Result := Result or SERVICE_ACCEPT_SHUTDOWN;
+    if wccHardwareProfileChange in ACodes then
+      Result := Result or SERVICE_ACCEPT_HARDWAREPROFILECHANGE;
+    if wccPowerEvent in ACodes then
+      Result := Result or SERVICE_ACCEPT_POWEREVENT;
+    if wccSessionChange in ACodes then
+      Result := Result or SERVICE_ACCEPT_SESSIONCHANGE;
+    if (wccTimeChange in ACodes) and IsWindows7OrNewer then
+      Result := Result or SERVICE_ACCEPT_TIMECHANGE;
+    if (wccTriggerEvent in ACodes) and IsWindows8OrNewer then
+      Result := Result or SERVICE_ACCEPT_TRIGGEREVENT;
+    if (wccUserModeReboot in ACodes) and IsWindows8OrNewer then
+      Result := Result or SERVICE_ACCEPT_USERMODEREBOOT;
   end;
 
 Var
@@ -592,7 +641,7 @@ begin
     if (FDaemon.Status=csStartPending) then
       dwControlsAccepted := 0
     else
-      dwControlsAccepted := GetAcceptedCodes;
+      dwControlsAccepted := GetAcceptedCodes(WB.AcceptedCodes);
     if (FDaemon.Status in PendingStatus) and (FDaemon.Status = LastStatus) then
       Inc(FCheckPoint)
     else

packages/fcl-json/src/fpjson.pp

@@ -12,10 +12,10 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-{$mode objfpc}
-{$h+}
 unit fpjson;
 
+{$i fcl-json.inc}
+
 interface
 
 uses

packages/fcl-json/src/fpjsonrtti.pp

@@ -113,7 +113,7 @@ Type
   TJSONRestorePropertyEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Var Handled : Boolean) of object;
   TJSONPropertyErrorEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Error : Exception; Var Continue : Boolean) of object;
   TJSONGetObjectEvent = Procedure (Sender : TOBject; AObject : TObject; Info : PPropInfo; AData : TJSONObject; DataName : TJSONStringType; Var AValue : TObject);
-  TJSONDestreamOption = (jdoCaseInsensitive,jdoIgnorePropertyErrors,jdoIgnoreNulls);
+  TJSONDestreamOption = (jdoCaseInsensitive,jdoIgnorePropertyErrors,jdoIgnoreNulls,jdoNullClearsProperty);
   TJSONDestreamOptions = set of TJSONDestreamOption;
 
   TJSONDeStreamer = Class(TJSONFiler)
@@ -132,6 +132,7 @@ Type
     // Try to parse a date.
     Function ExtractDateTime(S : String): TDateTime;
     function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject;
+    procedure DoClearProperty(AObject: TObject; PropInfo: PPropInfo); virtual;
     procedure DoRestoreProperty(AObject: TObject; PropInfo: PPropInfo;  PropData: TJSONData); virtual;
     function DoMapProperty(AObject: TObject; PropInfo: PPropInfo; JSON: TJSONObject): TJSONData; virtual;
     procedure DoBeforeReadObject(Const JSON: TJSONObject; AObject: TObject); virtual;
@@ -396,9 +397,13 @@ begin
       If B then
         exit;
       end;
-    if (PropData.JSONType=jtNull) then
-      if Not (jdoIgnoreNulls in Options) then
-        DoRestoreProperty(AObject,PropInfo,PropData);
+    if (PropData.JSONType<>jtNull) then
+      DoRestoreProperty(AObject,PropInfo,PropData)
+    else if (jdoNullClearsProperty in Options) then
+      DoClearProperty(aObject,PropInfo)
+    else if not (jdoIgnoreNulls in Options) then
+      DoRestoreProperty(AObject,PropInfo,PropData)
+
   except
     On E : Exception do
       If Assigned(FOnPropError) then
@@ -413,6 +418,56 @@ begin
   end;
 end;
 
+procedure TJSONDeStreamer.DoClearProperty(AObject : TObject;PropInfo : PPropInfo);
+
+Var
+  PI : PPropInfo;
+  TI : PTypeInfo;
+
+begin
+  PI:=PropInfo;
+  TI:=PropInfo^.PropType;
+  case TI^.Kind of
+    tkUnknown :
+      Error(SErrUnknownPropertyKind,[PI^.Name]);
+    tkInteger,
+    tkEnumeration,
+    tkSet,
+    tkChar,
+    tkWChar,
+    tkBool,
+    tkQWord,
+    tkUChar,
+    tkInt64 :
+      SetOrdProp(AObject,PI,0);
+    tkFloat :
+      SetFloatProp(AObject,PI,0.0);
+    tkSString,
+    tkLString,
+    tkAString:
+      SetStrProp(AObject,PI,'');
+    tkWString :
+      SetWideStrProp(AObject,PI,'');
+    tkVariant:
+      SetVariantProp(AObject,PI,Null);
+    tkClass:
+      SetOrdProp(AObject,PI,0);
+    tkUString :
+      SetUnicodeStrProp(AObject,PI,'');
+  else
+{
+    tkObject,
+    tkArray,
+    tkRecord,
+    tkInterface,
+    tkDynArray,
+    tkInterfaceRaw,
+    tkProcVar,
+    tkMethod }
+      Error(SErrUnsupportedPropertyKind,[PI^.Name]);
+  end;
+end;
+
 procedure TJSONDeStreamer.DoRestoreProperty(AObject : TObject;PropInfo : PPropInfo; PropData : TJSONData);
 
 Var

packages/fcl-json/tests/testjsonrtti.pp

@@ -122,6 +122,7 @@ type
     procedure DeStream(JSON: TJSONStringType; AObject: TObject);
     procedure DeStream(JSON: TJSONObject; AObject: TObject);
     procedure DoDateTimeFormat;
+    Procedure DoNullError;
   protected
     procedure SetUp; override;
     procedure TearDown; override;
@@ -138,6 +139,8 @@ type
     Procedure TestVariantString;
     Procedure TestVariantArray;
     procedure TestEmpty;
+    procedure TestNullError;
+    procedure TestNull;
     procedure TestBoolean;
     procedure TestInteger;
     procedure TestIntegerCaseInsensitive;
@@ -284,6 +287,23 @@ begin
   AssertEquals('Empty Tag',0,TComponent(FToFree).Tag);
 end;
 
+procedure TTestJSONDeStreamer.TestNullError;
+
+begin
+  AssertException('Null error',EJSON, @DoNullError);
+end;
+
+procedure TTestJSONDeStreamer.TestNull;
+Var
+  B : TBooleanComponent;
+
+begin
+  B:=TBooleanComponent.Create(Nil);
+  DS.Options:=DS.Options+[jdoIgnoreNulls];
+  DeStream('{ "BooleanProp" : null }',B);
+  AssertEquals('Correct boolean value',False,B.BooleanProp);
+end;
+
 procedure TTestJSONDeStreamer.DeStream(JSON : TJSONStringType; AObject : TObject);
 
 begin
@@ -428,6 +448,15 @@ begin
   DeStream('{"DateTimeProp" : "'+DateTimeToStr(RecodeMillisecond(Now,0))+'"}',FToFree);
 end;
 
+procedure TTestJSONDeStreamer.DoNullError;
+Var
+  B : TBooleanComponent;
+
+begin
+  B:=TBooleanComponent.Create(Nil);
+  Destream('{ "BooleanProp" : null }',B);
+end;
+
 procedure TTestJSONDeStreamer.TestDateTimeFormat;
 
 Const

packages/fcl-passrc/src/pastree.pp

@@ -4249,7 +4249,7 @@ begin
   if Full then
     begin
     if GenericTemplateTypes<>nil then
-      Result:=Result+GenericTemplateTypesAsString(GenericTemplateTypes)+' = '+Result
+      Result:=SafeName+GenericTemplateTypesAsString(GenericTemplateTypes)+' = '+Result
     else
       Result:=SafeName+' = '+Result;
     end;

packages/fcl-passrc/src/paswrite.pp

@@ -35,7 +35,10 @@ type
                       woAddLineNumber,    // Prefix line with generated line numbers in comment
                       woAddSourceLineNumber,    // Prefix line with original source line numbers (when available) in comment
                       woForwardClasses,   // Add forward definitions for all classes
-                      woForceOverload     // Force 'overload;' on overloads that are not marked as such.
+                      woForceOverload,     // Force 'overload;' on overloads that are not marked as such.
+                      woNoAsm,         // Do not allow asm block
+                      woSkipPrivateExternals,  // Skip generation of external procedure declaration in implementation section
+                      woAlwaysRecordHelper     // Force use of record helper for type helper
                       );
   TPasWriterOptions = Set of TPasWriterOption;
 
@@ -60,6 +63,7 @@ type
     procedure SetForwardClasses(AValue: TStrings);
     procedure SetIndentSize(AValue: Integer);
   protected
+    procedure DisableHintsWarnings;
     procedure PrepareDeclSectionInStruct(const ADeclSection: string);
     procedure MaybeSetLineElement(AElement: TPasElement);
     function GetExpr(E: TPasExpr): String; virtual;
@@ -82,10 +86,11 @@ type
   public
     constructor Create(AStream: TStream); virtual;
     destructor Destroy; override;
+    procedure WriteMembers(aMembers: TFPList; aDefaultVisibility: TPasMemberVisibility=visDefault); virtual;
     procedure AddForwardClasses(aSection: TPasSection); virtual;
     procedure WriteResourceString(aStr: TPasResString); virtual;
     procedure WriteEnumType(AType: TPasEnumType); virtual;
-    procedure WriteElement(AElement: TPasElement);virtual;
+    procedure WriteElement(AElement: TPasElement;SkipSection : Boolean = False);virtual;
     procedure WriteType(AType: TPasType; Full : Boolean = True);virtual;
     procedure WriteProgram(aModule : TPasProgram); virtual;
     Procedure WriteLibrary(aModule : TPasLibrary); virtual;
@@ -220,10 +225,11 @@ begin
     FLineElement:=AElement;
 end;
 
-procedure TPasWriter.WriteElement(AElement: TPasElement);
+procedure TPasWriter.WriteElement(AElement: TPasElement;SkipSection : Boolean = False);
 
 begin
-  MaybeSetLineElement(AElement);
+  if not SkipSection then
+    MaybeSetLineElement(AElement);
   if AElement.InheritsFrom(TPasModule) then
     WriteModule(TPasModule(AElement))
   else if AElement.InheritsFrom(TPasSection) then
@@ -299,6 +305,16 @@ begin
     AddLn(';');
 end;
 
+procedure TPasWriter.DisableHintsWarnings;
+
+begin
+  Addln('{$HINTS OFF}');
+  Addln('{$WARNINGS OFF}');
+  Addln('{$IFDEF FPC}');
+  Addln('{$NOTES OFF}');
+  Addln('{$ENDIF FPC}');
+end;
+
 procedure TPasWriter.WriteProgram(aModule: TPasProgram);
 
 Var
@@ -321,13 +337,7 @@ begin
     AddLn;
     end;
   if HasOption(woNoImplementation) then
-    begin
-    Addln('{$HINTS OFF}');
-    Addln('{$WARNINGS OFF}');
-    Addln('{$IFDEF FPC}');
-    Addln('{$NOTES OFF}');
-    Addln('{$ENDIF FPC}');
-    end;
+    DisableHintsWarnings;
   if Assigned(aModule.ProgramSection) then
     WriteSection(aModule.ProgramSection);
   if Assigned(AModule.InitializationSection) then
@@ -364,11 +374,7 @@ begin
     AddLn;
     end;
   if HasOption(woNoImplementation) then
-    begin
-    Addln('{$HINTS OFF}');
-    Addln('{$WARNINGS OFF}');
-    Addln('{$NOTES OFF}');
-    end;
+    DisableHintsWarnings;
   if Assigned(AModule.InitializationSection) then
     begin
     PrepareDeclSection('');
@@ -484,18 +490,14 @@ begin
   AddLn('implementation');
   FInImplementation:=True;
   if HasOption(woNoImplementation) then
-    begin
-    Addln('{$HINTS OFF}');
-    Addln('{$WARNINGS OFF}');
-    Addln('{$NOTES OFF}');
-    end;
+    DisableHintsWarnings;
   if hasOption(woNoExternalFunc) then
     WriteDummyExternalFunctions(AModule.InterfaceSection);
   if Assigned(AModule.ImplementationSection) then
-  begin
+    begin
     AddLn;
     WriteSection(AModule.ImplementationSection);
-  end;
+    end;
   AddLn;
   if NotOption(woNoImplementation) then
     begin
@@ -564,12 +566,13 @@ begin
   C:=0;
   if ASection.UsesList.Count>0 then
     begin
-    For I:=1 to WordCount(ExtraUnits,UnitSeps) do
-      begin
-      u:=Trim(ExtractWord(1,ExtraUnits,UnitSeps));
-      if (U<>'') then
-        AddUnit(U,Nil);
-      end;
+    if not (aSection is TImplementationSection) then
+      For I:=1 to WordCount(ExtraUnits,UnitSeps) do
+        begin
+        u:=Trim(ExtractWord(1,ExtraUnits,UnitSeps));
+        if (U<>'') then
+          AddUnit(U,Nil);
+        end;
     if length(ASection.UsesClause)=ASection.UsesList.Count then
       begin
       for i := 0 to length(ASection.UsesClause)-1 do
@@ -609,17 +612,7 @@ procedure TPasWriter.WriteClass(AClass: TPasClassType);
 
 var
   i: Integer;
-  Member, LastMember: TPasElement;
   InterfacesListPrefix: string;
-  LastVisibility, CurVisibility: TPasMemberVisibility;
-
-  function ForceVisibility: boolean;
-  begin
-    Result := (LastMember <> nil) and
-      // variables can't be declared directly after methods nor properties
-      // (visibility section or var keyword is required)
-      ((Member is TPasVariable) and not (Member is TPasProperty)) and not (LastMember is TPasVariable);
-  end;
 
 begin
   PrepareDeclSection('type');
@@ -632,9 +625,22 @@ begin
     okObject: Add('object');
     okClass: Add('class');
     okInterface: Add('interface');
+    okTypeHelper :
+      if HasOption(woAlwaysRecordHelper) then
+        Add('record helper')
+      else
+        Add('type helper');
     okRecordHelper: Add('record helper');
     okClassHelper: Add('class helper');
   end;
+  if (AClass.ObjKind in [okTypeHelper,okRecordHelper,okClassHelper]) then
+    begin
+    if not Assigned(AClass.HelperForType) then
+      Add(' for unknowntype')
+    else
+      Add(' for '+AClass.HelperForType.SafeName)
+    end;
+
   if AClass.IsForward then
     exit;
   if (AClass.ObjKind=okClass) and (ACLass.ExternalName<>'') and NotOption(woNoExternalClass) then
@@ -660,11 +666,35 @@ begin
       AddLn('['+AClass.InterfaceGUID+']');
   IncIndent;
   IncDeclSectionLevel;
-  LastVisibility := visDefault;
+  WriteMembers(AClass.Members);
+  DecDeclSectionLevel;
+  DecIndent;
+  Add('end');
+end;
+
+procedure TPasWriter.WriteMembers(aMembers : TFPList; aDefaultVisibility : TPasMemberVisibility = visDefault);
+
+Var
+  Member, LastMember: TPasElement;
+  LastVisibility, CurVisibility: TPasMemberVisibility;
+
+  function ForceVisibility: boolean;
+  begin
+    Result := (LastMember <> nil) and
+      // variables can't be declared directly after methods nor properties
+      // (visibility section or var keyword is required)
+      ((Member is TPasVariable) and not (Member is TPasProperty)) and not (LastMember is TPasVariable);
+  end;
+
+Var
+  I : integer;
+
+begin
+  LastVisibility:=aDefaultVisibility;
   LastMember := nil;
-  for i := 0 to AClass.Members.Count - 1 do
+  for i := 0 to aMembers.Count - 1 do
     begin
-    Member := TPasElement(AClass.Members[i]);
+    Member := TPasElement(aMembers[i]);
     CurVisibility := Member.Visibility;
     if (CurVisibility <> LastVisibility) or ForceVisibility then
       begin
@@ -683,9 +713,6 @@ begin
     WriteElement(Member);
     LastMember := Member;
     end;
-  DecDeclSectionLevel;
-  DecIndent;
-  Add('end');
 end;
 
 procedure TPasWriter.WriteConst(AConst: TPasConst);
@@ -708,7 +735,7 @@ begin
   // handle variables in classes/records
   else if vmClass in aVar.VarModifiers then
     PrepareDeclSectionInStruct('class var')
-  else if CurDeclSection<>'' then
+  else if (CurDeclSection<>'') and not (aVar.Parent.ClassType = TPasRecordType) then
     PrepareDeclSectionInStruct('var');
   Add(aVar.SafeName + ': ');
   if Not Assigned(aVar.VarType) then
@@ -772,19 +799,29 @@ end;
 procedure TPasWriter.WriteRecordType(AType: TPasRecordType);
 
 Var
-  S : TStrings;
   I : Integer;
+  Temp : String;
+  el : TPasElement;
 
 begin
-  S:=TStringList.Create;
-  try
-    S.Text:=AType.GetDeclaration(true);
-    For I:=0 to S.Count-2 do
-      AddLn(S[i]);
-    Add(S[S.Count-1]);
-  finally
-    S.Free;
-  end;
+  Temp:='record';
+  If aType.IsPacked then
+    if Atype.IsBitPacked then
+      Temp:='bitpacked '+Temp
+    else
+      Temp:='packed '+Temp;
+  If (Atype.Name<>'') then
+    begin
+    if AType.GenericTemplateTypes.Count>0 then
+      Temp:=AType.SafeName+GenericTemplateTypesAsString(AType.GenericTemplateTypes)+' = '+Temp
+    else
+      Temp:=AType.SafeName+' = '+Temp;
+    end;
+  AddLn(Temp);
+  IncIndent;
+  WriteMembers(AType.Members,visPublic);
+  DecIndent;
+  Add('end');
 end;
 
 procedure TPasWriter.WriteArrayType(AType: TPasArrayType; Full : Boolean = True);
@@ -801,18 +838,30 @@ begin
     Add('; '+cCallingConventions[TPasProcedureType(AProc).CallingConvention]);
 end;
 
+
 procedure TPasWriter.WriteProcDecl(AProc: TPasProcedure; ForceBody : Boolean = False; NamePrefix : String = '');
 
+  Procedure EmptyBody;
+
+  begin
+    Addln('');
+    Addln('begin');
+    AddLn('end;');
+    Addln('');
+  end;
 Var
   AddExternal : boolean;
   IsImpl : Boolean;
 
 begin
+
   IsImpl:=AProc.Parent is TPasSection;
   if IsImpl then
     PrepareDeclSection('');
   if Not IsImpl then
     IsImpl:=FInImplementation;
+  if FInImplementation and (Assigned(AProc.LibraryExpr) or Assigned(AProc.LibrarySymbolName)) and HasOption(woSkipPrivateExternals)  then
+    Exit;
   Add(AProc.TypeName + ' ' + NamePrefix+AProc.SafeName);
   if Assigned(AProc.ProcType) and (AProc.ProcType.Args.Count > 0) then
     AddProcArgs(AProc.ProcType.Args) ;
@@ -826,7 +875,7 @@ begin
   // delphi compatible order for example: procedure foo; reintroduce; overload; static;
   if not IsImpl and AProc.IsReintroduced then
     Add(' reintroduce;');
-  if AProc.IsOverload then
+  if AProc.IsOverload and (Not FInImplementation) then
     Add(' overload;');
   if not IsImpl then
     begin
@@ -841,7 +890,7 @@ begin
     if AProc.IsStatic then
       Add(' static;');
     end;
-  if pmAssembler in AProc.Modifiers then
+  if (pmAssembler in AProc.Modifiers) and Not (woNoAsm in OPtions) then
     Add(' assembler;');
   if AProc.CallingConvention<>ccDefault then
     Add(' '+cCallingConventions[AProc.CallingConvention]+';');
@@ -863,16 +912,15 @@ begin
     end;
   AddLn;
 
-  if Assigned(AProc.Body) then
-    WriteProcImpl(AProc.Body,pmAssembler in AProc.Modifiers)
-  else if ForceBody then
+  if Assigned(AProc.Body)  then
     begin
-    Addln('');
-    Addln('begin');
-    AddLn('end;');
-    Addln('');
-    end;
-
+    if (pmAssembler in AProc.Modifiers) and (woNoAsm in Options) then
+      EmptyBody
+    else
+      WriteProcImpl(AProc.Body,pmAssembler in AProc.Modifiers)
+    end
+  else if ForceBody then
+    EmptyBody;
 end;
 
 

packages/pastojs/src/fppas2js.pp

@@ -24353,25 +24353,45 @@ function TPasToJSConverter.ConvertExceptOn(El: TPasImplExceptOn;
   AContext: TConvertContext): TJSElement;
 // convert "on T do ;" to "if(T.isPrototypeOf(exceptObject)){}"
 // convert "on E:T do ;" to "if(T.isPrototypeOf(exceptObject)){ var E=exceptObject; }"
+// convert "on TExternal do ;" to "if(rtl.isExt(exceptObject,TExternal)){}"
+
 Var
   IfSt : TJSIfStatement;
   ListFirst , ListLast: TJSStatementList;
   DotExpr: TJSDotMemberExpression;
   Call: TJSCallExpression;
   V: TJSVariableStatement;
+  aResolver: TPas2JSResolver;
+  aType: TPasType;
+  IsExternal: Boolean;
 begin
   Result:=nil;
+  aResolver:=AContext.Resolver;
+  aType:=aResolver.ResolveAliasType(El.TypeEl);
+  IsExternal:=(aType is TPasClassType) and TPasClassType(aType).IsExternal;
+
   // create "if()"
   IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
   try
-    // create "T.isPrototypeOf"
-    DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
-    DotExpr.MExpr:=CreateReferencePathExpr(El.TypeEl,AContext);
-    DotExpr.Name:='isPrototypeOf';
-    // create "T.isPrototypeOf(exceptObject)"
-    Call:=CreateCallExpression(El);
-    Call.Expr:=DotExpr;
-    Call.AddArg(CreatePrimitiveDotExpr(GetBIName(pbivnExceptObject),El));
+    if IsExternal then
+      begin
+      // create rtl.isExt(exceptObject,T)
+      Call:=CreateCallExpression(El);
+      Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnIsExt)]);
+      Call.AddArg(CreatePrimitiveDotExpr(GetBIName(pbivnExceptObject),El));
+      Call.AddArg(CreateReferencePathExpr(El.TypeEl,AContext));
+      end
+    else
+      begin
+      // create "T.isPrototypeOf"
+      DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
+      DotExpr.MExpr:=CreateReferencePathExpr(El.TypeEl,AContext);
+      DotExpr.Name:='isPrototypeOf';
+      // create "T.isPrototypeOf(exceptObject)"
+      Call:=CreateCallExpression(El);
+      Call.Expr:=DotExpr;
+      Call.AddArg(CreatePrimitiveDotExpr(GetBIName(pbivnExceptObject),El));
+      end;
     IfSt.Cond:=Call;
 
     if El.VarEl<>nil then

packages/pastojs/tests/tcmodules.pas

@@ -16957,28 +16957,35 @@ end;
 procedure TTestModule.TestExternalClass_Is;
 begin
   StartProgram(false);
-  Add('{$modeswitch externalclass}');
-  Add('type');
-  Add('  TExtA = class external name ''ExtA''');
-  Add('  end;');
-  Add('  TExtAClass = class of TExtA;');
-  Add('  TExtB = class external name ''ExtB'' (TExtA)');
-  Add('  end;');
-  Add('  TExtBClass = class of TExtB;');
-  Add('  TExtC = class (TExtB)');
-  Add('  end;');
-  Add('  TExtCClass = class of TExtC;');
-  Add('var');
-  Add('  A: texta; ClA: TExtAClass;');
-  Add('  B: textb; ClB: TExtBClass;');
-  Add('  C: textc; ClC: TExtCClass;');
-  Add('begin');
-  Add('  if a is textb then ;');
-  Add('  if a is textc then ;');
-  Add('  if b is textc then ;');
-  Add('  if cla is textb then ;');
-  Add('  if cla is textc then ;');
-  Add('  if clb is textc then ;');
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtA''',
+  '  end;',
+  '  TExtAClass = class of TExtA;',
+  '  TExtB = class external name ''ExtB'' (TExtA)',
+  '  end;',
+  '  TExtBClass = class of TExtB;',
+  '  TExtC = class (TExtB)',
+  '  end;',
+  '  TExtCClass = class of TExtC;',
+  'var',
+  '  A: texta; ClA: TExtAClass;',
+  '  B: textb; ClB: TExtBClass;',
+  '  C: textc; ClC: TExtCClass;',
+  'begin',
+  '  if a is textb then ;',
+  '  if a is textc then ;',
+  '  if b is textc then ;',
+  '  if cla is textb then ;',
+  '  if cla is textc then ;',
+  '  if clb is textc then ;',
+  '  try',
+  '  except',
+  '  on TExtA do ;',
+  '  on e: TExtB do ;',
+  '  end;',
+  '']);
   ConvertProgram;
   CheckSource('TestExternalClass_Is',
     LinesToStr([ // statements
@@ -17002,6 +17009,12 @@ begin
     'if (rtl.isExt($mod.ClA, ExtB)) ;',
     'if (rtl.is($mod.ClA, $mod.TExtC)) ;',
     'if (rtl.is($mod.ClB, $mod.TExtC)) ;',
+    'try {} catch ($e) {',
+    '  if (rtl.isExt($e,ExtA)) {}',
+    '  else if (rtl.isExt($e,ExtB)) {',
+    '    var e = $e;',
+    '  } else throw $e',
+    '};',
     '']));
 end;
 

packages/winunits-jedi/src/jwawinsvc.pas

@@ -157,6 +157,12 @@ const
   {$EXTERNALSYM SERVICE_CONTROL_POWEREVENT}
   SERVICE_CONTROL_SESSIONCHANGE         = $0000000E;
   {$EXTERNALSYM SERVICE_CONTROL_SESSIONCHANGE}
+  SERVICE_CONTROL_TIMECHANGE            = $00000010;
+  {$EXTERNALSYM SERVICE_CONTROL_TIMECHANGE}
+  SERVICE_CONTROL_TRIGGEREVENT          = $00000020;
+  {$EXTERNALSYM SERVICE_CONTROL_TRIGGEREVENT}
+  SERVICE_CONTROL_USERMODEREBOOT        = $00000040;
+  {$EXTERNALSYM SERVICE_CONTROL_USERMODEREBOOT}
 
 //
 // Service State -- for CurrentState
@@ -197,6 +203,13 @@ const
   {$EXTERNALSYM SERVICE_ACCEPT_POWEREVENT}
   SERVICE_ACCEPT_SESSIONCHANGE         = $00000080;
   {$EXTERNALSYM SERVICE_ACCEPT_SESSIONCHANGE}
+  SERVICE_ACCEPT_TIMECHANGE            = $00000200;
+  {$EXTERNALSYM SERVICE_ACCEPT_TIMECHANGE}
+  SERVICE_ACCEPT_TRIGGEREVENT          = $00000400;
+  {$EXTERNALSYM SERVICE_ACCEPT_TRIGGEREVENT}
+  SERVICE_ACCEPT_USERMODEREBOOT        = $00000800;
+  {$EXTERNALSYM SERVICE_ACCEPT_USERMODEREBOOT}
+
 
 //
 // Service Control Manager object specific access types

rtl/i8086/math.inc

@@ -42,10 +42,10 @@
     procedure Handle_I8086_Error(InterruptNumber : dword); public name 'FPC_HANDLE_I8086_ERROR';
       var
         FpuStatus : word;
-        OutError : dword;
+        OutError : byte;
       begin
         OutError:=InterruptNumber;
-        case InterruptNumber of
+        case byte(InterruptNumber) of
          0 : OutError:=200;    {'Division by Zero'}
          5 : OutError:=201;    {'Bounds Check', not caught yet }
          12 : OutError:=202;   {'Stack Fault', not caught yet }

tests/webtbs/tw37423.pp

@@ -0,0 +1,90 @@
+program inline_bug;
+
+{$MODE objfpc}
+
+{ bug is only triggered when inlining is on }
+{$INLINE on}
+
+{
+
+[nickysn@dhcppc1 inline_bug]$ fpc inline_bug
+Free Pascal Compiler version 3.2.0 [2020/06/21] for x86_64
+Copyright (c) 1993-2020 by Florian Klaempfl and others
+Target OS: Linux for x86-64
+Compiling inline_bug.pas
+Linking inline_bug
+/usr/bin/ld: inline_bug.o: in function `P$INLINE_BUG$_$TMODULE_$__$$_DOSTUFF':
+inline_bug.pas:(.text.n_p$inline_bug$_$tmodule_$__$$_dostuff+0x59): undefined reference to `.Lj62'
+inline_bug.pas(69,1) Error: Error while linking
+inline_bug.pas(69,1) Fatal: There were 1 errors compiling module, stopping
+Fatal: Compilation aborted
+Error: /usr/bin/ppcx64 returned an error exitcode
+
+}
+
+type
+  TSample = class
+  private
+    function GetContainsData: Boolean; inline;
+  public
+    property ContainsData: Boolean read GetContainsData;
+  end;
+  TSampleList = class
+  private
+    FSampleList: array [1..10] of TSample;
+    function GetSample(Index: Integer): TSample; inline;
+  public
+    constructor Create;
+    property Sample[Index: Integer]: TSample read GetSample; default;
+  end;
+  TModule = class
+  private
+    FSamples: TSampleList;
+  public
+    constructor Create;
+    procedure DoStuff;
+  end;
+
+function TSample.GetContainsData: Boolean; inline;
+begin
+  Result := False;
+end;
+
+constructor TSampleList.Create;
+var
+  I: Integer;
+begin
+  for I := 1 to 10 do
+    FSampleList[I] := TSample.Create;
+end;
+
+function TSampleList.GetSample(Index: Integer): TSample; inline;
+begin
+  if (Index < Low(FSampleList)) or (Index > High(FSampleList)) then
+    raise TObject.Create;
+  Result := FSampleList[Index];
+end;
+
+constructor TModule.Create;
+begin
+  FSamples := TSampleList.Create;
+end;
+
+procedure TModule.DoStuff;
+var
+  I: Integer;
+begin
+  for I := 1 to 10 do
+    if FSamples[I].ContainsData then
+      begin
+        Writeln('!!!');
+        halt(1);
+      end;
+end;
+
+var
+  Module: TModule;
+begin
+  Module := TModule.Create;
+  Module.DoStuff;
+end.

utils/pas2js/stubcreator.pp

@@ -340,7 +340,7 @@ begin
   FLineNumberWidth:=4;
   FIndentSize:=2;
   FExtraUnits:='';
-  FOptions:=[woNoImplementation,woNoExternalClass,woNoExternalVar,woNoExternalFunc];
+  FOptions:=[woNoImplementation,woNoExternalClass,woNoExternalVar,woNoExternalFunc,woNoAsm,woSkipPrivateExternals,woAlwaysRecordHelper];
 end;
 
 destructor TStubCreator.Destroy;