View Issue Details

IDProjectCategoryView StatusLast Update
0035134FPCFCLpublic2019-02-25 11:28
ReporterAnton KavalenkaAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformx86-64-linuxOSOS Version
Product Version3.3.1Product Build 
Target Version3.2.0Fixed in Version3.3.1 
Summary0035134: fpreadgif: r40995 broke paletted GIF reading
DescriptionAttached slightly modified test from fcl-image/examples/imgconv.pp

Patch attached which reverts r40995 changes.
Assumption that current stream pos is outside of stream is simply wrong, because
stream analysis returns to the previously stored OldPos

Stream.Position:=OldPos;
Steps To Reproducetry to run
./imgconv G image.gif PI image.png
TagsNo tags attached.
Fixed in Revision41409
FPCOldBugId
FPCTarget
Attached Files
  • imgconv.pp (4,939 bytes)
    {
        This file is part of the Free Pascal run time library.
        Copyright (c) 2003 by the Free Pascal development team
    
        Image conversion example.
    
        See the file COPYING.FPC, included in this distribution,
        for details about the copyright.
    
        This program is distributed in the hope that it will be useful,
        but WITHOUT ANY WARRANTY; without even the implied warranty of
        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    
     **********************************************************************}
    {$mode objfpc}{$h+}
    program ImgConv;
    
    {_$define UseFile}
    
    uses FPWriteXPM, FPWritePNG, FPWriteBMP, fpreadgif,
         FPReadXPM, FPReadPNG, FPReadBMP, fpreadjpeg,fpwritejpeg,
         fpreadtga,fpwritetga,fpreadpnm,fpwritepnm, fpreadtiff, fpwritetiff,
         {$ifndef UseFile}classes,{$endif}
         FPImage, sysutils;
    
    var img : TFPMemoryImage;
        reader : TFPCustomImageReader;
        Writer : TFPCustomimageWriter;
        ReadFile, WriteFile, WriteOptions : string;
    
    procedure Init;
    var t : char;
    begin
      if paramcount = 4 then
        begin
        T := upcase (paramstr(1)[1]);
        if T = 'X' then
          Reader := TFPReaderXPM.Create
        else if T = 'B' then
          Reader := TFPReaderBMP.Create
        else if T = 'J' then
          Reader := TFPReaderJPEG.Create
        else if T = 'P' then
          Reader := TFPReaderPNG.Create
        else if T = 'T' then
          Reader := TFPReaderTarga.Create
        else if T = 'F' then
          Reader := TFPReaderTiff.Create
        else if T = 'N' then
          Reader := TFPReaderPNM.Create
        else if T = 'G' then
          Reader := TFPReaderGIF.Create
        else
          begin
          Writeln('Unknown file format : ',T);
          Halt(1);
          end;
        ReadFile := paramstr(2);
        WriteOptions := paramstr(3);
        WriteFile := paramstr(4);
        end
      else
        begin
        Reader := nil;
        ReadFile := paramstr(1);
        WriteOptions := paramstr(2);
        WriteFile := paramstr(3);
        end;
      WriteOptions := uppercase (writeoptions);
      T := WriteOptions[1];
      if T = 'X' then
        Writer := TFPWriterXPM.Create
      else if T = 'B' then
        begin
        Writer := TFPWriterBMP.Create;
        TFPWriterBMP(Writer).BitsPerPixel:=32;
        end
      else if T = 'J' then
        Writer := TFPWriterJPEG.Create
      else if T = 'P' then
        Writer := TFPWriterPNG.Create
      else if T = 'T' then
        Writer := TFPWriterTARGA.Create
      else if T = 'F' then
        Writer := TFPWriterTiff.Create
      else if T = 'N' then
        Writer := TFPWriterPNM.Create
      else
        begin
        Writeln('Unknown file format : ',T);
        Halt(1);
        end;
      img := TFPMemoryImage.Create(0,0);
      img.UsePalette:=false;
    end;
    
    procedure ReadImage;
    {$ifndef UseFile}var str : TStream;{$endif}
    begin
      if assigned (reader) then
        img.LoadFromFile (ReadFile, Reader)
      else
        {$ifdef UseFile}
        img.LoadFromFile (ReadFile);
        {$else}
        if fileexists (ReadFile) then
          begin
          str := TFileStream.create (ReadFile,fmOpenRead);
          try
            img.loadFromStream (str);
          finally
            str.Free;
          end;
          end
        else
          writeln ('File ',readfile,' doesn''t exists!');
        {$endif}
    end;
    
    procedure WriteImage;
    var t : string;
    begin
      t := WriteOptions;
      writeln (' WriteImage, options=',t);
      if (t[1] = 'P') then
        with (Writer as TFPWriterPNG) do
          begin
          Grayscale := pos ('G', t) > 0;
          Indexed := pos ('I', t) > 0;
          WordSized := pos('W', t) > 0;
          UseAlpha := pos ('A', t) > 0;
          writeln ('Grayscale ',Grayscale, ' - Indexed ',Indexed,
                   ' - WordSized ',WordSized,' - UseAlpha ',UseAlpha);
          end
      else if (t[1] = 'X') then
        begin
        if length(t) > 1 then
        with (Writer as TFPWriterXPM) do
          begin
          ColorCharSize := ord(t[2]) - ord('0');
          end;
        end;
      writeln ('Options checked, now writing...');
      img.SaveToFile (WriteFile, Writer);
    end;
    
    procedure Clean;
    begin
      Reader.Free;
      Writer.Free;
      Img.Free;
    end;
    
    begin
      if (paramcount <> 4) and (paramcount <> 3) then
        begin
        writeln ('Give filename to read and to write, preceded by filetype:');
        writeln ('X for XPM, P for PNG, B for BMP, J for JPEG, T for TGA,');
        writeln ('N for PNM (read only), F for TIFF');
        writeln ('example: imgconv X hello.xpm P hello.png');
        writeln ('example: imgconv hello.xpm P hello.png');
        writeln ('Options for');
        writeln ('  PNG :  G : grayscale, A : use alpha, ');
        writeln ('         I : Indexed in palette, W : Word sized.');
        writeln ('  XPM :  Number of chars to use for 1 pixel');
        writeln ('  The color size of an XPM can be set after the X as 1,2,3 or 4');
        writeln ('example: imgconv hello.xpm PIA hello.png');
        writeln ('example: imgconv hello.png X2 hello.xpm');
        end
      else
        try
          writeln ('Initing');
          Init;
          writeln ('Reading image');
          ReadImage;
          writeln ('Writing image');
          WriteImage;
          writeln ('Clean up');
          Clean;
        except
          on e : exception do
            writeln ('Error: ',e.message);
        end;
    end.
    
    imgconv.pp (4,939 bytes)
  • image.gif (37,962 bytes)
    image.gif (37,962 bytes)
  • fpreadgif.diff (851 bytes)
    --- /projects/fpc/packages/fcl-image/src/fpreadgif.pas	2019-01-22 18:17:21.365970632 +0300
    +++ /projects/fpc/packages/fcl-image/examples/fpreadgif.pas	2019-02-21 22:51:32.222374995 +0300
    @@ -303,8 +303,8 @@
           end;
         until (B = 0)  or (Stream.Position>=Stream.Size);
         
    -    if Stream.Position>=Stream.Size then 
    -      Exit(False);
    +   { if Stream.Position>=Stream.Size then 
    +      Exit(False); }
     
         Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),
                  False, Rect(0,0,0,0), '', ContProgress);
    @@ -323,8 +323,8 @@
           end;
         until (B = 0) or (Stream.Position>=Stream.Size);
         
    -    if Stream.Position>=Stream.Size then
    -       Exit(False);
    +   { if Stream.Position>=Stream.Size then
    +       Exit(False); }
                   
     
         Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),
    
    fpreadgif.diff (851 bytes)

