Browse Source

Merge branch source:main into main

Massimo Magnano 2 years ago
parent
commit
868f58b225

+ 8 - 4
packages/fcl-image/fpmake.pp

@@ -28,7 +28,7 @@ begin
     P.Email := '';
     P.Email := '';
     P.Description := 'Image loading and conversion parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.Description := 'Image loading and conversion parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;
     P.NeedLibC:= false;
-    P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc,sinclairql,wasi];
+    P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc,sinclairql];
     if Defaults.CPU=jvm then
     if Defaults.CPU=jvm then
       P.OSes := P.OSes - [java,android];
       P.OSes := P.OSes - [java,android];
 
 
@@ -128,10 +128,12 @@ begin
           AddUnit('fpimage');
           AddUnit('fpimage');
           AddUnit('bmpcomn');
           AddUnit('bmpcomn');
         end;
         end;
+    T:=P.Targets.AddUnit('jpegcomn.pas');    
     T:=P.Targets.AddUnit('fpreadjpeg.pas');
     T:=P.Targets.AddUnit('fpreadjpeg.pas');
       with T.Dependencies do
       with T.Dependencies do
         begin
         begin
           AddUnit('fpimage');
           AddUnit('fpimage');
+          Addunit('jpegcomn');
         end;
         end;
     T:=P.Targets.AddUnit('fpreadpcx.pas');
     T:=P.Targets.AddUnit('fpreadpcx.pas');
       with T.Dependencies do
       with T.Dependencies do
@@ -195,7 +197,7 @@ begin
       with T.Dependencies do
       with T.Dependencies do
         begin
         begin
           AddUnit('fpimage');
           AddUnit('fpimage');
-          AddUnit('fpreadjpeg');
+          AddUnit('jpegcomn');
         end;
         end;
     T:=P.Targets.AddUnit('fpwritepcx.pas');
     T:=P.Targets.AddUnit('fpwritepcx.pas');
       with T.Dependencies do
       with T.Dependencies do
@@ -233,10 +235,12 @@ begin
           AddUnit('fpimage');
           AddUnit('fpimage');
         end;
         end;
     T:=P.Targets.AddUnit('freetypeh.pp',[solaris,iphonesim,ios,darwin,freebsd,openbsd,netbsd,linux,haiku,beos,win32,win64,aix,dragonfly]);
     T:=P.Targets.AddUnit('freetypeh.pp',[solaris,iphonesim,ios,darwin,freebsd,openbsd,netbsd,linux,haiku,beos,win32,win64,aix,dragonfly]);
-    T.Dependencies.AddInclude('libfreetype.inc');
+      T.CPUS:=T.CPUS-[wasm32];
+      T.Dependencies.AddInclude('libfreetype.inc');
     T:=P.Targets.AddUnit('freetypehdyn.pp',[solaris,iphonesim,ios,darwin,freebsd,openbsd,netbsd,linux,haiku,beos,win32,win64,aix,dragonfly]);
     T:=P.Targets.AddUnit('freetypehdyn.pp',[solaris,iphonesim,ios,darwin,freebsd,openbsd,netbsd,linux,haiku,beos,win32,win64,aix,dragonfly]);
       T.ResourceStrings:=true;
       T.ResourceStrings:=true;
-    T.Dependencies.AddInclude('libfreetype.inc');
+      T.CPUS:=T.CPUS-[wasm32];
+      T.Dependencies.AddInclude('libfreetype.inc');
     T:=P.Targets.AddUnit('freetype.pp',[solaris,iphonesim,ios,darwin,freebsd,openbsd,netbsd,linux,haiku,beos,win32,win64,aix,dragonfly]);
     T:=P.Targets.AddUnit('freetype.pp',[solaris,iphonesim,ios,darwin,freebsd,openbsd,netbsd,linux,haiku,beos,win32,win64,aix,dragonfly]);
       with T.Dependencies do
       with T.Dependencies do
         begin
         begin

+ 3 - 0
packages/fcl-passrc/src/pasresolver.pp

@@ -10325,6 +10325,9 @@ begin
     FindData.Found:=DeclEl;
     FindData.Found:=DeclEl;
     end;
     end;
 
 
+  if (DeclEl is TPasVariable) and El.HasParent(DeclEl) then
+    RaiseIdentifierNotFound(20230712105546,aName,El);
+
   Ref:=CreateReference(DeclEl,El,Access,@FindData);
   Ref:=CreateReference(DeclEl,El,Access,@FindData);
   CheckFoundElement(FindData,Ref);
   CheckFoundElement(FindData,Ref);
 
 

+ 10 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -205,6 +205,7 @@ type
     Procedure TestVarInitConst;
     Procedure TestVarInitConst;
     Procedure TestVarOfVarFail;
     Procedure TestVarOfVarFail;
     Procedure TestConstOfVarFail;
     Procedure TestConstOfVarFail;
+    Procedure TestConstSelfFail;
     Procedure TestTypedConstWrongExprFail;
     Procedure TestTypedConstWrongExprFail;
     Procedure TestVarWrongExprFail;
     Procedure TestVarWrongExprFail;
     Procedure TestArgWrongExprFail;
     Procedure TestArgWrongExprFail;
@@ -2928,6 +2929,15 @@ begin
   CheckParserException('Expected type, but got variable',PParser.nParserExpectedTypeButGot);
   CheckParserException('Expected type, but got variable',PParser.nParserExpectedTypeButGot);
 end;
 end;
 
 
+procedure TTestResolver.TestConstSelfFail;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  a = a;');
+  Add('begin');
+  CheckResolverException('identifier not found "a"',nIdentifierNotFound);
+end;
+
 procedure TTestResolver.TestTypedConstWrongExprFail;
 procedure TTestResolver.TestTypedConstWrongExprFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);

+ 1 - 1
packages/fcl-pdf/fpmake.pp

@@ -24,7 +24,7 @@ begin
     P.Email := '';
     P.Email := '';
     P.Description := 'PDF generating and TTF file info library';
     P.Description := 'PDF generating and TTF file info library';
     P.NeedLibC:= false;
     P.NeedLibC:= false;
-    P.OSes:=P.OSes-[embedded,win16,msdos,nativent,macosclassic,palmos,zxspectrum,msxdos,amstradcpc,sinclairql,wasi];
+    P.OSes:=P.OSes-[embedded,win16,msdos,nativent,macosclassic,palmos,zxspectrum,msxdos,amstradcpc,sinclairql];
     if Defaults.CPU=jvm then
     if Defaults.CPU=jvm then
       P.OSes := P.OSes - [java,android];
       P.OSes := P.OSes - [java,android];
 
 

+ 1 - 1
packages/pasjpeg/fpmake.pp

@@ -19,7 +19,7 @@ begin
     P.Directory:=ADirectory;
     P.Directory:=ADirectory;
 {$endif ALLPACKAGES}
 {$endif ALLPACKAGES}
     P.Version:='3.3.1';
     P.Version:='3.3.1';
-    P.OSes:=P.OSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc,sinclairql,wasi];
+    P.OSes:=P.OSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc,sinclairql];
     if Defaults.CPU=jvm then
     if Defaults.CPU=jvm then
       P.OSes := P.OSes - [java,android];
       P.OSes := P.OSes - [java,android];
 
 

+ 3 - 0
packages/pasjpeg/src/jconfig.inc

@@ -1,3 +1,6 @@
+{$IFDEF CPUWASM}
+{$DEFINE NOGOTO}
+{$ENDIF}
 { ----------------------- JPEG_INTERNAL_OPTIONS ---------------------- }
 { ----------------------- JPEG_INTERNAL_OPTIONS ---------------------- }
 
 
 
 

+ 153 - 97
packages/pasjpeg/src/jdhuff.pas

