View Issue Details

IDProjectCategoryView StatusLast Update
0031687FPCFCLpublic2017-04-21 21:07
ReporterDenis KozlovAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Product Version3.1.1Product Build 
Target Version3.2.0Fixed in Version3.1.1 
Summary0031687: TCustomApplication.Terminate(0) does not set 0 exit code
DescriptionCalling TCustomApplication.Terminate(0) does not set 0 exit code, because it explicitly discards a zero value.

This contradicts the documentation and common sense.
Additional InformationSample project and patch are attached.
Tagspatch
Fixed in Revision35877
FPCOldBugId
FPCTarget
Attached Files
  • example.pas (534 bytes)
    program example;
    
    {$mode objfpc}{$H+}
    
    uses
      Classes, SysUtils, CustApp;
    
    type
      TMyApplication = class(TCustomApplication)
      protected
        procedure DoRun; override;
      end;
    
    procedure TMyApplication.DoRun;
    begin
      ExitCode := 1; // Set exit code "1"
      Terminate(0);  // Set exit code "0" (NOT WORKING)
    end;
    
    var
      Application: TMyApplication;
    
    begin
      Application := TMyApplication.Create(nil);
      Application.Run;
      Application.Free;
      WriteLn(ExitCode); // Prints out "1" instead of "0"
      ReadLn;
    end.
    
    example.pas (534 bytes)
  • custapp.pp.patch (627 bytes)
    Index: packages/fcl-base/src/custapp.pp
    ===================================================================
    --- packages/fcl-base/src/custapp.pp	(revision 35860)
    +++ packages/fcl-base/src/custapp.pp	(working copy)
    @@ -362,7 +362,7 @@
     
     procedure TCustomApplication.Terminate;
     begin
    -  Terminate(0);
    +  Terminate(ExitCode);
     end;
     
     procedure TCustomApplication.Terminate(AExitCode : Integer) ;
    @@ -369,8 +369,7 @@
     
     begin
       FTerminated:=True;
    -  If (AExitCode<>0) then
    -    ExitCode:=AExitCode;
    +  ExitCode:=AExitCode;
     end;
     
     function TCustomApplication.GetOptionAtIndex(AIndex : Integer; IsLong: Boolean): String;
    
    custapp.pp.patch (627 bytes)

Activities

Denis Kozlov

2017-04-20 16:24

reporter  

example.pas (534 bytes)
program example;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils, CustApp;

type
  TMyApplication = class(TCustomApplication)
  protected
    procedure DoRun; override;
  end;

procedure TMyApplication.DoRun;
begin
  ExitCode := 1; // Set exit code "1"
  Terminate(0);  // Set exit code "0" (NOT WORKING)
end;

var
  Application: TMyApplication;

begin
  Application := TMyApplication.Create(nil);
  Application.Run;
  Application.Free;
  WriteLn(ExitCode); // Prints out "1" instead of "0"
  ReadLn;
end.
example.pas (534 bytes)

Denis Kozlov

2017-04-20 16:24

reporter  

custapp.pp.patch (627 bytes)
Index: packages/fcl-base/src/custapp.pp
===================================================================
--- packages/fcl-base/src/custapp.pp	(revision 35860)
+++ packages/fcl-base/src/custapp.pp	(working copy)
@@ -362,7 +362,7 @@
 
 procedure TCustomApplication.Terminate;
 begin
-  Terminate(0);
+  Terminate(ExitCode);
 end;
 
 procedure TCustomApplication.Terminate(AExitCode : Integer) ;
@@ -369,8 +369,7 @@
 
 begin
   FTerminated:=True;
-  If (AExitCode<>0) then
-    ExitCode:=AExitCode;
+  ExitCode:=AExitCode;
 end;
 
 function TCustomApplication.GetOptionAtIndex(AIndex : Integer; IsLong: Boolean): String;
custapp.pp.patch (627 bytes)

Denis Kozlov

2017-04-20 16:27

reporter   ~0099703

Please backport to FPC 3.0 fixes too.

Michael Van Canneyt

2017-04-21 21:07

administrator   ~0099741

Applied the patch, thanks for the fix!

Issue History

Date Modified Username Field Change
2017-04-20 16:23 Denis Kozlov New Issue
2017-04-20 16:24 Denis Kozlov File Added: example.pas
2017-04-20 16:24 Denis Kozlov File Added: custapp.pp.patch
2017-04-20 16:24 Denis Kozlov Tag Attached: patch
2017-04-20 16:27 Denis Kozlov Note Added: 0099703
2017-04-20 16:27 Michael Van Canneyt Assigned To => Michael Van Canneyt
2017-04-20 16:27 Michael Van Canneyt Status new => assigned
2017-04-21 21:07 Michael Van Canneyt Fixed in Revision => 35877
2017-04-21 21:07 Michael Van Canneyt Note Added: 0099741
2017-04-21 21:07 Michael Van Canneyt Status assigned => resolved
2017-04-21 21:07 Michael Van Canneyt Fixed in Version => 3.1.1
2017-04-21 21:07 Michael Van Canneyt Resolution open => fixed
2017-04-21 21:07 Michael Van Canneyt Target Version => 3.2.0