Relationships

related to 0034919 resolvedMarco van de Voort Gif reader in FPC hangs when trying to read the attached gif file 

Activities

Anton Kavalenka

2019-02-21 21:02

reporter  

imgconv.pp (4,939 bytes)
{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2003 by the Free Pascal development team

    Image conversion example.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
{$mode objfpc}{$h+}
program ImgConv;

{_$define UseFile}

uses FPWriteXPM, FPWritePNG, FPWriteBMP, fpreadgif,
     FPReadXPM, FPReadPNG, FPReadBMP, fpreadjpeg,fpwritejpeg,
     fpreadtga,fpwritetga,fpreadpnm,fpwritepnm, fpreadtiff, fpwritetiff,
     {$ifndef UseFile}classes,{$endif}
     FPImage, sysutils;

var img : TFPMemoryImage;
    reader : TFPCustomImageReader;
    Writer : TFPCustomimageWriter;
    ReadFile, WriteFile, WriteOptions : string;

procedure Init;
var t : char;
begin
  if paramcount = 4 then
    begin
    T := upcase (paramstr(1)[1]);
    if T = 'X' then
      Reader := TFPReaderXPM.Create
    else if T = 'B' then
      Reader := TFPReaderBMP.Create
    else if T = 'J' then
      Reader := TFPReaderJPEG.Create
    else if T = 'P' then
      Reader := TFPReaderPNG.Create
    else if T = 'T' then
      Reader := TFPReaderTarga.Create
    else if T = 'F' then
      Reader := TFPReaderTiff.Create
    else if T = 'N' then
      Reader := TFPReaderPNM.Create
    else if T = 'G' then
      Reader := TFPReaderGIF.Create
    else
      begin
      Writeln('Unknown file format : ',T);
      Halt(1);
      end;
    ReadFile := paramstr(2);
    WriteOptions := paramstr(3);
    WriteFile := paramstr(4);
    end
  else
    begin
    Reader := nil;
    ReadFile := paramstr(1);
    WriteOptions := paramstr(2);
    WriteFile := paramstr(3);
    end;
  WriteOptions := uppercase (writeoptions);
  T := WriteOptions[1];
  if T = 'X' then
    Writer := TFPWriterXPM.Create
  else if T = 'B' then
    begin
    Writer := TFPWriterBMP.Create;
    TFPWriterBMP(Writer).BitsPerPixel:=32;
    end
  else if T = 'J' then
    Writer := TFPWriterJPEG.Create
  else if T = 'P' then
    Writer := TFPWriterPNG.Create
  else if T = 'T' then
    Writer := TFPWriterTARGA.Create
  else if T = 'F' then
    Writer := TFPWriterTiff.Create
  else if T = 'N' then
    Writer := TFPWriterPNM.Create
  else
    begin
    Writeln('Unknown file format : ',T);
    Halt(1);
    end;
  img := TFPMemoryImage.Create(0,0);
  img.UsePalette:=false;
end;

procedure ReadImage;
{$ifndef UseFile}var str : TStream;{$endif}
begin
  if assigned (reader) then
    img.LoadFromFile (ReadFile, Reader)
  else
    {$ifdef UseFile}
    img.LoadFromFile (ReadFile);
    {$else}
    if fileexists (ReadFile) then
      begin
      str := TFileStream.create (ReadFile,fmOpenRead);
      try
        img.loadFromStream (str);
      finally
        str.Free;
      end;
      end
    else
      writeln ('File ',readfile,' doesn''t exists!');
    {$endif}
end;

procedure WriteImage;
var t : string;
begin
  t := WriteOptions;
  writeln (' WriteImage, options=',t);
  if (t[1] = 'P') then
    with (Writer as TFPWriterPNG) do
      begin
      Grayscale := pos ('G', t) > 0;
      Indexed := pos ('I', t) > 0;
      WordSized := pos('W', t) > 0;
      UseAlpha := pos ('A', t) > 0;
      writeln ('Grayscale ',Grayscale, ' - Indexed ',Indexed,
               ' - WordSized ',WordSized,' - UseAlpha ',UseAlpha);
      end
  else if (t[1] = 'X') then
    begin
    if length(t) > 1 then
    with (Writer as TFPWriterXPM) do
      begin
      ColorCharSize := ord(t[2]) - ord('0');
      end;
    end;
  writeln ('Options checked, now writing...');
  img.SaveToFile (WriteFile, Writer);
end;

procedure Clean;
begin
  Reader.Free;
  Writer.Free;
  Img.Free;
end;

begin
  if (paramcount <> 4) and (paramcount <> 3) then
    begin
    writeln ('Give filename to read and to write, preceded by filetype:');
    writeln ('X for XPM, P for PNG, B for BMP, J for JPEG, T for TGA,');
    writeln ('N for PNM (read only), F for TIFF');
    writeln ('example: imgconv X hello.xpm P hello.png');
    writeln ('example: imgconv hello.xpm P hello.png');
    writeln ('Options for');
    writeln ('  PNG :  G : grayscale, A : use alpha, ');
    writeln ('         I : Indexed in palette, W : Word sized.');
    writeln ('  XPM :  Number of chars to use for 1 pixel');
    writeln ('  The color size of an XPM can be set after the X as 1,2,3 or 4');
    writeln ('example: imgconv hello.xpm PIA hello.png');
    writeln ('example: imgconv hello.png X2 hello.xpm');
    end
  else
    try
      writeln ('Initing');
      Init;
      writeln ('Reading image');
      ReadImage;
      writeln ('Writing image');
      WriteImage;
      writeln ('Clean up');
      Clean;
    except
      on e : exception do
        writeln ('Error: ',e.message);
    end;
end.
imgconv.pp (4,939 bytes)

Anton Kavalenka

2019-02-21 21:02

reporter  

image.gif (37,962 bytes)
image.gif (37,962 bytes)

Anton Kavalenka

2019-02-21 21:03

reporter  

fpreadgif.diff (851 bytes)
--- /projects/fpc/packages/fcl-image/src/fpreadgif.pas	2019-01-22 18:17:21.365970632 +0300
+++ /projects/fpc/packages/fcl-image/examples/fpreadgif.pas	2019-02-21 22:51:32.222374995 +0300
@@ -303,8 +303,8 @@
       end;
     until (B = 0)  or (Stream.Position>=Stream.Size);
     
-    if Stream.Position>=Stream.Size then 
-      Exit(False);
+   { if Stream.Position>=Stream.Size then 
+      Exit(False); }
 
     Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),
              False, Rect(0,0,0,0), '', ContProgress);