@@ -559,8 +559,11 @@ function jpeg_fill_bit_buffer (var state : bitread_working_state;
                               {register} get_buffer : bit_buf_type;
                               {register} get_buffer : bit_buf_type;
                               {register} bits_left : int;
                               {register} bits_left : int;
                               nbits  : int) : boolean;
                               nbits  : int) : boolean;
+{$IFNDEF NOGOTO}
 label
 label
   no_more_bytes;
   no_more_bytes;
+{$ENDIF}
+
 { Load up the bit buffer to a depth of at least nbits }
 { Load up the bit buffer to a depth of at least nbits }
 var
 var
   { Copy heavily used state fields into locals (hopefully registers) }
   { Copy heavily used state fields into locals (hopefully registers) }
@@ -570,6 +573,43 @@ var
   {register} c : int;
   {register} c : int;
 var
 var
   cinfo : j_decompress_ptr;
   cinfo : j_decompress_ptr;
+
+
+  Procedure DoNomoreBytes;
+
+  begin
+    { We get here if we've read the marker that terminates the compressed
+      data segment.  There should be enough bits in the buffer register
+      to satisfy the request; if so, no problem. }
+
+    if (nbits <= bits_left) then
+      exit;
+    { Uh-oh.  Report corrupted data to user and stuff zeroes into
+      the data stream, so that we can produce some kind of image.
+      We use a nonvolatile flag to ensure that only one warning message
+      appears per data segment. }
+
+    if not cinfo^.entropy^.insufficient_data then
+    begin
+      WARNMS(j_common_ptr(cinfo), JWRN_HIT_MARKER);
+      cinfo^.entropy^.insufficient_data := TRUE;
+    end;
+    { Fill the buffer with zero bits }
+    get_buffer := get_buffer shl (MIN_GET_BITS - bits_left);
+    bits_left := MIN_GET_BITS;
+  end;
+
+  Procedure PrepareExit;
+  begin
+    { Unload the local registers }
+    state.next_input_byte := next_input_byte;
+    state.bytes_in_buffer := bytes_in_buffer;
+    state.get_buffer := get_buffer;
+    state.bits_left := bits_left;
+
+    jpeg_fill_bit_buffer := TRUE;
+  end;
+
 begin
 begin
   next_input_byte := state.next_input_byte;
   next_input_byte := state.next_input_byte;
   bytes_in_buffer := state.bytes_in_buffer;
   bytes_in_buffer := state.bytes_in_buffer;
@@ -640,7 +680,13 @@ begin
 
 
           cinfo^.unread_marker := c;
           cinfo^.unread_marker := c;
           { See if we need to insert some fake zero bits. }
           { See if we need to insert some fake zero bits. }
-          goto no_more_bytes;
+          {$IFDEF NOGOTO}
+            DoNomoreBytes;
+            PrepareExit;
+            exit;
+          {$ELSE}
+            goto no_more_bytes;
+          {$ENDIF}
         end;
         end;
       end;
       end;
 
 
@@ -651,36 +697,13 @@ begin
   end
   end
   else
   else
   begin
   begin
+{$IFNDEF NOGOTO}
   no_more_bytes:
   no_more_bytes:
-    { We get here if we've read the marker that terminates the compressed
-      data segment.  There should be enough bits in the buffer register
-      to satisfy the request; if so, no problem. }
-
-    if (nbits > bits_left) then
-    begin
-      { Uh-oh.  Report corrupted data to user and stuff zeroes into
-        the data stream, so that we can produce some kind of image.
-        We use a nonvolatile flag to ensure that only one warning message
-        appears per data segment. }
-
-      if not cinfo^.entropy^.insufficient_data then
-      begin
-        WARNMS(j_common_ptr(cinfo), JWRN_HIT_MARKER);
-        cinfo^.entropy^.insufficient_data := TRUE;
-      end;
-      { Fill the buffer with zero bits }
-      get_buffer := get_buffer shl (MIN_GET_BITS - bits_left);
-      bits_left := MIN_GET_BITS;
-    end;
+{$ENDIF}
+    DoNomoreBytes;
   end;
   end;
 
 
-  { Unload the local registers }
-  state.next_input_byte := next_input_byte;
-  state.bytes_in_buffer := bytes_in_buffer;
-  state.get_buffer := get_buffer;
-  state.bits_left := bits_left;
-
-  jpeg_fill_bit_buffer := TRUE;
+  prepareExit;
 end;
 end;
 
 
 
 
@@ -848,8 +871,10 @@ end;
 {METHODDEF}
 {METHODDEF}
 function decode_mcu (cinfo : j_decompress_ptr;
 function decode_mcu (cinfo : j_decompress_ptr;
                      var MCU_data : array of JBLOCKROW) : boolean; far;
                      var MCU_data : array of JBLOCKROW) : boolean; far;
+{$IFNDEF NOGOTO}
 label
 label
   label1, label2, label3;
   label1, label2, label3;
+{$ENDIF}
 var
 var
   entropy : huff_entropy_ptr;
   entropy : huff_entropy_ptr;
   {register} s, k, r : int;
   {register} s, k, r : int;
@@ -863,8 +888,26 @@ var
   state : savable_state;
   state : savable_state;
   dctbl : d_derived_tbl_ptr;
   dctbl : d_derived_tbl_ptr;
   actbl : d_derived_tbl_ptr;
   actbl : d_derived_tbl_ptr;
+  skiptolabel1,skiptolabel2,skiptolabel3 : Boolean;
+
 var
 var
   nb, look : int; {register}
   nb, look : int; {register}
+
+  // Return true if we assign a result and must exit decode_mcu
+  function DoDecode(aTable : d_derived_tbl_ptr) : Boolean;
+
+  begin
+    s := jpeg_huff_decode(br_state,get_buffer,bits_left,aTable,nb);
+    if (s < 0) then
+    begin
+      decode_mcu := FALSE;
+      exit(true);
+    end;
+    get_buffer := br_state.get_buffer;
+    bits_left := br_state.bits_left;
+    DoDecode:=False;
+  end;
+
 begin
 begin
   entropy := huff_entropy_ptr (cinfo^.entropy);
   entropy := huff_entropy_ptr (cinfo^.entropy);
 
 
@@ -904,8 +947,8 @@ begin
       dctbl := entropy^.dc_cur_tbls[blkn];
       dctbl := entropy^.dc_cur_tbls[blkn];
       actbl := entropy^.ac_cur_tbls[blkn];
       actbl := entropy^.ac_cur_tbls[blkn];
 
 
