* synchronized with trunk

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

.gitattributes

@@ -13389,6 +13389,8 @@ tests/tbs/tb0672.pp svneol=native#text/pascal
 tests/tbs/tb0673.pp svneol=native#text/pascal
 tests/tbs/tb0674.pp svneol=native#text/pascal
 tests/tbs/tb0675.pp svneol=native#text/pascal
+tests/tbs/tb0676.pp svneol=native#text/pascal
+tests/tbs/tb0676a.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
@@ -14444,6 +14446,7 @@ tests/test/tarrconstr12.pp svneol=native#text/pascal
 tests/test/tarrconstr13.pp svneol=native#text/pascal
 tests/test/tarrconstr14.pp svneol=native#text/pascal
 tests/test/tarrconstr15.pp svneol=native#text/pascal
+tests/test/tarrconstr16.pp svneol=native#text/pascal
 tests/test/tarrconstr2.pp svneol=native#text/pascal
 tests/test/tarrconstr3.pp svneol=native#text/pascal
 tests/test/tarrconstr4.pp svneol=native#text/pascal
@@ -18508,6 +18511,7 @@ tests/webtbs/tw3768.pp svneol=native#text/plain
 tests/webtbs/tw3774.pp svneol=native#text/plain
 tests/webtbs/tw3777.pp svneol=native#text/plain
 tests/webtbs/tw3778.pp svneol=native#text/plain
+tests/webtbs/tw37780.pp svneol=native#text/plain
 tests/webtbs/tw3780.pp svneol=native#text/plain
 tests/webtbs/tw3782.pp svneol=native#text/plain
 tests/webtbs/tw3796.pp svneol=native#text/plain

compiler/nadd.pas

@@ -1348,7 +1348,7 @@ implementation
                    (left.nodetype=equaln) and
                    (right.nodetype=equaln) and
                    (not might_have_sideeffects(left)) and
-                   (not might_have_sideeffects(right)) and
+                   (not might_have_sideeffects(right,[mhs_exceptions])) and
                    (is_constintnode(taddnode(left).left) or is_constintnode(taddnode(left).right) or
                     is_constpointernode(taddnode(left).left) or is_constpointernode(taddnode(left).right) or
                     is_constcharnode(taddnode(left).left) or is_constcharnode(taddnode(left).right)) and

compiler/ncnv.pas

@@ -2119,7 +2119,7 @@ implementation
               cassignmentnode.create(
                 cvecnode.create(
                   ctemprefnode.create(arrnode),
-                  cordconstnode.create(paracount,tarraydef(totypedef).rangedef,false)),
+                  cordconstnode.create(paracount+tarraydef(totypedef).lowrange,tarraydef(totypedef).rangedef,false)),
                 elemnode.left));
             elemnode.left:=nil;
             inc(paracount);
@@ -3175,7 +3175,13 @@ implementation
                        if (target_info.endian = endian_big) and (nf_absolute in flags) then
                          swap_const_value(tordconstnode(left).value,tordconstnode(left).resultdef.size);
                        if not(nf_generic_para in flags) then
-                         adaptrange(resultdef,tordconstnode(left).value,([nf_internal,nf_absolute]*flags)<>[],nf_explicit in flags,cs_check_range in localswitches);
+                          adaptrange(
+                            resultdef,tordconstnode(left).value,
+                            { when evaluating an explicit typecast during inlining, don't warn about
+                              lost bits; only warn if someone literally typed e.g. byte($1ff) }
+                            (([nf_internal,nf_absolute]*flags)<>[]) or (forinline and (nf_explicit in flags)),
+                            nf_explicit in flags,
+                            cs_check_range in localswitches);
                        { swap value back, but according to new type }
                        if (target_info.endian = endian_big) and (nf_absolute in flags) then
                          swap_const_value(tordconstnode(left).value,resultdef.size);

compiler/nflw.pas

@@ -2202,7 +2202,6 @@ implementation
 
                     if assigned(labelsym.jumpbuf) then
                       begin
