Recent

Author Topic: Different outcome in Lazarus Trunk and in 2.0.2  (Read 1652 times)

madref

  • Hero Member
  • *****
  • Posts: 949
  • ..... A day not Laughed is a day wasted !!
    • Nursing With Humour
Different outcome in Lazarus Trunk and in 2.0.2
« on: May 24, 2019, 05:13:41 pm »
I have this problem when I run the same code in Lazarus 2.0.2 it works great.
But when I run the code in Lazarus Trunk I get all zero's


It all started with this thread
https://forum.lazarus.freepascal.org/index.php/topic,44814.60.html


And I ended up with this code:
Code: Pascal  [Select][+][-]
  1. unit referee_test;
  2.  
  3.  
  4. {$mode objfpc}{$H+}
  5.  
  6.  
  7. interface
  8.  
  9.  
  10. uses
  11.   Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls,
  12.   referee_wedstrijd_sheet;
  13.  
  14.  
  15. type
  16.  
  17.  
  18.   { TForm_Test }
  19.  
  20.  
  21.   TForm_Test = class(TForm)
  22.     BT_Close: TButton;
  23.     FullTextMemo: TMemo;
  24.     PenaltyMemo: TMemo;
  25.     SelectFileRG: TRadioGroup;
  26.     Splitter: TSplitter;
  27.     TopPanel: TPanel;
  28.     procedure BT_CloseClick(Sender: TObject);
  29.     procedure PopulateMemosFromFile(aFilename: String);
  30.     procedure SelectFileRGSelectionChanged(Sender: TObject);
  31.   end;
  32.  
  33.  
  34. var
  35.   Form_Test: TForm_Test;
  36.  
  37.  
  38. implementation
  39.  
  40.  
  41. {$R *.lfm}
  42.  
  43.  
  44. { TForm_Test }
  45.  
  46.  
  47. function GetName(pp: TWedstrijdSheetParser; aTeam: TTeamStr): String;
  48. begin
  49.   case aTeam of
  50.     sTeamA: Exit(pp.TeamA);
  51.     sTeamB: Exit(pp.TeamB);
  52.   end;
  53. end;
  54.  
  55.  
  56. procedure TForm_Test.PopulateMemosFromFile(aFilename: String);
  57. var
  58.   pp: TWedstrijdSheetParser;
  59.   team: TTeamStr;
  60.   period: TPeriodStr;
  61.   penaltyKind: TPenaltyKind;
  62.   total: Integer;
  63.   FlatString: string;
  64.   MinorA, MajorA, MiscA, GMPA, MPA, PSA: integer;
  65.   MinorB, MajorB, MiscB, GMPB, MPB, PSB: integer;
  66.  
  67.  
  68.   function PeriodToStr(aPeriod: TPeriodStr): String;
  69.   begin
  70.     WriteStr(Result, aPeriod);
  71.     Delete(Result, 1, 1);
  72.   end;
  73.  
  74.  
  75.   function PenaltyKindToStr(aPenaltyKind: TPenaltyKind): String;
  76.   begin
  77.     WriteStr(Result, aPenaltyKind);
  78.     Delete(Result, 1, 2);
  79.   end;
  80.  
  81.  
  82. begin
  83.   FullTextMemo.Lines.LoadFromFile(aFilename);
  84.  
  85.  
  86.   pp := TWedstrijdSheetParser.Create(aFilename);
  87.  
  88.  
  89.   try
  90.     PenaltyMemo.Clear;
  91.     PenaltyMemo.Append('Using data file "' + pp.Filename + '"'#10);
  92.     MinorA := 0;              MinorB := 0;
  93.     MajorA := 0;              MajorB := 0;
  94.     MiscA := 0;               MiscB := 0;
  95.     GMPA := 0;                GMPB := 0;
  96.     MPA := 0;                 MPB := 0;
  97.     PSA :=0;                  PSB :=0;
  98.  
  99.  
  100.     for team := sTeamA to sTeamB do
  101.       begin
  102.         PenaltyMemo.Append(GetName(pp, team) + #10'-------------------------------');
  103. //        total := 0;
  104.         for period := Low(TPeriodStr) to High(TPeriodStr) do
  105.           begin
  106. //            PenaltyMemo.Append('    ' + PeriodToStr(period) + #10'    ------------');
  107.             for penaltyKind := Low(TPenaltyKind) to High(TPenaltyKind) do
  108.               begin
  109.                 total := pp.DataArray[team][period][penaltyKind];
  110.                 case penaltyKind of
  111.                   pkMinor: if team = sTeamA then Inc(MinorA,total) else Inc(MinorB,total);
  112.                   pkMajor: if team = sTeamA then Inc(MajorA,total) else Inc(MajorB,total);
  113.                   pkMisc : if team = sTeamA then Inc(MiscA,total) else Inc(MiscB,total);
  114.                   pkGMP  : if team = sTeamA then Inc(GMPA,total) else Inc(GMPB,total);
  115.                   pkMP   : if team = sTeamA then Inc(MPA,total) else Inc(MPB,total);
  116.                   pkPS   : if team = sTeamA then Inc(PSA,total) else Inc(PSB,total);
  117.                 end;  // case TPenaltyKind
  118. //                WriteStr(FlatString, '"',GetName(pp,team),'","', Period,'","', PenaltyKind, '","');
  119.                 WriteStr(FlatString, '    ', GetName(pp,Team),'   ', Period,'   ', PenaltyKind, '   ', pp.DataArray[team][period][penaltyKind]);
  120. //                WriteStr(FlatString, '    ', PenaltyKind, '   ', pp.DataArray[team][period][penaltyKind]);
  121.                 PenaltyMemo.Lines.Add (FlatString);
  122. //               PenaltyMemo.Lines.Add('      %s: %d', [PenaltyKindToStr(penaltyKind), pp.DataArray[team][period][penaltyKind]]);
  123. //                Inc(total, pp.DataArray[team][period][penaltyKind]);
  124.               end;
  125. //            PenaltyMemo.Lines.Add('      total penalties: %d'#10,[total]);
  126.           end;
  127.         PenaltyMemo.Append('');
  128.       end;
  129.     WriteStr(FlatString, '    ', GetName(pp,sTeamA),'   ', MinorA,'   ', MajorA, '   ', MiscA, '   ', GMPA, '   ', MPA, '   ', PSA);
  130.     PenaltyMemo.Lines.Add (FlatString);
  131.     WriteStr(FlatString, '    ', GetName(pp,sTeamB),'   ', MinorB,'   ', MajorB, '   ', MiscB, '   ', GMPB, '   ', MPB, '   ', PSB);
  132.     PenaltyMemo.Lines.Add (FlatString);
  133.   finally
  134.     pp.Free;
  135.   end;
  136.  
  137.  
  138. end;
  139.  
  140.  
  141. procedure TForm_Test.BT_CloseClick(Sender: TObject);
  142. begin
  143.   Close;
  144. end;
  145.  
  146.  
  147. procedure TForm_Test.SelectFileRGSelectionChanged(Sender: TObject);
  148. var s: string;
  149. begin
  150.   s := 'users/madref/documents/referee3 database/' ;
  151.   case SelectFileRG.ItemIndex of
  152.     0: PopulateMemosFromFile(s+'52702.txt');
  153.     1: PopulateMemosFromFile(s+'52677.txt');
  154.     2: PopulateMemosFromFile(s+'55675.txt');
  155.   end;
  156. end;
  157.  
  158.  
  159. end.
  160.  


This is the other unit:
Code: Pascal  [Select][+][-]
  1. unit referee_wedstrijd_sheet;
  2.  
  3.  
  4. {$mode objfpc}{$H+}
  5.  
  6.  
  7. interface
  8.  
  9.  
  10. uses
  11.   Classes, SysUtils, LazUTF8;
  12.  
  13.  
  14. type
  15.   TStr = (sBlank, sTeamA, sTeamB, sPeriode1, sPeriode2, sPeriode3, sPeriode4, sScoring, sPEN, sMin);
  16.   TTeamStr = sTeamA..sTeamB;
  17.   TPeriodStr = sPeriode1..sPeriode4;
  18.   TParseDataStr = sTeamA..sPeriode4;
  19.   TStringsByDataStr = array[TParseDataStr] of String;
  20.   TPenaltyKind = (pkMinor, pkMajor, pkMisc, pkGMP, pkMP, pkPS);
  21.   TPenaltyValues = array[TPenaltyKind] of Integer;
  22.   TPeriodPenValues = array[TPeriodStr] of TPenaltyValues;
  23.   TTeamPeriodPenArray = array[TTeamStr] of TPeriodPenValues;
  24.  
  25.  
  26.   { TWedstrijdSheetParser }
  27.  
  28.  
  29.   TWedstrijdSheetParser = class(TObject)
  30.   private
  31.     FFilename: String;
  32.     FStringsByData: TStringsByDataStr;
  33.     function GetTeamA: String;
  34.     function GetTeamB: String;
  35.     function HasStr(const aLine: String; aStr: TStr; out aPos: Integer): Boolean;
  36.     function ReadFileToArrayOK: Boolean;
  37.   public
  38.     DataArray: TTeamPeriodPenArray;
  39.     constructor Create(const aFilename: String);
  40.     property Filename: String read FFilename;
  41.     property TeamA: String read GetTeamA;
  42.     property TeamB: String read GetTeamB;
  43.   end;
  44.  
  45.  
  46. implementation
  47.  
  48.  
  49. { TWedstrijdSheetParser }
  50.  
  51.  
  52. function TWedstrijdSheetParser.GetTeamA: String;
  53. begin
  54.   Exit(FStringsByData[sTeamA]);
  55. end;
  56.  
  57.  
  58. function TWedstrijdSheetParser.GetTeamB: String;
  59. begin
  60.   Exit(FStringsByData[sTeamB]);
  61. end;
  62.  
  63.  
  64. function TWedstrijdSheetParser.HasStr(const aLine: String; aStr: TStr; out aPos: Integer): Boolean;
  65. begin
  66.   aPos := 0;
  67.   case aLine of
  68.     '': Exit(False);
  69.     else case aStr of
  70.       sBlank:    Exit(False);
  71.       sTeamA:    begin aPos := Pos('Team A:', aLine); Exit(aPos > 0); end;
  72.       sTeamB:    begin aPos := Pos('Team B:', aLine); Exit(aPos > 0); end;
  73.       sPeriode1: begin aPos := Pos('1e periode', aLine); Exit(aPos > 0); end;
  74.       sPeriode2: begin aPos := Pos('2e periode', aLine); Exit(aPos > 0); end;
  75.       sPeriode3: begin aPos := Pos('3e periode', aLine); Exit(aPos > 0); end;
  76.       sPeriode4: begin aPos := Pos('Verlenging', aLine); Exit(aPos > 0); end;
  77.       sScoring:  begin aPos := Pos('Scoring', aLine); Exit(aPos > 0); end;
  78.       sPEN:      begin aPos := Pos(' PEN ', aLine); Exit(aPos > 0); end;
  79.       sMin:      begin aPos := Pos(' min ', aLine); Exit(aPos > 0); end;
  80.     end;
  81.   end;
  82. end;
  83.  
  84.  
  85. function TWedstrijdSheetParser.ReadFileToArrayOK: Boolean;
  86. var
  87.   tf: TextFile;
  88.   tmp: String;
  89.   s: TStr;
  90.   allPeriodsRead: Boolean;
  91.   p: Integer;
  92. begin
  93.   Result := False;
  94.   allPeriodsRead := False;
  95.   {$I-}
  96.   AssignFile(tf, FFilename);
  97.   s := sBlank;
  98.   try
  99.     Reset(tf);
  100.     while not EOF(tf) do
  101.       begin
  102.         ReadLn(tf, tmp);
  103.         UTF8FixBroken(tmp);
  104.         tmp := Trim(tmp);
  105.         if tmp = '' then
  106.           Continue;
  107.  
  108.  
  109.         case s of
  110.           sBlank, sPEN: ;
  111.           sTeamA: begin FStringsByData[sTeamA] := tmp; s := sBlank; end;
  112.           sTeamB: begin FStringsByData[sTeamB] := tmp; s := sBlank; end;
  113.           sPeriode1: case HasStr(tmp, sScoring, p) of
  114.                        True:  begin s := sBlank; Continue; end;
  115.                        False: if HasStr(tmp, sPEN, p) then
  116.                                 FStringsByData[sPeriode1] := FStringsByData[sPeriode1] + Copy(tmp, p+5, Maxint) + ',';
  117.                      end;
  118.           sPeriode2: case HasStr(tmp, sScoring, p) of
  119.                        True:  begin s := sBlank; Continue; end;
  120.                        False: if HasStr(tmp, sPEN, p) then
  121.                                 FStringsByData[sPeriode2] := FStringsByData[sPeriode2] + Copy(tmp, p+5, MaxInt) + ',';
  122.                      end;
  123.           sPeriode3: case HasStr(tmp, sScoring, p) of
  124.                        True:  begin s := sBlank; Continue; end;
  125.                        False: if HasStr(tmp, sPEN, p) then
  126.                                 FStringsByData[sPeriode3] := FStringsByData[sPeriode3] + Copy(tmp, p+5, MaxInt) + ',';
  127.                      end;
  128.           sPeriode4: case HasStr(tmp, sScoring, p) of
  129.                        True:  begin s := sBlank; allPeriodsRead := True; Continue; end;
  130.                        False: if HasStr(tmp, sPEN, p) then
  131.                                 FStringsByData[sPeriode4] := FStringsByData[sPeriode4] + Copy(tmp, p+5, MaxInt) + ',';
  132.                      end;
  133.           sScoring: if allPeriodsRead then
  134.                       Break;
  135.         end;
  136.  
  137.  
  138.         if s = sBlank then
  139.         begin
  140.           if HasStr(tmp, sTeamA, p) then
  141.             s := sTeamA
  142.           else if HasStr(tmp, sTeamB, p) then
  143.             s := sTeamB
  144.           else if HasStr(tmp, sPeriode1, p) then
  145.             s := sPeriode1
  146.           else if HasStr(tmp, sPeriode2, p) then
  147.             s := sPeriode2
  148.           else if HasStr(tmp, sPeriode3, p) then
  149.             s := sPeriode3
  150.           else if HasStr(tmp, sPeriode4, p) then
  151.             s := sPeriode4
  152.           else if HasStr(tmp, sScoring, p) then
  153.             s := sScoring;
  154.           end;
  155.       end; // while not EOF
  156.   finally
  157.     CloseFile(tf);
  158.   end;
  159.   {$I+}
  160.   Result := IOResult = 0;
  161. end;
  162.  
  163.  
  164. constructor TWedstrijdSheetParser.Create(const aFilename: String);
  165. var
  166.   pds: TParseDataStr;
  167.   sl: TStringList;
  168.   teemA, teemB, s: String;
  169.   team: TTeamStr;
  170.   penKind: TPenaltyKind;
  171.  
  172.  
  173.   procedure ParsePenStr(out aTeam: TTeamStr; out aPenKind: TPenaltyKind);
  174.   var
  175.     p: Integer;
  176.     si: String;
  177.   begin
  178.     if Pos(teamA, s) > 0 then
  179.       aTeam := sTeamA
  180.     else if Pos(teamB, s) > 0 then
  181.       aTeam := sTeamB
  182.     else Assert(True,'Error in parsing team name or error in data');
  183.     case HasStr(s, sMin, p) of
  184.       True: begin
  185.               Dec(p);
  186.               si := s[p];
  187.               Dec(p);
  188.               while s[p] in ['0'..'9'] do
  189.                 begin
  190.                   si := s[p] + si;
  191.                   Dec(p);
  192.                 end;
  193.               Assert(TryStrToInt(si, p),'Error in parsing minute value');
  194.               case si of
  195.                 '2':  aPenKind := pkMinor;
  196.                 '5':  aPenKind := pkMajor;
  197.                 '10': aPenKind := pkMisc;
  198.                 '20': aPenKind := pkGMP;
  199.                 '25': aPenKind := pkMP;
  200.                 '50': aPenKind := pkPS;
  201.                 else Assert(True,'Error: "min" has unexpected value "'+si+'"');
  202.               end;
  203.             end;
  204.       False: aPenKind := pkPS;
  205.     end;
  206.   end;
  207.  
  208.  
  209. begin
  210.   Assert(FileExists(aFilename),'TWedstrijdSheetParser.Create: file '+aFilename+' cannot be found');
  211.   FFilename := aFilename;
  212.   Assert(ReadFileToArrayOK,'TWedstrijdSheetParser.Create: failed to create array from '+aFilename);
  213.   teemA := FStringsByData[sTeamA];
  214.   teemB := FStringsByData[sTeamB];
  215.   sl := TStringList.Create;
  216.   sl.StrictDelimiter := True;
  217.  
  218.  
  219.   for pds := Low(TPeriodStr) to High(TPeriodStr) do
  220.     begin
  221.       sl.CommaText := FStringsByData[pds];
  222.       for s in sl do
  223.         if s <> '' then
  224.         begin
  225.           ParsePenStr(team, penKind);
  226.           Inc(DataArray[team][pds][penKind]);
  227.         end;
  228.     end;
  229.   sl.Free;
  230. end;     // Create
  231.  
  232.  
  233. end.
  234.  


Does any1 know why I have 2 different outcomes?
You treat a disease, you win, you lose.
You treat a person and I guarantee you, you win, no matter the outcome.

Lazarus 3.99 (rev main_3_99-649-ge13451a5ab) FPC 3.3.1 x86_64-darwin-cocoa
Mac OS X Monterey

howardpc

  • Hero Member
  • *****
  • Posts: 4144
Re: Different outcome in Lazarus Trunk and in 2.0.2
« Reply #1 on: May 24, 2019, 06:30:32 pm »
You don't supply compilable sources.
However, the attached, slightly simplified, adaptation (of what I think your source GUI and source .txt might be) compiles OK for me with Lazarus 2.0.2 and Lazarus trunk, and parses the data correctly in both cases -- non-zero data shows up along with the (correct) zero data.
Does the unaltered attachment produce correct results for you on Windows (I tested on Linux)?Maybe your data is somehow invalid (malformed utf8)?
« Last Edit: May 24, 2019, 07:00:40 pm by howardpc »

marcov

  • Administrator
  • Hero Member
  • *
  • Posts: 11383
  • FPC developer.
Re: Different outcome in Lazarus Trunk and in 2.0.2
« Reply #2 on: May 24, 2019, 06:34:32 pm »
When testing for correctness, make sure all checks are on!

madref

  • Hero Member
  • *****
  • Posts: 949
  • ..... A day not Laughed is a day wasted !!
    • Nursing With Humour
Re: Different outcome in Lazarus Trunk and in 2.0.2
« Reply #3 on: May 25, 2019, 09:36:36 am »
You don't supply compilable sources.
However, the attached, slightly simplified, adaptation (of what I think your source GUI and source .txt might be) compiles OK for me with Lazarus 2.0.2 and Lazarus trunk, and parses the data correctly in both cases -- non-zero data shows up along with the (correct) zero data.
Does the unaltered attachment produce correct results for you on Windows (I tested on Linux)?Maybe your data is somehow invalid (malformed utf8)?


It now works on Mac OSx as a stand alone project. But implemented in my database project it fails again

Did you modify any of the source code?
« Last Edit: May 25, 2019, 09:58:15 am by madref »
You treat a disease, you win, you lose.
You treat a person and I guarantee you, you win, no matter the outcome.

Lazarus 3.99 (rev main_3_99-649-ge13451a5ab) FPC 3.3.1 x86_64-darwin-cocoa
Mac OS X Monterey

madref

  • Hero Member
  • *****
  • Posts: 949
  • ..... A day not Laughed is a day wasted !!
    • Nursing With Humour
Re: Different outcome in Lazarus Trunk and in 2.0.2
« Reply #4 on: May 25, 2019, 09:37:27 am »
When testing for correctness, make sure all checks are on!
What do you mean exactly with that?

You treat a disease, you win, you lose.
You treat a person and I guarantee you, you win, no matter the outcome.

Lazarus 3.99 (rev main_3_99-649-ge13451a5ab) FPC 3.3.1 x86_64-darwin-cocoa
Mac OS X Monterey

howardpc

  • Hero Member
  • *****
  • Posts: 4144
Re: Different outcome in Lazarus Trunk and in 2.0.2
« Reply #5 on: May 25, 2019, 11:31:29 am »
Did you modify any of the source code?
As I wrote, I adapted the code you showed at the opening of this thread in order to make a compilable project that could be tested.
Mostly this was removing the radiogroup you had which I replaced with a button to feed a single text file to the routine that you say fails for you. I also removed one or two redundant variables and methods, and obviously reconstructed the GUI to be something like what I presume your failing test project looks like. A diff of your project's units against mine will show you the changes in detail.

I presume Marco's comment relates to checking all the relevant checkboxes on the Debugging page under Compiler Options in your project's Options.

marcov

  • Administrator
  • Hero Member
  • *
  • Posts: 11383
  • FPC developer.
Re: Different outcome in Lazarus Trunk and in 2.0.2
« Reply #6 on: May 25, 2019, 03:31:54 pm »
When testing for correctness, make sure all checks are on!
What do you mean exactly with that?

Runtime checks, array indexes etc.  Compile with e.g. -Criot

madref

  • Hero Member
  • *****
  • Posts: 949
  • ..... A day not Laughed is a day wasted !!
    • Nursing With Humour
Re: Different outcome in Lazarus Trunk and in 2.0.2
« Reply #7 on: May 27, 2019, 01:07:34 pm »
i implemented the given source code and set -Criot but still the stand-alone works, but implemented in my database project it fails in truncates
You treat a disease, you win, you lose.
You treat a person and I guarantee you, you win, no matter the outcome.

Lazarus 3.99 (rev main_3_99-649-ge13451a5ab) FPC 3.3.1 x86_64-darwin-cocoa
Mac OS X Monterey

 

TinyPortal © 2005-2018