+      SkipToLabel1:=False;
       { Decode a single block's worth of coefficients }
       { Decode a single block's worth of coefficients }
-
       { Section F.2.2.1: decode the DC coefficient difference }
       { Section F.2.2.1: decode the DC coefficient difference }
       {HUFF_DECODE(s, br_state, dctbl, return FALSE, label1);}
       {HUFF_DECODE(s, br_state, dctbl, return FALSE, label1);}
       if (bits_left < HUFF_LOOKAHEAD) then
       if (bits_left < HUFF_LOOKAHEAD) then
@@ -920,35 +963,38 @@ begin
         if (bits_left < HUFF_LOOKAHEAD) then
         if (bits_left < HUFF_LOOKAHEAD) then
         begin
         begin
           nb := 1;
           nb := 1;
+          {$IFDEF NOGOTO}
+          if DoDecode(dctbl) then
+            exit;
+          SkipToLabel1:=True;
+          {$ELSE}
           goto label1;
           goto label1;
+          {$ENDIF}
         end;
         end;
       end;
       end;
-      {look := PEEK_BITS(HUFF_LOOKAHEAD);}
-      look := int(get_buffer shr (bits_left -  HUFF_LOOKAHEAD)) and
-                   pred(1 shl HUFF_LOOKAHEAD);
+      if not SkipToLabel1 then
+        begin
+          {look := PEEK_BITS(HUFF_LOOKAHEAD);}
+          look := int(get_buffer shr (bits_left -  HUFF_LOOKAHEAD)) and
+                       pred(1 shl HUFF_LOOKAHEAD);
 
 
-      nb := dctbl^.look_nbits[look];
-      if (nb <> 0) then
-      begin
-        {DROP_BITS(nb);}
-        Dec(bits_left, nb);
+          nb := dctbl^.look_nbits[look];
+          if (nb <> 0) then
+          begin
+            {DROP_BITS(nb);}
+            Dec(bits_left, nb);
 
 
-        s := dctbl^.look_sym[look];
-      end
-      else
-      begin
-        nb := HUFF_LOOKAHEAD+1;
-    label1:
-        s := jpeg_huff_decode(br_state,get_buffer,bits_left,dctbl,nb);
-        if (s < 0) then
-        begin
-          decode_mcu := FALSE;
-          exit;
+            s := dctbl^.look_sym[look];
+          end
+          else
+          begin
+            nb := HUFF_LOOKAHEAD+1;
+            {$IFNDEF NOGOTO}
+            label1:
+            {$ENDIF}
+            if DoDecode(dctbl) then exit;
+          end;
         end;
         end;
-        get_buffer := br_state.get_buffer;
-        bits_left := br_state.bits_left;
-      end;
-
       if (s <> 0) then
       if (s <> 0) then
       begin
       begin
         {CHECK_BIT_BUFFER(br_state, s, return FALSE);}
         {CHECK_BIT_BUFFER(br_state, s, return FALSE);}
@@ -993,6 +1039,7 @@ begin
         while (k < DCTSIZE2) do         { Nomssi: k is incr. in the loop }
         while (k < DCTSIZE2) do         { Nomssi: k is incr. in the loop }
         begin
         begin
           {HUFF_DECODE(s, br_state, actbl, return FALSE, label2);}
           {HUFF_DECODE(s, br_state, actbl, return FALSE, label2);}
+          skiptolabel2:=False;
           if (bits_left < HUFF_LOOKAHEAD) then
           if (bits_left < HUFF_LOOKAHEAD) then
           begin
           begin
             if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then
             if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then
@@ -1005,35 +1052,39 @@ begin
             if (bits_left < HUFF_LOOKAHEAD) then
             if (bits_left < HUFF_LOOKAHEAD) then
             begin
             begin
               nb := 1;
               nb := 1;
+              {$IFDEF NOGOTO}
+              if DoDecode(actbl) then
+                exit;
+              skiptolabel2:=True;
+              {$ELSE}
               goto label2;
               goto label2;
+              {$ENDIF}
             end;
             end;
           end;
           end;
           {look := PEEK_BITS(HUFF_LOOKAHEAD);}
           {look := PEEK_BITS(HUFF_LOOKAHEAD);}
-          look := int(get_buffer shr (bits_left -  HUFF_LOOKAHEAD)) and
-                       pred(1 shl HUFF_LOOKAHEAD);
+          if not SkipToLabel2 then
+            begin
+              look := int(get_buffer shr (bits_left -  HUFF_LOOKAHEAD)) and
+                           pred(1 shl HUFF_LOOKAHEAD);
 
 
-          nb := actbl^.look_nbits[look];
-          if (nb <> 0) then
-          begin
-            {DROP_BITS(nb);}
-            Dec(bits_left, nb);
+              nb := actbl^.look_nbits[look];
+              if (nb <> 0) then
+              begin
+                {DROP_BITS(nb);}
+                Dec(bits_left, nb);
 
 
-            s := actbl^.look_sym[look];
-          end
-          else
-          begin
-            nb := HUFF_LOOKAHEAD+1;
-        label2:
-            s := jpeg_huff_decode(br_state,get_buffer,bits_left,actbl,nb);
-            if (s < 0) then
-            begin
-              decode_mcu := FALSE;
-              exit;
+                s := actbl^.look_sym[look];
+              end
+              else
+              begin
+                nb := HUFF_LOOKAHEAD+1;
+                {$IFNDEF NOGOTO}
+                label2:
+                {$ENDIF}
+                if DoDecode(actbl) then
+                  exit;
+              end;
             end;
             end;
-            get_buffer := br_state.get_buffer;
-            bits_left := br_state.bits_left;
-          end;
-
           r := s shr 4;
           r := s shr 4;
           s := s and 15;
           s := s and 15;
 
 
@@ -1084,6 +1135,7 @@ begin
         k := 1;
         k := 1;
         while (k < DCTSIZE2) do
         while (k < DCTSIZE2) do
         begin
         begin
+          SkipToLabel3:=False;
           {HUFF_DECODE(s, br_state, actbl, return FALSE, label3);}
           {HUFF_DECODE(s, br_state, actbl, return FALSE, label3);}
           if (bits_left < HUFF_LOOKAHEAD) then
           if (bits_left < HUFF_LOOKAHEAD) then
           begin
           begin
@@ -1097,35 +1149,39 @@ begin
             if (bits_left < HUFF_LOOKAHEAD) then
             if (bits_left < HUFF_LOOKAHEAD) then
             begin
             begin
               nb := 1;
               nb := 1;
+              {$IFDEF NOGOTO}
+              if DoDecode(actbl) then
+                exit;
+              SkipToLabel3:=True;
+              {$ELSE}
               goto label3;
               goto label3;
+              {$ENDIF}
             end;
             end;
           end;
           end;
-          {look := PEEK_BITS(HUFF_LOOKAHEAD);}
-          look := int(get_buffer shr (bits_left -  HUFF_LOOKAHEAD)) and
-                       pred(1 shl HUFF_LOOKAHEAD);
+          if not SkipToLabel3 then
+            begin
+              {look := PEEK_BITS(HUFF_LOOKAHEAD);}
+              look := int(get_buffer shr (bits_left -  HUFF_LOOKAHEAD)) and
+                           pred(1 shl HUFF_LOOKAHEAD);
 
 
-          nb := actbl^.look_nbits[look];
-          if (nb <> 0) then
-          begin
-            {DROP_BITS(nb);}
-            Dec(bits_left, nb);
+              nb := actbl^.look_nbits[look];
+              if (nb <> 0) then
+              begin
+                {DROP_BITS(nb);}
+                Dec(bits_left, nb);
 
 
-            s := actbl^.look_sym[look];
-          end
-          else
-          begin
-            nb := HUFF_LOOKAHEAD+1;
-        label3:
-            s := jpeg_huff_decode(br_state,get_buffer,bits_left,actbl,nb);
-            if (s < 0) then
-            begin
-              decode_mcu := FALSE;
-              exit;
-            end;
-            get_buffer := br_state.get_buffer;
-            bits_left := br_state.bits_left;
-          end;
+                s := actbl^.look_sym[look];
+              end
+              else
+              begin
+                nb := HUFF_LOOKAHEAD+1;
+                {$IFNDEF NOGOTO}
+                label3:
+                {$ENDIF}
+                if DoDecode(actbl) then exit;
 
 
+              end;
+            end;
           r := s shr 4;
           r := s shr 4;
           s := s and 15;
           s := s and 15;
 
 

+ 21 - 2
packages/pasjpeg/src/jdmarker.pas

@@ -537,17 +537,23 @@ end;  { get_sof }
 {LOCAL}
 {LOCAL}
 function get_sos (cinfo : j_decompress_ptr) : boolean;
 function get_sos (cinfo : j_decompress_ptr) : boolean;
 { Process a SOS marker }
 { Process a SOS marker }
+{$IFNDEF NOGOTO}
 label
 label
   id_found;
   id_found;
+{$ENDIF}
+
 var
 var
   length : INT32;
   length : INT32;
   i, ci, n, c, cc : int;
   i, ci, n, c, cc : int;
   compptr : jpeg_component_info_ptr;
   compptr : jpeg_component_info_ptr;
+  foundid : boolean;
+
 { Declare and initialize local copies of input pointer/count }
 { Declare and initialize local copies of input pointer/count }
 var
 var
   datasrc : jpeg_source_mgr_ptr;
   datasrc : jpeg_source_mgr_ptr;
   next_input_byte : JOCTETptr;    { Array[] of JOCTET; }
   next_input_byte : JOCTETptr;    { Array[] of JOCTET; }
   bytes_in_buffer : size_t;
   bytes_in_buffer : size_t;
+
 begin
 begin
   datasrc := cinfo^.src;
   datasrc := cinfo^.src;
   next_input_byte := datasrc^.next_input_byte;
   next_input_byte := datasrc^.next_input_byte;
@@ -674,16 +680,29 @@ begin
     Inc(next_input_byte);
     Inc(next_input_byte);
 
 
     compptr := jpeg_component_info_ptr(cinfo^.comp_info);
     compptr := jpeg_component_info_ptr(cinfo^.comp_info);
+
+    FoundID:=False;
+
     for ci := 0 to Pred(cinfo^.num_components) do
     for ci := 0 to Pred(cinfo^.num_components) do
     begin
     begin
-      if (cc = compptr^.component_id) then
+      FoundID:=(cc = compptr^.component_id);
+      if FoundID then
+        begin
+      {$IFDEF NOGOTO}
+        Break;
+      {$ELSE}
         goto id_found;
         goto id_found;
+      {$ENDIF}
+        end;
       Inc(compptr);
       Inc(compptr);
     end;
     end;
 
 
-    ERREXIT1(j_common_ptr(cinfo), JERR_BAD_COMPONENT_ID, cc);
+    if not FoundID then
+      ERREXIT1(j_common_ptr(cinfo), JERR_BAD_COMPONENT_ID, cc);
 
 
+  {$IFNDEF NOGOTO}
   id_found:
   id_found:
+  {$ENDIF}
 
 
     cinfo^.cur_comp_info[i] := compptr;
     cinfo^.cur_comp_info[i] := compptr;
     compptr^.dc_tbl_no := (c shr 4) and 15;
     compptr^.dc_tbl_no := (c shr 4) and 15;

+ 153 - 45
packages/pasjpeg/src/jdphuff.pas

@@ -308,9 +308,12 @@ end;
 
 
 {METHODDEF}
 {METHODDEF}
 function decode_mcu_DC_first (cinfo : j_decompress_ptr;
 function decode_mcu_DC_first (cinfo : j_decompress_ptr;
-                              var MCU_data : array of JBLOCKROW) : boolean;
+                               var MCU_data : array of JBLOCKROW) : boolean;
+{$IFNDEF NOGOTO}
 label
 label
   label1;
   label1;
+{$ENDIF}
+
 var
 var
   entropy : phuff_entropy_ptr;
   entropy : phuff_entropy_ptr;
   Al : int;
   Al : int;
@@ -327,6 +330,23 @@ var
   compptr : jpeg_component_info_ptr;
   compptr : jpeg_component_info_ptr;
 var
 var
   nb, look : int; {register}
   nb, look : int; {register}
+  skiptolabel1 : boolean;
+
+  // Return true if we assign a result do decode_mcu_dc_first  and need to exit
+  function DoDecode : Boolean;
+
+  begin
+    s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb);
+    if (s < 0) then
+    begin
+      decode_mcu_DC_first := FALSE;
+      exit(true);
+    end;
+    get_buffer := br_state.get_buffer;
+    bits_left := br_state.bits_left;
+    DoDecode:=False;
+  end;
+
 begin
 begin
   entropy := phuff_entropy_ptr (cinfo^.entropy);
   entropy := phuff_entropy_ptr (cinfo^.entropy);
   Al := cinfo^.Al;
   Al := cinfo^.Al;
@@ -372,6 +392,7 @@ begin
 
 
       { Section F.2.2.1: decode the DC coefficient difference }
       { Section F.2.2.1: decode the DC coefficient difference }
       {HUFF_DECODE(s, br_state, tbl, return FALSE, label1);}
       {HUFF_DECODE(s, br_state, tbl, return FALSE, label1);}
+      skiptolabel1:=False;
       if (bits_left < HUFF_LOOKAHEAD) then
       if (bits_left < HUFF_LOOKAHEAD) then
       begin
       begin
         if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then
         if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then
@@ -384,35 +405,40 @@ begin
         if (bits_left < HUFF_LOOKAHEAD) then
         if (bits_left < HUFF_LOOKAHEAD) then
         begin
         begin
           nb := 1;
           nb := 1;
-          goto label1;
+          {$IFDEF NOGOTO}
+            SkipToLabel1:=true;
+            if DoDecode then
+              exit;
+          {$ELSE}
+            goto label1;
+          {$ENDIF}
+
         end;
         end;
       end;
       end;
-      {look := PEEK_BITS(HUFF_LOOKAHEAD);}
-      look := int(get_buffer shr (bits_left -  HUFF_LOOKAHEAD)) and
-                     pred(1 shl HUFF_LOOKAHEAD);
+      if not SkipToLabel1 then
+        begin
+          {look := PEEK_BITS(HUFF_LOOKAHEAD);}
+          look := int(get_buffer shr (bits_left -  HUFF_LOOKAHEAD)) and
+                         pred(1 shl HUFF_LOOKAHEAD);
 
 
-      nb := tbl^.look_nbits[look];
-      if (nb <> 0) then
-      begin
-        {DROP_BITS(nb);}
-        Dec(bits_left, nb);
+          nb := tbl^.look_nbits[look];
+          if (nb <> 0) then
+          begin
+            {DROP_BITS(nb);}
+            Dec(bits_left, nb);
 
 
-        s := tbl^.look_sym[look];
-      end
-      else
-      begin
-        nb := HUFF_LOOKAHEAD+1;
-    label1:
-        s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb);
-        if (s < 0) then
-        begin
-          decode_mcu_DC_first := FALSE;
-          exit;
+            s := tbl^.look_sym[look];
+          end
+          else
+          begin
+            nb := HUFF_LOOKAHEAD+1;
+            {$IFNDEF NOGOTO}
+            label1:
+            {$ENDIF}
+            if DoDecode then
+              exit;
+          end;
         end;
         end;