@@ -323,8 +323,8 @@
       end;
     until (B = 0) or (Stream.Position>=Stream.Size);
     
-    if Stream.Position>=Stream.Size then
-       Exit(False);
+   { if Stream.Position>=Stream.Size then
+       Exit(False); }
               
 
     Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),
fpreadgif.diff (851 bytes)

Michael Van Canneyt

2019-02-22 09:04

administrator   ~0114345

Applied, tested (on original problem as well) and committed. Thanks for the patch!

Issue History

Date Modified Username Field Change
2019-02-21 21:02 Anton Kavalenka New Issue
2019-02-21 21:02 Anton Kavalenka File Added: imgconv.pp
2019-02-21 21:02 Anton Kavalenka File Added: image.gif
2019-02-21 21:03 Anton Kavalenka File Added: fpreadgif.diff
2019-02-21 21:07 Marco van de Voort Relationship added related to 0034919
2019-02-22 09:04 Michael Van Canneyt Assigned To => Michael Van Canneyt
2019-02-22 09:04 Michael Van Canneyt Status new => assigned
2019-02-22 09:04 Michael Van Canneyt Fixed in Revision => 41409
2019-02-22 09:04 Michael Van Canneyt Note Added: 0114345
2019-02-22 09:04 Michael Van Canneyt Status assigned => resolved
2019-02-22 09:04 Michael Van Canneyt Fixed in Version => 3.3.1
2019-02-22 09:04 Michael Van Canneyt Resolution open => fixed
2019-02-22 09:04 Michael Van Canneyt Target Version => 3.2.0
2019-02-25 11:28 Anton Kavalenka Status resolved => closed