-                        labelsym.nonlocal:=true;
                         result:=ccallnode.createintern('fpc_longjmp',
                           ccallparanode.create(cordconstnode.create(1,sinttype,true),
                           ccallparanode.create(cloadnode.create(labelsym.jumpbuf,labelsym.jumpbuf.owner),

compiler/pexpr.pas

@@ -3390,12 +3390,10 @@ implementation
                           Message(sym_e_label_already_defined);
                         if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
                           begin
-                            tlabelsym(srsym).nonlocal:=true;
                             include(current_procinfo.flags,pi_has_interproclabel);
+                            if (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
+                              Message(sym_e_interprocgoto_into_init_final_code_not_allowed);
                           end;
-                        if tlabelsym(srsym).nonlocal and
-                          (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
-                          Message(sym_e_interprocgoto_into_init_final_code_not_allowed);
                         tlabelsym(srsym).defined:=true;
                         p1:=clabelnode.create(nil,tlabelsym(srsym));
                         tlabelsym(srsym).code:=p1;

compiler/pstatmnt.pas

@@ -1281,12 +1281,10 @@ implementation
                      Message(sym_e_label_already_defined);
                    if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
                      begin
-                       tlabelsym(srsym).nonlocal:=true;
                        include(current_procinfo.flags,pi_has_interproclabel);
+                       if (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
+                         Message(sym_e_interprocgoto_into_init_final_code_not_allowed);
                      end;
-                   if tlabelsym(srsym).nonlocal and
-                     (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
-                     Message(sym_e_interprocgoto_into_init_final_code_not_allowed);
 
                    tlabelsym(srsym).defined:=true;
                    p:=clabelnode.create(nil,tlabelsym(srsym));

compiler/scanner.pas

@@ -4601,6 +4601,16 @@ type
               inc_comment_level;
             '}' :
               dec_comment_level;
+            '*' :
+              { in iso mode, comments opened by a curly bracket can be closed by asterisk, round bracket }
+              if m_iso in current_settings.modeswitches then
+                begin
+                  readchar;
+                  if c=')' then
+                    dec_comment_level
+                  else
+                    continue;
+                end;
             #10,#13 :
               linebreak;
             #26 :
@@ -4690,6 +4700,16 @@ type
                    else
                     found:=0;
                  end;
+              '}' :
+                { in iso mode, comments opened by asterisk, round bracket can be closed by a curly bracket }
+                if m_iso in current_settings.modeswitches then
+                  begin
+                    dec_comment_level;
+                    if comment_level=0 then
+                      found:=2
+                    else
+                      found:=0;
+                  end;
                '(' :
                  begin
                    if found=4 then

packages/cocoaint/src/webkit/WebFrame.inc

@@ -23,7 +23,7 @@ type
     function name: NSString; message 'name';
     function webView: WebView; message 'webView';
     function frameView: WebFrameView; message 'frameView';
-    function DOMDocument_: DOMDocument; message 'DOMDocument';
+    function DOMDocument: DOMDocument; message 'DOMDocument';
     function frameElement: DOMHTMLElement; message 'frameElement';
     procedure loadRequest (request: NSURLRequest); message 'loadRequest:';
     procedure loadData_MIMEType_textEncodingName_baseURL (data: NSData; MIMEType: NSString; encodingName: NSString; URL: NSURL); message 'loadData:MIMEType:textEncodingName:baseURL:';

packages/fcl-passrc/src/pasresolver.pp

@@ -6711,11 +6711,14 @@ begin
             end;
           okInterface:
             begin
-            // there can be multiple interfacetype constraint
-            if not (LastType is TPasClassType) then
-              RaiseCannotBeTogether(20190720211236,LastType.Name,MemberType.Name);
-            if TPasClassType(LastType).ObjKind<>okInterface then
-              RaiseCannotBeTogether(20190720211304,LastType.Name,MemberType.Name);
+            if LastType<>nil then
+              begin
+              // there can be multiple interfacetype constraint
+              if not (LastType is TPasClassType) then
+                RaiseCannotBeTogether(20190720211236,LastType.Name,MemberType.Name);
+              if TPasClassType(LastType).ObjKind<>okInterface then
+                RaiseCannotBeTogether(20190720211304,LastType.Name,MemberType.Name);
+              end;
             end
           else
             RaiseXIsNotAValidConstraint(20190720210919,MemberType.Name);

rtl/arm/arm.inc

@@ -1190,13 +1190,13 @@ function SwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inlin
     { is turned into "longint(AValue) shr 8", so if AValue < 0 then    }
     { the sign bits from the upper 16 bits are shifted in rather than  }
     { zeroes.                                                          }
-    Result := SmallInt((Word(AValue) shr 8) or (Word(AValue) shl 8));
+    Result := SmallInt(((Word(AValue) shr 8) or (Word(AValue) shl 8)) and $ffff);
   end;
 
 
 function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
-    Result := Word((AValue shr 8) or (AValue shl 8));
+    Result := ((AValue shr 8) or (AValue shl 8)) and $ffff;
   end;
 
 (*

rtl/inc/compproc.inc

@@ -67,10 +67,10 @@ Procedure fpc_shortstr_insert_char(source:Char;var s:shortstring;index:SizeInt);
 {$endif VER3_0}
 
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
-{$ifdef VER3_2}
+{$if defined(VER3_0) or defined(VER3_2)}
 function fpc_dynarray_copy(psrc : pointer;ti : pointer;
     lowidx,count:tdynarrayindex) : fpc_stub_dynarray;compilerproc;
-{$endif VER3_2}
+{$endif VER3_0 or VER3_2}
 function fpc_array_to_dynarray_copy(psrc : pointer;ti : pointer;
     lowidx,count,maxcount:tdynarrayindex;
     elesize : sizeint;

rtl/inc/dynarr.inc

@@ -208,8 +208,7 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
           { do we have to allocate memory? }
           if dims[0] = 0 then
             exit;
-          getmem(newp,size);
-          fillchar(newp^,size,0);
+          newp:=AllocMem(size);
 {$ifndef VER3_0}
           { call int_InitializeArray for management operators }
           if assigned(eletypemngd) and (PTypeKind(eletype)^ in [tkRecord, tkObject]) then
@@ -323,7 +322,7 @@ function int_array_to_dynarray_copy(psrc : pointer;ti : pointer;
     ) : fpc_stub_dynarray;[external name 'FPC_ARR_TO_DYNARR_COPY'];
 
 
-{$ifdef VER3_2}
+{$if defined(VER3_0) or defined(VER3_2)}
 function fpc_dynarray_copy(psrc : pointer;ti : pointer;
     lowidx,count:tdynarrayindex) : fpc_stub_dynarray;[Public,Alias:'FPC_DYNARR_COPY'];compilerproc;
   var
@@ -337,18 +336,26 @@ function fpc_dynarray_copy(psrc : pointer;ti : pointer;
 
      realpsrc:=pdynarray(psrc-sizeof(tdynarray));
 
+{$ifdef VER3_0}
+     tti:=aligntoptr(ti+2+PByte(ti)[1]);
+{$else VER3_0}
      tti:=aligntoqword(ti+2+PByte(ti)[1]);
+{$endif VER3_0}
 
      elesize:=pdynarraytypedata(tti)^.elSize;
+{$ifdef VER3_0}
+     eletype:=pdynarraytypedata(tti)^.elType;
+{$else VER3_0}
      { only set if type needs finalization }
      if assigned(pdynarraytypedata(tti)^.elType) then
        eletype:=pdynarraytypedata(tti)^.elType^
      else
        eletype:=nil;
+{$endif VER3_0}
 
      fpc_array_to_dynarray_copy(psrc,ti,lowidx,count,realpsrc^.high+1,elesize,eletype);
   end;
-{$endif VER3_2}
+{$endif VER3_0 or VER3_2}
 
 { copy a custom array (open/dynamic/static) to dynamic array }
 function fpc_array_to_dynarray_copy(psrc : pointer;ti : pointer;

rtl/inc/generic.inc

@@ -2663,13 +2663,13 @@ function SwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inlin
     { is turned into "longint(AValue) shr 8", so if AValue < 0 then    }
     { the sign bits from the upper 16 bits are shifted in rather than  }
     { zeroes.                                                          }
-    Result := SmallInt((Word(AValue) shr 8) or (Word(AValue) shl 8));
+    Result := SmallInt(((Word(AValue) shr 8) or (Word(AValue) shl 8)) and $ffff);
   end;
 
 {$ifndef cpujvm}
 function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
-    Result := Word((AValue shr 8) or (AValue shl 8));
+    Result := ((AValue shr 8) or (AValue shl 8)) and $ffff;
   end;
 {$endif}
 

rtl/x86_64/x86_64.inc

@@ -1021,13 +1021,13 @@ function SwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inlin
     { is turned into "longint(AValue) shr 8", so if AValue < 0 then    }
     { the sign bits from the upper 16 bits are shifted in rather than  }
     { zeroes.                                                          }
-    Result := SmallInt((Word(AValue) shr 8) or (Word(AValue) shl 8));
+    Result := SmallInt(((Word(AValue) shr 8) or (Word(AValue) shl 8)) and $ffff);
   end;
 
 
 function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
-    Result := Word((AValue shr 8) or (AValue shl 8));
+    Result := ((AValue shr 8) or (AValue shl 8)) and $ffff;
   end;
 
 

tests/tbs/tb0676.pp

@@ -0,0 +1,14 @@
+{ %NORUN }
+
+program tb0676;
+
+{$warn 4110 error}
+
+begin
+  SwapEndian(UInt16($1234));
+  SwapEndian(Int16($8765));
+  SwapEndian(UInt32($12345678));
+  SwapEndian(Int32($87654321));
+  SwapEndian(UInt64($1234567887654321));
+  SwapEndian(Int64($8765432112345678));
+end.

tests/tbs/tb0676a.pp

@@ -0,0 +1,21 @@
+{ %opt=-vw -Sew }
+{ %norun }
+
+{$mode objfpc}
+
+function SwapEndian(const AValue: Word): Word;inline;
+  begin
+    Result := Word((AValue shr 8) or (AValue shl 8));
+  end;
+
+const
+  Value = 8008;
+
+var
+  v: Word;
+begin
+  writeln(sizeof(Value));
+  Writeln(HexStr(Value, 4));
+  v := swapendian(Value);
+  Writeln(HexStr(v, 4));
+end.

tests/test/tarrconstr16.pp

@@ -0,0 +1,48 @@
+program tarrconstr16;
+
+type
+  TEnum = (
+    teOne,
+    teTwo,
+    teThree
+  );
+
+  TTest1 = array[0..2] of LongInt;
+  TTest2 = array[1..3] of LongInt;
+  TTest3 = array[TEnum] of LongInt;
+  TTest4 = array[-1..1] of LongInt;
+
+procedure CheckArray(Actual, Expected: array of LongInt; Code: LongInt);
+var
+  i: SizeInt;
+begin
+  if Length(Actual) <> Length(Expected) then
+    Halt(Code);
+  for i := 0 to High(Actual) do
+    if Actual[i] <> Expected[i] then
+      Halt(Code);
+end;
+
+var
+  arr1: TTest1;
+  arr2: TTest2;
+  arr3: TTest3;
+  arr4: TTest4;
+begin
+  FillChar(arr1, SizeOf(arr1), 0);
+  FillChar(arr2, SizeOf(arr2), 0);
+  FillChar(arr3, SizeOf(arr3), 0);
+  FillChar(arr4, SizeOf(arr4), 0);
+
+  arr1 := [1, 2, 3];
+  CheckArray(arr1, [1, 2, 3], 1);
+
+  arr2 := [1, 2, 3];
+  CheckArray(arr2, [1, 2, 3], 2);
+
+  arr3 := [1, 2, 3];
+  CheckArray(arr3, [1, 2, 3], 3);
+
+  arr4 := [1, 2, 3];
+  CheckArray(arr4, [1, 2, 3], 4);
+end.

tests/webtbs/tw37428.pp

@@ -1,8 +1,8 @@
 {$mode iso}
-label
-  0;
+{$goto on}
 
 begin
-  0:
-    writeln('ok');
+  writeln{comment*);{}
+  writeln(*comment};(* *)
+  writeln;
 end.

tests/webtbs/tw37780.pp

@@ -0,0 +1,18 @@
+program testbug;
+
+type
+  PTestRec = ^TTestRec;
+  TTestRec = record
+    Val: Integer;
+    Next: PTestRec;
+  end;
+
+var
+  TR: TTestRec;
+
+begin
+  TR.Val := 6;
+  TR.Next := nil;
+  if (TR.Val = 10) or ((TR.Val = 5) and (TR.Next^.Val = 5)) then
+    Writeln('OK');
+end.