-        get_buffer := br_state.get_buffer;
-        bits_left := br_state.bits_left;
-      end;
-
       if (s <> 0) then
       if (s <> 0) then
       begin
       begin
         {CHECK_BIT_BUFFER(br_state, s, return FALSE);}
         {CHECK_BIT_BUFFER(br_state, s, return FALSE);}
@@ -469,8 +495,10 @@ end;
 {METHODDEF}
 {METHODDEF}
 function decode_mcu_AC_first (cinfo : j_decompress_ptr;
 function decode_mcu_AC_first (cinfo : j_decompress_ptr;
                               var MCU_data : array of JBLOCKROW) : boolean;
                               var MCU_data : array of JBLOCKROW) : boolean;
+{$IFNDEF NOGOTO}
 label
 label
   label2;
   label2;
+{$ENDIF}
 var
 var
   entropy : phuff_entropy_ptr;
   entropy : phuff_entropy_ptr;
   Se : int;
   Se : int;
@@ -486,6 +514,19 @@ var
   tbl : d_derived_tbl_ptr;
   tbl : d_derived_tbl_ptr;
 var
 var
   nb, look : int; {register}
   nb, look : int; {register}
+
+  function DoDecode : boolean;
+  begin
+    s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb);
+    if (s < 0) then
+    begin
+      decode_mcu_AC_first := FALSE;
+      exit;
+    end;
+    get_buffer := br_state.get_buffer;
+    bits_left := br_state.bits_left;
+  end;
+
 begin
 begin
   entropy := phuff_entropy_ptr (cinfo^.entropy);
   entropy := phuff_entropy_ptr (cinfo^.entropy);
   Se := cinfo^.Se;
   Se := cinfo^.Se;
@@ -544,7 +585,12 @@ begin
           if (bits_left < HUFF_LOOKAHEAD) then
           if (bits_left < HUFF_LOOKAHEAD) then
           begin
           begin
             nb := 1;
             nb := 1;
+            {$IFDEF NOGOTO}
+            if DoDecode then
+              exit;
+            {$ELSE}
             goto label2;
             goto label2;
+            {$ENDIF}
           end;
           end;
         end;
         end;
         {look := PEEK_BITS(HUFF_LOOKAHEAD);}
         {look := PEEK_BITS(HUFF_LOOKAHEAD);}
@@ -562,15 +608,11 @@ begin
         else
         else
         begin
         begin
           nb := HUFF_LOOKAHEAD+1;
           nb := HUFF_LOOKAHEAD+1;
+          {$IFNDEF NOGOTO}
       label2:
       label2:
-          s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb);
-          if (s < 0) then
-          begin
-            decode_mcu_AC_first := FALSE;
+          {$ENDIF}
+          if DoDecode then
             exit;
             exit;
-          end;
-          get_buffer := br_state.get_buffer;
-          bits_left := br_state.bits_left;
         end;
         end;
 
 
         r := s shr 4;
         r := s shr 4;
@@ -745,8 +787,10 @@ end;
 {METHODDEF}
 {METHODDEF}
 function decode_mcu_AC_refine (cinfo : j_decompress_ptr;
 function decode_mcu_AC_refine (cinfo : j_decompress_ptr;
                                var MCU_data : array of JBLOCKROW) : boolean;
                                var MCU_data : array of JBLOCKROW) : boolean;
+{$IFNDEF NOGOTO}
 label
 label
   undoit, label3;
   undoit, label3;
+{$ENDIF}
 var
 var
   entropy : phuff_entropy_ptr;
   entropy : phuff_entropy_ptr;
   Se : int;
   Se : int;
@@ -768,6 +812,30 @@ var
   pos : int;
   pos : int;
 var
 var
   nb, look : int; {register}
   nb, look : int; {register}
+
+  Function DoDecode: boolean;
+  begin
+    s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb);
+    if (s < 0) then
+      exit(True);
+    get_buffer := br_state.get_buffer;
+    bits_left := br_state.bits_left;
+    doDecode:=False;
+  end;
+
+  Procedure FinishDecode;
+
+  begin
+    { Re-zero any output coefficients that we made newly nonzero }
+  while (num_newnz > 0) do
+  begin
+    Dec(num_newnz);
+    block^[newnz_pos[num_newnz]] := 0;
+  end;
+
+  decode_mcu_AC_refine := FALSE;
+  end;
+
 begin
 begin
   entropy := phuff_entropy_ptr (cinfo^.entropy);
   entropy := phuff_entropy_ptr (cinfo^.entropy);
   Se := cinfo^.Se;
   Se := cinfo^.Se;
@@ -822,13 +890,28 @@ begin
         if (bits_left < HUFF_LOOKAHEAD) then
         if (bits_left < HUFF_LOOKAHEAD) then
         begin
         begin
           if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then
           if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then
+            begin
+            {$IFDEF NOGOTO}
+            FinishDecode;
+            Exit;
+            {$ELSE}
             goto undoit;
             goto undoit;
+            {$ENDIF}
+            end;
           get_buffer := br_state.get_buffer;
           get_buffer := br_state.get_buffer;
           bits_left := br_state.bits_left;
           bits_left := br_state.bits_left;
           if (bits_left < HUFF_LOOKAHEAD) then
           if (bits_left < HUFF_LOOKAHEAD) then
           begin
           begin
             nb := 1;
             nb := 1;
+            {$IFDEF NOGOTO}
+            if DoDecode then
+              begin
+              FinishDecode;
+              Exit;
+              end;
+            {$ELSE}
             goto label3;
             goto label3;
+            {$ENDIF}
           end;
           end;
         end;
         end;
         {look := PEEK_BITS(HUFF_LOOKAHEAD);}
         {look := PEEK_BITS(HUFF_LOOKAHEAD);}
@@ -846,12 +929,14 @@ begin
         else
         else
         begin
         begin
           nb := HUFF_LOOKAHEAD+1;
           nb := HUFF_LOOKAHEAD+1;
+          {$IFNDEF NOGOTO}
       label3:
       label3:
-          s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb);
-          if (s < 0) then
-            goto undoit;
-          get_buffer := br_state.get_buffer;
-          bits_left := br_state.bits_left;
+          {$ENDIF}
+          if DoDecode then
+            begin
+            FinishDecode;
+            Exit;
+            end;
         end;
         end;
 
 
         r := s shr 4;
         r := s shr 4;
@@ -864,7 +949,14 @@ begin
           if (bits_left < 1) then
           if (bits_left < 1) then
           begin
           begin
             if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then
             if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then
+              begin
+              {$IFDEF NOGOTO}
+              FinishDecode;
+              Exit;
+              {$ELSE}
               goto undoit;
               goto undoit;
+              {$ENDIF}
+              end;
             get_buffer := br_state.get_buffer;
             get_buffer := br_state.get_buffer;
             bits_left := br_state.bits_left;
             bits_left := br_state.bits_left;
           end;
           end;
@@ -887,7 +979,14 @@ begin
               if (bits_left < r) then
               if (bits_left < r) then
               begin
               begin
                 if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,r)) then
                 if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,r)) then
+                  begin
+                  {$IFDEF NOGOTO}
+                  FinishDecode;
+                  Exit;
+                  {$ELSE}
                   goto undoit;
                   goto undoit;
+                  {$ENDIF}
+                  end;
                 get_buffer := br_state.get_buffer;
                 get_buffer := br_state.get_buffer;
                 bits_left := br_state.bits_left;
                 bits_left := br_state.bits_left;
               end;
               end;
@@ -914,7 +1013,14 @@ begin
             if (bits_left < 1) then
             if (bits_left < 1) then
             begin
             begin
               if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then
               if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then
+                begin
+                {$IFDEF NOGOTO}
+                FinishDecode;
+                Exit;
+                {$ELSE}
                 goto undoit;
                 goto undoit;
+                {$ENDIF}
+                end;
               get_buffer := br_state.get_buffer;
               get_buffer := br_state.get_buffer;
               bits_left := br_state.bits_left;
               bits_left := br_state.bits_left;
             end;
             end;
@@ -969,7 +1075,14 @@ begin
           if (bits_left < 1) then
           if (bits_left < 1) then
           begin
           begin
             if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then
             if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then
+              begin
+              {$IFDEF NOGOTO}
+              FinishDecode;
+              Exit;
+              {$ELSE}
               goto undoit;
               goto undoit;
+              {$ENDIF}
+              end;
             get_buffer := br_state.get_buffer;
             get_buffer := br_state.get_buffer;
             bits_left := br_state.bits_left;
             bits_left := br_state.bits_left;
           end;
           end;
@@ -1009,15 +1122,10 @@ begin
   decode_mcu_AC_refine := TRUE;
   decode_mcu_AC_refine := TRUE;
   exit;
   exit;
 
 
+{$IFNDEF NOGOTO}
 undoit:
 undoit:
-  { Re-zero any output coefficients that we made newly nonzero }
-  while (num_newnz > 0) do
-  begin
-    Dec(num_newnz);
-    block^[newnz_pos[num_newnz]] := 0;
-  end;
-
-  decode_mcu_AC_refine := FALSE;
+{$ENDIF}
+  FinishDecode;
 end;
 end;
 
 
 
 

+ 130 - 29
packages/pasjpeg/src/jquant2.pas

@@ -368,10 +368,13 @@ end;
 
 
 {LOCAL}
 {LOCAL}
 procedure update_box (cinfo : j_decompress_ptr; var boxp : box);
 procedure update_box (cinfo : j_decompress_ptr; var boxp : box);
+{$IFNDEF NOGOTO}
 label
 label
   have_c0min, have_c0max,
   have_c0min, have_c0max,
   have_c1min, have_c1max,
   have_c1min, have_c1max,
   have_c2min, have_c2max;
   have_c2min, have_c2max;
+{$ENDIF}
+
 { Shrink the min/max bounds of a box to enclose only nonzero elements, }
 { Shrink the min/max bounds of a box to enclose only nonzero elements, }
 { and recompute its volume and population }
 { and recompute its volume and population }
 var
 var
@@ -382,6 +385,9 @@ var
   c0min,c0max,c1min,c1max,c2min,c2max : int;
   c0min,c0max,c1min,c1max,c2min,c2max : int;
   dist0,dist1,dist2 : INT32;
   dist0,dist1,dist2 : INT32;
   ccount : long;
   ccount : long;
+{$IFDEF NOGOTO}
+  doBreak : boolean;
+{$ENDIF}
 begin
 begin
   cquantize := my_cquantize_ptr(cinfo^.cquantize);
   cquantize := my_cquantize_ptr(cinfo^.cquantize);
   histogram := cquantize^.histogram;
   histogram := cquantize^.histogram;
@@ -390,8 +396,12 @@ begin
   c1min := boxp.c1min;  c1max := boxp.c1max;
   c1min := boxp.c1min;  c1max := boxp.c1max;
   c2min := boxp.c2min;  c2max := boxp.c2max;
   c2min := boxp.c2min;  c2max := boxp.c2max;
 
 
+{$IFDEF NOGOTO}
+DoBreak:=False;
+{$ENDIF}
   if (c0max > c0min) then
   if (c0max > c0min) then
     for c0 := c0min to c0max do
     for c0 := c0min to c0max do
+      begin
       for c1 := c1min to c1max do
       for c1 := c1min to c1max do
       begin
       begin
         histp := @(histogram^[c0]^[c1][c2min]);
         histp := @(histogram^[c0]^[c1][c2min]);
@@ -401,29 +411,60 @@ begin
           begin
           begin
             c0min := c0;
             c0min := c0;
             boxp.c0min := c0min;
             boxp.c0min := c0min;
+            {$IFDEF NOGOTO}
+            DoBreak:=True;
+            Break; // inner loop
+            {$ELSE}
             goto have_c0min;
             goto have_c0min;
+            {$ENDIF}
           end;
           end;
           Inc(histp);
           Inc(histp);
         end;
         end;
       end;
       end;
+      {$IFDEF NOGOTO}
+      if DoBreak then
+        Break;
+      {$ENDIF}
+      end;
+
+{$IFNDEF NOGOTO}
  have_c0min:
  have_c0min:
+{$ELSE}
+ DoBreak:=False;
+{$ENDIF}
   if (c0max > c0min) then
   if (c0max > c0min) then
     for c0 := c0max downto c0min do
     for c0 := c0max downto c0min do
-      for c1 := c1min to c1max do
       begin
       begin
-        histp := @(histogram^[c0]^[c1][c2min]);
-        for c2 := c2min to c2max do
+        for c1 := c1min to c1max do
         begin
         begin
-          if ( histp^ <> 0) then
+          histp := @(histogram^[c0]^[c1][c2min]);
+          for c2 := c2min to c2max do
           begin
           begin
-            c0max := c0;
-            boxp.c0max := c0;
-            goto have_c0max;
+            if ( histp^ <> 0) then
+            begin
+              c0max := c0;
+              boxp.c0max := c0;
+              {$IFDEF NOGOTO}
+              DoBreak:=True;
+              Break; // inner loop
+              {$ELSE}
+              goto have_c0max;
+              {$ENDIF}
+            end;
+            Inc(histp);
           end;
           end;
-          Inc(histp);
         end;
         end;
+        {$IFDEF NOGOTO}
+        if DoBreak then
+          Break;
+        {$ENDIF}
       end;
       end;
- have_c0max:
+
+{$IFNDEF NOGOTO}
+  have_c0max:
+{$ELSE}
+  DoBreak:=False;
+{$ENDIF}
   if (c1max > c1min) then
   if (c1max > c1min) then
     for c1 := c1min to c1max do
     for c1 := c1min to c1max do
       for c0 := c0min to c0max do
       for c0 := c0min to c0max do
@@ -435,12 +476,26 @@ begin
           begin
           begin
             c1min := c1;
             c1min := c1;
             boxp.c1min := c1;
             boxp.c1min := c1;
+            {$IFDEF NOGOTO}
+            DoBreak:=True;
+            Break; // inner loop
+            {$ELSE}
             goto have_c1min;
             goto have_c1min;
+            {$ENDIF}
           end;
           end;
           Inc(histp);
           Inc(histp);
         end;
         end;
+        {$IFDEF NOGOTO}
+        if DoBreak then
+          Break;
+        {$ENDIF}
       end;
       end;
- have_c1min:
+{$IFNDEF NOGOTO}
+  have_c1min:
+{$ELSE}
+  DoBreak:=False;
+{$ENDIF}
+
   if (c1max > c1min) then
   if (c1max > c1min) then
     for c1 := c1max downto c1min do
     for c1 := c1max downto c1min do
       for c0 := c0min to c0max do
       for c0 := c0min to c0max do
@@ -452,46 +507,92 @@ begin
           begin
           begin
             c1max := c1;
             c1max := c1;
             boxp.c1max := c1;
             boxp.c1max := c1;
+            {$IFDEF NOGOTO}
+            DoBreak:=True;
+            Break; // inner loop
+            {$ELSE}
             goto have_c1max;
             goto have_c1max;
+            {$ENDIF}
           end;
           end;
           Inc(histp);
           Inc(histp);
         end;
         end;
+        {$IFDEF NOGOTO}
+        if DoBreak then
+          Break;
+        {$ENDIF}
       end;
       end;
- have_c1max:
+{$IFNDEF NOGOTO}
+  have_c1max:
+{$ELSE}
+  DoBreak:=False;
+{$ENDIF}
+
   if (c2max > c2min) then
   if (c2max > c2min) then
     for c2 := c2min to c2max do
     for c2 := c2min to c2max do
-      for c0 := c0min to c0max do
       begin
       begin
-        histp := @(histogram^[c0]^[c1min][c2]);
-        for c1 := c1min to c1max do
+        for c0 := c0min to c0max do
         begin
         begin
-          if (histp^ <> 0) then
+          histp := @(histogram^[c0]^[c1min][c2]);
+          for c1 := c1min to c1max do
           begin
           begin
-            c2min := c2;
-            boxp.c2min := c2min;
-            goto have_c2min;
+            if (histp^ <> 0) then
+            begin
+              c2min := c2;
+              boxp.c2min := c2min;
+              {$IFDEF NOGOTO}
+              DoBreak:=True;
+              Break; // inner loop
+              {$ELSE}
+              goto have_c2min;
+              {$ENDIF}
+            end;
+            Inc(histp, HIST_C2_ELEMS);
           end;
           end;
-          Inc(histp, HIST_C2_ELEMS);
         end;
         end;
+        {$IFDEF NOGOTO}
+        if DoBreak then
+          Break;
+        {$ENDIF}
       end;
       end;
- have_c2min:
+{$IFNDEF NOGOTO}
+  have_c2min:
+{$ELSE}
+  DoBreak:=False;
+{$ENDIF}
+
   if (c2max > c2min) then
   if (c2max > c2min) then
     for c2 := c2max downto c2min do
     for c2 := c2max downto c2min do
-      for c0 := c0min to c0max do
       begin
       begin
-        histp := @(histogram^[c0]^[c1min][c2]);
-        for c1 := c1min to c1max do
+        for c0 := c0min to c0max do
         begin
         begin
-          if (histp^ <> 0) then
+          histp := @(histogram^[c0]^[c1min][c2]);
+          for c1 := c1min to c1max do
           begin
           begin
-            c2max := c2;
-            boxp.c2max := c2max;
-            goto have_c2max;
+            if (histp^ <> 0) then
+            begin
+              c2max := c2;
+              boxp.c2max := c2max;
+              {$IFDEF NOGOTO}
+              DoBreak:=True;
+              Break; // inner loop
+              {$ELSE}
+              goto have_c2max;
+              {$ENDIF}
+            end;
+            Inc(histp, HIST_C2_ELEMS);
           end;
           end;
-          Inc(histp, HIST_C2_ELEMS);
         end;
         end;
+        {$IFDEF NOGOTO}
+        if DoBreak then
+          Break;
+        {$ENDIF}
       end;
       end;
- have_c2max:
+{$IFNDEF NOGOTO}
+  have_c2max:
+{$ELSE}
+  DoBreak:=False;
+{$ENDIF}
+
 
 
   { Update box volume.
   { Update box volume.
     We use 2-norm rather than real volume here; this biases the method
     We use 2-norm rather than real volume here; this biases the method

+ 3 - 2
packages/pastojs/tests/tcmodules.pas

@@ -32,6 +32,7 @@ const
   // default parser+scanner options
   // default parser+scanner options
   po_tcmodules = po_Pas2js+[po_KeepScannerError];
   po_tcmodules = po_Pas2js+[po_KeepScannerError];
   co_tcmodules = [];
   co_tcmodules = [];
+  JSONNewLine = {$IFDEF Windows}'\r\n'{$ELSE}'\n'{$ENDIF};
 type
 type
   TSrcMarkerKind = (
   TSrcMarkerKind = (
     mkLabel,
     mkLabel,
@@ -8877,11 +8878,11 @@ begin
   CheckSource('TestStringConst_Multiline',
   CheckSource('TestStringConst_Multiline',
     LinesToStr([
     LinesToStr([
     'this.a = "";',
     'this.a = "";',
-    'this.b = "\nline";',
+    'this.b = "'+JSONNewLine+'line";',
     'this.c = "Single";',
     'this.c = "Single";',
     'this.d = "`";',
     'this.d = "`";',
     'this.e = "abc`xyz";',
     'this.e = "abc`xyz";',
-    'this.f = "first''line\n       second''line\n";',
+    'this.f = "first''line'+JSONNewLine+'       second''line\n";',
     '']),
     '']),
     LinesToStr([
     LinesToStr([
     ]));
     ]));

+ 14 - 5
packages/pastojs/tests/tcunitsearch.pas

@@ -373,6 +373,8 @@ end;
 procedure TCustomTestCLI.OnWriteFile(aFilename: string; Source: string);
 procedure TCustomTestCLI.OnWriteFile(aFilename: string; Source: string);
 var
 var
   aFile: TCLIFile;
   aFile: TCLIFile;
+  s: String;
+  i: Integer;
   {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
   {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
   //i: Integer;
   //i: Integer;
   {$ENDIF}
   {$ENDIF}
@@ -406,7 +408,14 @@ begin
   aFile.Source:=Source;
   aFile.Source:=Source;
   aFile.Attr:=faNormal;
   aFile.Attr:=faNormal;
   aFile.Age:=DateTimeToFileDate(CurDate);
   aFile.Age:=DateTimeToFileDate(CurDate);
-  writeln('TCustomTestCLI.OnWriteFile ',aFile.Filename,' Found=',FindFile(aFilename)<>nil,' "',LeftStr(aFile.Source,50),'" ');
+  s:=LeftStr(aFile.Source,50);
+  for i:=1 to length(s) do
+    if not (s[i] in [#9..#10,#13,' '..#126]) then
+    begin
+      s:='<BINARY>';
+      break;
+    end;
+  writeln('TCustomTestCLI.OnWriteFile ',aFile.Filename,' Found=',FindFile(aFilename)<>nil,' "',s,'" ');
   //writeln('TCustomTestCLI.OnWriteFile ',aFile.Source);
   //writeln('TCustomTestCLI.OnWriteFile ',aFile.Source);
 end;
 end;
 
 
@@ -877,7 +886,7 @@ begin
   AddUnit('unit1.pas',
   AddUnit('unit1.pas',
   ['var a: longint;'],
   ['var a: longint;'],
   ['']);
   ['']);
-  AddUnit('sub/unit1.pas',
+  AddUnit('sub'+PathDelim+'unit1.pas',
   ['var b: longint;'],
   ['var b: longint;'],
   ['']);
   ['']);
   AddFile('test1.pas',[
   AddFile('test1.pas',[
@@ -887,7 +896,7 @@ begin
     '  a:=b;',
     '  a:=b;',
     'end.']);
     'end.']);
   Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
   Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
-  AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'sub/unit1.pas" and "'+WorkDir+'unit1.pas"',ErrorMsg);
+  AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'sub'+PathDelim+'unit1.pas" and "'+WorkDir+'unit1.pas"',ErrorMsg);
 end;
 end;
 
 
 procedure TTestCLI_UnitSearch.TestUS_UsesInFile_IndirectDuplicate;
 procedure TTestCLI_UnitSearch.TestUS_UsesInFile_IndirectDuplicate;
@@ -897,7 +906,7 @@ begin
   AddUnit('unit1.pas',
   AddUnit('unit1.pas',
   ['var a: longint;'],
   ['var a: longint;'],
   ['']);
   ['']);
-  AddUnit('sub/unit1.pas',
+  AddUnit('sub'+PathDelim+'unit1.pas',
   ['var b: longint;'],
   ['var b: longint;'],
   ['']);
   ['']);
   AddUnit('unit2.pas',
   AddUnit('unit2.pas',
@@ -908,7 +917,7 @@ begin
     'begin',
     'begin',
     'end.']);
     'end.']);
   Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
   Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
-  AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'unit1.pas" and "'+WorkDir+'sub/unit1.pas"',ErrorMsg);
+  AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'unit1.pas" and "'+WorkDir+'sub'+PathDelim+'unit1.pas"',ErrorMsg);
 end;
 end;
 
 
 procedure TTestCLI_UnitSearch.TestUS_UsesInFile_WorkNotEqProgDir;
 procedure TTestCLI_UnitSearch.TestUS_UsesInFile_WorkNotEqProgDir;

+ 59 - 34
packages/paszlib/src/infblock.pas

@@ -171,6 +171,9 @@ function inflate_blocks (var s : inflate_blocks_state;
                          var z : z_stream;
                          var z : z_stream;
                          r : integer) : integer;           { initial return code }
                          r : integer) : integer;           { initial return code }
 
 
+Type
+  tblockaction = (baFallThrough,baContinue,baExit);
+
 var
 var
   t : cardinal;               { temporary storage }
   t : cardinal;               { temporary storage }
   b : cardinal;              { bit buffer }
   b : cardinal;              { bit buffer }
@@ -189,7 +192,7 @@ var
 var
 var
   cs : pInflate_codes_state;
   cs : pInflate_codes_state;
   
   
-  procedure do_btree;
+  function do_btree : TBlockAction;
   
   
   begin
   begin
     while (s.sub.trees.index < 4 + (s.sub.trees.table shr 10)) do
     while (s.sub.trees.index < 4 + (s.sub.trees.table shr 10)) do
@@ -210,7 +213,7 @@ var
           z.next_in := p;
           z.next_in := p;
           s.write := q;
           s.write := q;
           inflate_blocks := inflate_flush(s,z,r);
           inflate_blocks := inflate_flush(s,z,r);
-          exit;
+          exit(baExit);
         end;
         end;
         dec(n);
         dec(n);
         b := b or (cardinal(p^) shl k);
         b := b or (cardinal(p^) shl k);
@@ -247,7 +250,7 @@ var
       z.next_in := p;
       z.next_in := p;
       s.write := q;
       s.write := q;
       inflate_blocks := inflate_flush(s,z,r);
       inflate_blocks := inflate_flush(s,z,r);
-      exit;
+      exit(baExit);
     end;
     end;
     s.sub.trees.index := 0;
     s.sub.trees.index := 0;
     {$IFDEF ZLIB_DEBUG}
     {$IFDEF ZLIB_DEBUG}
@@ -255,9 +258,10 @@ var
     {$ENDIF}
     {$ENDIF}
     s.mode := DTREE;
     s.mode := DTREE;
     { fall through again }
     { fall through again }
+    do_btree:=baFallThrough;
   end;
   end;
   
   
-  procedure do_dtree;
+  function do_dtree : TBlockaction;
   
   
   begin
   begin
     while TRUE do
     while TRUE do
@@ -283,7 +287,7 @@ var
           z.next_in := p;
           z.next_in := p;
           s.write := q;
           s.write := q;
           inflate_blocks := inflate_flush(s,z,r);
           inflate_blocks := inflate_flush(s,z,r);
-          exit;
+          exit(baExit);
         end;
         end;
         dec(n);
         dec(n);
         b := b or (cardinal(p^) shl k);
         b := b or (cardinal(p^) shl k);
@@ -333,7 +337,7 @@ var
             z.next_in := p;
             z.next_in := p;
             s.write := q;
             s.write := q;
             inflate_blocks := inflate_flush(s,z,r);
             inflate_blocks := inflate_flush(s,z,r);
-            exit;
+            exit(baExit);
           end;
           end;
           dec(n);
           dec(n);
           b := b or (cardinal(p^) shl k);
           b := b or (cardinal(p^) shl k);
@@ -368,7 +372,7 @@ var
           z.next_in := p;
           z.next_in := p;
           s.write := q;
           s.write := q;
           inflate_blocks := inflate_flush(s,z,r);
           inflate_blocks := inflate_flush(s,z,r);
-          exit;
+          exit(baExit);
         end;
         end;
         if c = 16 then
         if c = 16 then
           c := s.sub.trees.blens^[i - 1]
           c := s.sub.trees.blens^[i - 1]
@@ -405,7 +409,7 @@ var
         z.next_in := p;
         z.next_in := p;
         s.write := q;
         s.write := q;
         inflate_blocks := inflate_flush(s,z,r);
         inflate_blocks := inflate_flush(s,z,r);
-        exit;
+        exit(baExit);
       end;
       end;
       {$IFDEF ZLIB_DEBUG}
       {$IFDEF ZLIB_DEBUG}
       Tracev('inflate:       trees ok');
       Tracev('inflate:       trees ok');
@@ -423,14 +427,16 @@ var
         z.next_in := p;
         z.next_in := p;
         s.write := q;
         s.write := q;
         inflate_blocks := inflate_flush(s,z,r);
         inflate_blocks := inflate_flush(s,z,r);
-        exit;
+        exit(baExit);
       end;
       end;
       s.sub.decode.codes := cs;
       s.sub.decode.codes := cs;
     end;
     end;
     s.mode := CODES;
     s.mode := CODES;
+    do_dtree:=baFallThrough;
   end;
   end;
-  
-  function do_codes: boolean;
+
+
+  function do_codes: tblockaction;
   
   
   begin
   begin
     { update pointers }
     { update pointers }
@@ -445,7 +451,7 @@ var
     if (r <> Z_STREAM_END) then
     if (r <> Z_STREAM_END) then
     begin
     begin
       inflate_blocks := inflate_flush(s, z, r);
       inflate_blocks := inflate_flush(s, z, r);
-      exit;
+      exit(baExit);
     end;
     end;
     r := Z_OK;
     r := Z_OK;
     inflate_codes_free(s.sub.decode.codes, z);
     inflate_codes_free(s.sub.decode.codes, z);
@@ -471,7 +477,7 @@ var
     if (not s.last) then
     if (not s.last) then
     begin
     begin
       s.mode := ZTYPE;
       s.mode := ZTYPE;
-      exit(false); { break for switch statement in C-code }
+      exit(baContinue); { break for switch statement in C-code }
     end;
     end;
     {$ifndef patch112}
     {$ifndef patch112}
     if (k > 7) then           { return unused byte, if any }
     if (k > 7) then           { return unused byte, if any }
@@ -485,10 +491,10 @@ var
     end;
     end;
     {$endif}
     {$endif}
     s.mode := DRY;
     s.mode := DRY;
-    do_codes:=true;
+    do_codes:=baFallThrough;
   end;
   end;
 
 
-  procedure do_dry;
+  function do_dry : tblockaction;
   
   
   begin
   begin
     {FLUSH}
     {FLUSH}
@@ -513,9 +519,10 @@ var
       z.next_in := p;
       z.next_in := p;
       s.write := q;
       s.write := q;
       inflate_blocks := inflate_flush(s,z,r);
       inflate_blocks := inflate_flush(s,z,r);
-      exit;
+      exit(baExit);
     end;
     end;
     s.mode := BLKDONE;
     s.mode := BLKDONE;
+    do_dry:=baFallThrough;
   end;
   end;
 
 
   procedure do_blkdone;
   procedure do_blkdone;
@@ -880,44 +887,62 @@ begin
         s.mode := BTREE;
         s.mode := BTREE;
         { fall trough case is handled by the while }
         { fall trough case is handled by the while }
         { try GOTO for speed - Nomssi }
         { try GOTO for speed - Nomssi }
-        do_btree;
-        do_dtree;
-        if not do_codes then 
-          continue;
-        do_dry;
+        if do_btree=baExit then
+          Exit;
+        if do_dtree=baExit then
+          Exit;
+        Case do_codes of
+          baContinue : continue;
+          baExit : Exit;
+        end;
+        if do_dry=baExit then
+          exit;
         do_blkdone;
         do_blkdone;
         exit;
         exit;
       end;
       end;
     BTREE:
     BTREE:
       begin
       begin
-        do_btree;
-        do_dtree;
-        if not do_codes then
-          continue;
-        do_dry;
+        if do_btree=baExit then
+          Exit;
+        if do_dtree=baExit then
+          Exit;
+        Case do_codes of
+          baContinue : continue;
+          baExit : Exit;
+        end;
+        if do_dry=baExit then
+          exit;
         do_blkdone;
         do_blkdone;
         exit;
         exit;
       end;
       end;
     DTREE:
     DTREE:
       begin
       begin
-        do_dtree;
-        if not do_codes then 
-          continue;
-        do_dry;
+        if do_dtree=baExit then
+          Exit;
+        Case do_codes of
+          baContinue : continue;
+          baExit : Exit;
+        end;
+        if do_dry=baExit then
+          exit;
         do_blkdone;
         do_blkdone;
         exit;
         exit;
       end;
       end;
     CODES:
     CODES:
       begin
       begin
-        if not do_codes then 
-          continue;
-        do_dry;
+        Case do_codes of
+          baContinue : continue;
+          baExit : Exit;
+        end;
+        if do_dry=baExit then
+          exit;
         do_blkdone;
         do_blkdone;
         exit;
         exit;
       end;
       end;
     DRY:
     DRY:
       begin
       begin
-        do_dry;
+        if do_dry=baExit then
+          exit;
         do_blkdone;
         do_blkdone;
         exit;
         exit;
       end;
       end;