* synchronized with trunk

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

.gitattributes

@@ -18108,6 +18108,7 @@ tests/webtbs/tw2886.pp svneol=native#text/plain
 tests/webtbs/tw2891.pp svneol=native#text/plain
 tests/webtbs/tw28916.pp svneol=native#text/pascal
 tests/webtbs/tw2892.pp svneol=native#text/plain
+tests/webtbs/tw28927.pp svneol=native#text/pascal
 tests/webtbs/tw28934.pp svneol=native#text/plain
 tests/webtbs/tw28948.pp svneol=native#text/plain
 tests/webtbs/tw28964.pp svneol=native#text/plain
@@ -18657,6 +18658,7 @@ tests/webtbs/tw38202.pp svneol=native#text/pascal
 tests/webtbs/tw38225.pp svneol=native#text/pascal
 tests/webtbs/tw38238.pp svneol=native#text/pascal
 tests/webtbs/tw38249.pp svneol=native#text/pascal
+tests/webtbs/tw38259.pp svneol=native#text/pascal
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain

compiler/optdfa.pas

@@ -508,20 +508,32 @@ unit optdfa;
 
             exitn:
               begin
-                if not(is_void(current_procinfo.procdef.returndef)) then
+                { in case of inlining, an exit node can have a successor, in this case, we do not have to
+                  use the faked resultnode }
+                if assigned(node.successor) then
+                  begin
+                    l:=node.optinfo^.life;
+                    DFASetIncludeSet(l,node.successor.optinfo^.life);
+                    UpdateLifeInfo(node,l);
+                  end
+                else if assigned(resultnode) and (resultnode.nodetype<>nothingn) then
                   begin
                     if not(assigned(node.optinfo^.def)) and
                        not(assigned(node.optinfo^.use)) then
                       begin
                         if assigned(texitnode(node).left) then
                           begin
-                            node.optinfo^.def:=resultnode.optinfo^.def;
+{                           this should never happen as
+                            texitnode.pass_typecheck converts the left node into a separate node already
+
+                             node.optinfo^.def:=resultnode.optinfo^.def;
 
                             dfainfo.use:[email protected]^.use;
                             dfainfo.def:[email protected]^.def;
                             dfainfo.map:=map;
                             foreachnodestatic(pm_postprocess,texitnode(node).left,@AddDefUse,@dfainfo);
-                            calclife(node);
+                            calclife(node); }
+                            Internalerror(2020122901);
                           end
                         else
                           begin

compiler/optutils.pas

@@ -163,11 +163,12 @@ unit optutils;
       var
         Continuestack : TFPList;
         Breakstack : TFPList;
+        Exitsuccessor: TNode;
       { sets the successor nodes of a node tree block
         returns the first node of the tree if it's a controll flow node }
       function DoSet(p : tnode;succ : tnode) : tnode;
         var
-          hp1,hp2 : tnode;
+          hp1,hp2, oldexitsuccessor: tnode;
           i : longint;
         begin
           result:=nil;
@@ -203,11 +204,15 @@ unit optutils;
             blockn:
               begin
                 result:=p;
+                oldexitsuccessor:=Exitsuccessor;
+                if nf_block_with_exit in p.flags then
+                  Exitsuccessor:=succ;
                 DoSet(tblocknode(p).statements,succ);
                 if assigned(tblocknode(p).statements) then
                   p.successor:=tblocknode(p).statements
                 else
                   p.successor:=succ;
+                Exitsuccessor:=oldexitsuccessor;
               end;
             forn:
               begin
@@ -288,7 +293,7 @@ unit optutils;
             exitn:
               begin
                 result:=p;
-                p.successor:=nil;
+                p.successor:=Exitsuccessor;
               end;
             casen:
               begin
@@ -337,6 +342,7 @@ unit optutils;
       begin
         Breakstack:=TFPList.Create;
         Continuestack:=TFPList.Create;
+        Exitsuccessor:=nil;
         DoSet(p,last);
         Continuestack.Free;
         Breakstack.Free;

compiler/ptype.pas

@@ -992,6 +992,7 @@ implementation
          old_parse_generic: boolean;
          recst: trecordsymtable;
          hadgendummy : boolean;
+         alignment: Integer;
       begin
          old_current_structdef:=current_structdef;
          old_current_genericdef:=current_genericdef;
@@ -1063,6 +1064,14 @@ implementation
                add_typedconst_init_routine(current_structdef);
              consume(_END);
             end;
+         if (token=_ID) and (pattern='ALIGN') then
+           begin
+             consume(_ID);
+             alignment:=get_intconst.svalue;
+             if not(alignment in [1,2,4,8,16,32,64]) then
+             else
+               recst.recordalignment:=shortint(alignment);
+           end;
          { make the record size aligned (has to be done before inserting the
            parameters, because that may depend on the record's size) }
          recst.addalignmentpadding;

compiler/x86/nx86inl.pas

@@ -651,7 +651,7 @@ implementation
            LOC_MMREGISTER,LOC_CMMREGISTER:
              begin
                location:=lnode.location;
-               hlcg.location_force_fpureg(current_asmdata.CurrAsmList,location,resultdef,false);
+               hlcg.location_force_fpureg(current_asmdata.CurrAsmList,location,lnode.resultdef,false);
              end;
            else
              internalerror(309991);

packages/fcl-passrc/src/pasresolveeval.pas

@@ -4147,10 +4147,12 @@ function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
  //   Source codepage is needed for reading non ASCII string literals 'ä'.
  //   Target codepage is needed for reading non ASCII # literals.
  //   Target codepage costs time to compute.
+var
+  Value: TResEvalValue;
 
   procedure RangeError(id: TMaxPrecInt);
   begin
-    Result.Free;
+    Value.Free;
     RaiseRangeCheck(id,Expr);
   end;
 
@@ -4183,13 +4185,13 @@ var
   var
     h: RawByteString;
   begin
-    if Result.Kind=revkString then
+    if Value.Kind=revkString then
       begin
       // switch to unicodestring
-      h:=TResEvalString(Result).S;
-      Result.Free;
-      Result:=nil; // in case of exception in GetUnicodeStr
-      Result:=TResEvalUTF16.CreateValue(GetUnicodeStr(h,Expr));
+      h:=TResEvalString(Value).S;
+      Value.Free;
+      Value:=nil; // in case of exception in GetUnicodeStr
+      Value:=TResEvalUTF16.CreateValue(GetUnicodeStr(h,Expr));
       end;
   end;
 {$ENDIF}
@@ -4197,7 +4199,7 @@ var
   procedure AddSrc(h: String);
   {$ifdef FPC_HAS_CPSTRING}
   var
-    Value: TResEvalString;
+    ValueAnsi: TResEvalString;
     OnlyASCII: Boolean;
     i: Integer;
   {$ENDIF}
@@ -4216,13 +4218,13 @@ var
         break;
         end;
 
-    if Result.Kind=revkString then
+    if Value.Kind=revkString then
       begin
-      Value:=TResEvalString(Result);
-      if OnlyASCII and Value.OnlyASCII then
+      ValueAnsi:=TResEvalString(Value);
+      if OnlyASCII and ValueAnsi.OnlyASCII then
         begin
         // concatenate ascii strings
-        Value.S:=Value.S+h;
+        ValueAnsi.S:=ValueAnsi.S+h;
         exit;
         end;
 
@@ -4232,47 +4234,47 @@ var
       CP_UTF16:
         begin
         ForceUTF16;
-        TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+GetUnicodeStr(h,Expr);
-        //writeln('AddSrc len(h)=',length(h),' StringCodePage=',StringCodePage(h),' GetCodePage=',GetCodePage(h),' S=',length(TResEvalUTF16(Result).S));
+        TResEvalUTF16(Value).S:=TResEvalUTF16(Value).S+GetUnicodeStr(h,Expr);
+        //writeln('AddSrc len(h)=',length(h),' StringCodePage=',StringCodePage(h),' GetCodePage=',GetCodePage(h),' S=',length(TResEvalUTF16(Value).S));
         end;
       CP_UTF16BE:
         RaiseNotYetImplemented(20201220222608,Expr);
       else
         begin
-        if Value.S<>'' then
+        if ValueAnsi.S<>'' then
         begin
-          if Value.OnlyASCII then
-            SetCodePage(Value.S,TargetCP,false);
-          Value.S:=Value.S+h;
+          if ValueAnsi.OnlyASCII then
+            SetCodePage(ValueAnsi.S,TargetCP,false);
+          ValueAnsi.S:=ValueAnsi.S+h;
         end else begin
-          Value.S:=h;
+          ValueAnsi.S:=h;
         end;
         end;
       end;
 
       end
     else
-      TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+GetUnicodeStr(h,Expr);
+      TResEvalUTF16(Value).S:=TResEvalUTF16(Value).S+GetUnicodeStr(h,Expr);
     {$else}
-    TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+h;
+    TResEvalUTF16(Value).S:=TResEvalUTF16(Value).S+h;
     {$endif}
   end;
 
   procedure AddHash(u: longword);
   {$ifdef FPC_HAS_CPSTRING}
   begin
-    if Result.Kind=revkString then
-      TResEvalString(Result).s:=TResEvalString(Result).S+Chr(u)
+    if Value.Kind=revkString then
+      TResEvalString(Value).s:=TResEvalString(Value).S+Chr(u)
     else
-      TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
+      TResEvalUTF16(Value).S:=TResEvalUTF16(Value).S+WideChar(u);
   end;
   {$else}
   begin
-    TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
+    TResEvalUTF16(Value).S:=TResEvalUTF16(Value).S+WideChar(u);
   end;
   {$endif}
 
-  function ReadHash(Value: TResEvalValue; const S: string; p, l: integer): integer;
+  function ReadHash(const S: string; p, l: integer): integer;
   var
     StartP: Integer;
     u: longword;
@@ -4283,6 +4285,7 @@ var
     OldCP: TSystemCodePage;
     {$ENDIF}
   begin
+    //writeln('ReadHash S="',S,'" p=',p,' l=',l,' ',StringCodePage(S));
     Result:=p;
     inc(Result);
     if Result>l then
@@ -4402,9 +4405,9 @@ begin
   TargetCP:=CP_ACP;
   SourceCPValid:=false;
   SourceCP:=CP_ACP;
-  Result:=TResEvalString.Create;
+  Value:=TResEvalString.Create;
   {$else}
-  Result:=TResEvalUTF16.Create;
+  Value:=TResEvalUTF16.Create;
   {$endif}
   p:=1;
   //writeln('TResExprEvaluator.EvalPrimitiveExprString ',GetObjPath(Expr),' ',Expr.SourceFilename,' ',Expr.SourceLinenumber div 2048,' S=[',S,']');
@@ -4442,7 +4445,7 @@ begin
         AddSrc(copy(S,StartP,p-StartP));
       end;
     '#':
-      p:=ReadHash(Result,S,p,l);
+      p:=ReadHash(S,p,l);
     '^':
       begin
       // ^A is #1
@@ -4460,6 +4463,7 @@ begin
     else
       RaiseNotYetImplemented(20170523123815,Expr,'ord='+IntToStr(ord(S[p])));
     end;
+  Result:=Value;
   {$IFDEF VerbosePasResEval}
   //writeln('TResExprEvaluator.EvalPrimitiveExprString Result=',Result.AsString);
   {$ENDIF}

packages/fcl-passrc/src/pasresolver.pp

@@ -4734,7 +4734,7 @@ end;
 
 procedure TPasResolver.GetParamsOfNameExpr(El: TPasExpr; out
   ParentParams: TPRParentParams);
-// Checks is El is the name expression of a call or array access
+// Checks if El is the name expression of a call or array access
 // For example: a.b.El()  a.El[]
 // Note: TPasParser guarantees that there is at most one TBinaryExpr
 //       and one TInlineSpecializeExpr between El and TParamsExpr
@@ -10176,7 +10176,6 @@ begin
   if ParentParams.InlineSpec<>nil then
     begin
     TypeCnt:=InlParams.Count;
-    // ToDo: generic functions without params
     DeclEl:=FindGenericEl(aName,TypeCnt,FindData,El);
     if DeclEl<>nil then
       begin
@@ -10207,9 +10206,19 @@ begin
       begin
       TemplTypes:=GetProcTemplateTypes(Proc);
       if (TemplTypes<>nil) then
+        begin
         // implicit function specialization without bracket
+        {$IFDEF VerbosePasResolver}
+        DeclEl:=El;
+        while DeclEl.Parent is TPasExpr do
+          DeclEl:=DeclEl.Parent;
+        {AllowWriteln}
+        writeln('TPasResolver.ResolveNameExpr ',WritePasElTree(TPasExpr(DeclEl),'  '));
+        {AllowWriteln-}
+        {$ENDIF}
         RaiseMsg(20191007222004,nCouldNotInferTypeArgXForMethodY,
           sCouldNotInferTypeArgXForMethodY,[TPasGenericTemplateType(TemplTypes[0]).Name,Proc.Name],El);
+        end;
       end;
 
     if El.Parent.ClassType=TPasProperty then
@@ -10757,7 +10766,7 @@ begin
   else if Value.ClassType=TInlineSpecializeExpr then
     begin
     // e.g. Name<>()
-    ResolveInlineSpecializeExpr(TInlineSpecializeExpr(Value),rraRead);
+    ResolveInlineSpecializeExpr(TInlineSpecializeExpr(Value),Access);
     end
   else if Value.ClassType=TParamsExpr then
     begin
@@ -27370,7 +27379,7 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
             end
           else if ParentNeedsExprResult(Expr) then
             begin
-            // a procedure
+            // a procedure address
             exit;
             end;
           if rcSetReferenceFlags in Flags then
@@ -28235,6 +28244,8 @@ begin
     else
       Result:=true;
     end
+  else if C=TInlineSpecializeExpr then
+    Result:=ParentNeedsExprResult(TInlineSpecializeExpr(P))
   else if C.InheritsFrom(TPasExpr) then
     Result:=true
   else if (C=TPasEnumValue)

packages/fcl-passrc/src/pastree.pp

@@ -1789,6 +1789,7 @@ function GenericTemplateTypesAsString(List: TFPList): string;
 procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
 
 function dbgs(const s: TProcTypeModifiers): string; overload;
+function WritePasElTree(Expr: TPasExpr; FollowPrefix: string = ''): string;
 
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
@@ -1903,6 +1904,77 @@ begin
   Result:='['+Result+']';
 end;
 
+function WritePasElTree(Expr: TPasExpr; FollowPrefix: string): string;
+{  TBinary Kind= OpCode=
+    +Left=TBinary Kind= OpCode=
+    | +Left=TParamsExpr[]
+    | | +Value=Prim Kind= Value=
+    | | +Params[1]=Prim Kind= Value=
+    +Right=Prim
+}
+var
+  C: TClass;
+  s: string;
+  ParamsExpr: TParamsExpr;
+  InlineSpecExpr: TInlineSpecializeExpr;
+  SubEl: TPasElement;
+  ArrayValues: TArrayValues;
+  i: Integer;
+begin
+  if Expr=nil then exit('nil');
+  C:=Expr.ClassType;
+
+  Result:=C.ClassName;
+  str(Expr.Kind,s);
+  Result:=Result+' '+s;
+  str(Expr.OpCode,s);
+  Result:=Result+' '+s;
+
+  if C=TPrimitiveExpr then
+    Result:=Result+' Value="'+TPrimitiveExpr(Expr).Value+'"'
+  else if C=TUnaryExpr then
+    Result:=Result+' Operand='+WritePasElTree(TUnaryExpr(Expr).Operand,FollowPrefix)
+  else if C=TBoolConstExpr then
+    Result:=Result+' Value='+BoolToStr(TBoolConstExpr(Expr).Value,'True','False')
+  else if C=TArrayValues then
+    begin
+    ArrayValues:=TArrayValues(Expr);
+    for i:=0 to length(ArrayValues.Values)-1 do
+      Result:=Result+sLineBreak+FollowPrefix+'+Values['+IntToStr(i)+']='+WritePasElTree(ArrayValues.Values[i],FollowPrefix+'| ');
+    end
+  else if C=TBinaryExpr then
+    begin
+    Result:=Result+sLineBreak+FollowPrefix+'+Left='+WritePasElTree(TBinaryExpr(Expr).left,FollowPrefix+'| ');
+    Result:=Result+sLineBreak+FollowPrefix+'+Right='+WritePasElTree(TBinaryExpr(Expr).right,FollowPrefix+'| ');
+    end
+  else if C=TParamsExpr then
+    begin
+    ParamsExpr:=TParamsExpr(Expr);
+    Result:=Result+sLineBreak+FollowPrefix+'+Value='+WritePasElTree(ParamsExpr.Value,FollowPrefix+'| ');
+    for i:=0 to length(ParamsExpr.Params)-1 do
+      Result:=Result+sLineBreak+FollowPrefix+'+Params['+IntToStr(i)+']='+WritePasElTree(ParamsExpr.Params[i],FollowPrefix+'| ');
+    end
+  else if C=TInlineSpecializeExpr then
+    begin
+    InlineSpecExpr:=TInlineSpecializeExpr(Expr);
+    Result:=Result+sLineBreak+FollowPrefix+'+Name='+WritePasElTree(InlineSpecExpr.NameExpr,FollowPrefix+'| ');
+    if InlineSpecExpr.Params<>nil then
+      for i:=0 to InlineSpecExpr.Params.Count-1 do
+        begin
+        Result:=Result+sLineBreak+FollowPrefix+'+Params['+IntToStr(i)+']=';
+        SubEl:=TPasElement(InlineSpecExpr.Params[i]);
+        if SubEl=nil then
+          Result:=Result+'nil'
+        else if SubEl is TPasExpr then
+          Result:=Result+WritePasElTree(TPasExpr(SubEl),FollowPrefix+'| ')
+        else
+          Result:=Result+SubEl.Name+':'+SubEl.ClassName;
+        end;
+    end
+  else
+    Result:=C.ClassName+' Kind=';
+end;
+
 Function IndentStrings(S : TStrings; indent : Integer) : string;
 Var
   I,CurrLen,CurrPos : Integer;

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -62,6 +62,10 @@ const
   // non fpc hints
   nPAParameterInOverrideNotUsed = 4501;
   sPAParameterInOverrideNotUsed = 'Parameter "%s" not used';
+  nPAFieldNotUsed = 4502;
+  sPAFieldNotUsed = 'Field "%s" not used';
+  nPAFieldIsAssignedButNeverUsed = 4503;
+  sPAFieldIsAssignedButNeverUsed = 'Field "%s" is assigned but never used';
   // fpc hints: use same IDs as fpc
   nPAUnitNotUsed = 5023;
   sPAUnitNotUsed = 'Unit "%s" not used in %s';
@@ -2827,8 +2831,14 @@ begin
           sPAPrivateFieldIsNeverUsed,[El.FullName],El);
       end
     else if El.ClassType=TPasVariable then
-      EmitMessage(20170311234201,mtHint,nPALocalVariableNotUsed,
-        sPALocalVariableNotUsed,[El.Name],El)
+      begin
+      if El.Parent is TPasMembersType then
+        EmitMessage(20201229033108,mtHint,nPAFieldNotUsed,
+          sPAFieldNotUsed,[El.Name],El)
+      else
+        EmitMessage(20170311234201,mtHint,nPALocalVariableNotUsed,
+          sPALocalVariableNotUsed,[El.Name],El);
+      end
     else
       EmitMessage(20170314221334,mtHint,nPALocalXYNotUsed,
         sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
@@ -2842,6 +2852,9 @@ begin
     if El.Visibility in [visPrivate,visStrictPrivate] then
       EmitMessage(20170311234159,mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
         sPAPrivateFieldIsAssignedButNeverUsed,[El.FullName],El)
+    else if El.Parent is TPasMembersType then
+      EmitMessage(20201229033618,mtHint,nPAFieldIsAssignedButNeverUsed,
+        sPAFieldIsAssignedButNeverUsed,[El.Name],El)
     else
       EmitMessage(20170311233825,mtHint,nPALocalVariableIsAssignedButNeverUsed,
         sPALocalVariableIsAssignedButNeverUsed,[El.Name],El);

packages/fcl-passrc/src/pparser.pp

@@ -2527,11 +2527,16 @@ begin
         NextToken;
         if CurToken=tkspecialize then
           begin
+          // Obj.specialize ...
           if CanSpecialize=aMust then
             CheckToken(tkLessThan);
           CanSpecialize:=aMust;
           NextToken;
-          end;
+          end
+        else if msDelphi in CurrentModeswitches then
+          CanSpecialize:=aCan
+        else
+          CanSpecialize:=aCannot;
         if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are sub identifiers as well
           begin
           aName:=aName+'.'+CurTokenString;

packages/fcl-passrc/src/pscanner.pp

@@ -3106,7 +3106,8 @@ end;
 function TPascalScanner.FetchToken: TToken;
 
 begin
-  FPreviousToken:=FCurToken;
+  if Not (FCurToken in [tkWhiteSpace,tkLineEnding]) then
+    FPreviousToken:=FCurToken;
   while true do
   begin
     Result := DoFetchToken;
@@ -5051,8 +5052,7 @@ begin
       begin
       if ForceCaret or PPisSkipping or
          (PreviousToken in [tkeof,tkTab,tkLineEnding,tkComment,tkIdentifier,
-                   tkNil,tkOperator,tkBraceClose,tkSquaredBraceClose,tkCaret,
-                   tkWhitespace]) then
+                   tkNil,tkOperator,tkBraceClose,tkSquaredBraceClose,tkCaret]) then
         begin
         Inc(FTokenPos);
         Result := tkCaret;

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -156,7 +156,7 @@ type
     procedure TestGenProc_TypeParamCntOverload;
     procedure TestGenProc_TypeParamCntOverloadNoParams;
     procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
-    procedure TestGenProc_ParamSpecWithT; // ToDo: Func<T>(Bird: TBird<T>)
+    procedure TestGenProc_ParamSpecWithT;
     // ToDo: NestedResultAssign
 
     // generic function infer types
@@ -186,6 +186,7 @@ type
     procedure TestGenMethod_OverloadTypeParamCntDelphi;
     procedure TestGenMethod_OverloadArgs;
     procedure TestGenMethod_TypeCastParam;
+    procedure TestGenMethod_TypeCastIdentDot;
   end;
 
 implementation
@@ -3010,6 +3011,32 @@ begin
   ParseUnit;
 end;
 
+procedure TTestResolveGenerics.TestGenMethod_TypeCastIdentDot;
+begin
+  StartUnit(false);
+  Add([
+  '{$mode delphi}',
+  'interface',
+  'type',
+  '  TObject = class end;',
+  '  TBird = class end;',
+  '  TEagle = class(TBird)',
+  '    procedure Run<S>(p: S);',
+  '    procedure Fly;',
+  '  end;',
+  'implementation',
+  'procedure TEagle.Run<S>(p: S);',
+  'begin',
+  'end;',
+  'procedure TEagle.Fly;',
+  'var Bird: TBird;',
+  'begin',
+  '  TEagle(Bird).Run<word>(3);',
+  'end;',
+  '']);
+  ParseUnit;
+end;
+
 initialization
   RegisterTests([TTestResolveGenerics]);
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -3544,7 +3544,8 @@ begin
   '  s[9+1]:=''b'';',
   '  s[10]:='''''''';',
   '  s[11]:=^g;',
-  '  s[12]:=^H;']);
+  '  s[12]:=^H;',
+  '']);
   ParseProgram;
 end;
 
@@ -3622,6 +3623,7 @@ begin
   '  m=low(char)+high(char);',
   '  n = string(''A'');',
   '  o = UnicodeString(''A'');',
+  //'  p = ^C''bird'';',
   'begin']);
   ParseProgram;
   CheckResolverUnexpectedHints;

packages/fcl-passrc/tests/tcscanner.pas

@@ -115,6 +115,7 @@ type
     procedure TestNumber;
     procedure TestChar;
     procedure TestCharString;
+    procedure TestCaretString;
     procedure TestBraceOpen;
     procedure TestBraceClose;
     procedure TestMul;
@@ -831,6 +832,12 @@ begin
   TestToken(pscanner.tkChar,'''A''');
 end;
 
+procedure TTestScanner.TestCaretString;
+begin
+
+  TestTokens([tkIdentifier,tkWhiteSpace,tkEqual,tkwhiteSpace,pscanner.tkString,tkSemicolon],'a = ^C''abc'';',false);
+end;
+
 procedure TTestScanner.TestNumber;
 
 begin

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -945,9 +945,9 @@ begin
   'begin',
   '  DoIt;']);
   AnalyzeProgram;
-  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "b" not used');
-  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
-    'Local variable "c" is assigned but never used');
+  CheckUseAnalyzerHint(mtHint,nPAFieldNotUsed,'Field "b" not used');
+  CheckUseAnalyzerHint(mtHint,nPAFieldIsAssignedButNeverUsed,
+    'Field "c" is assigned but never used');
   CheckUseAnalyzerUnexpectedHints;
 end;
 
@@ -2278,9 +2278,9 @@ begin
   Add('begin');
   Add('  Point(1);');
   AnalyzeProgram;
-  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
-    'Local variable "X" is assigned but never used');
-  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
+  CheckUseAnalyzerHint(mtHint,nPAFieldIsAssignedButNeverUsed,
+    'Field "X" is assigned but never used');
+  CheckUseAnalyzerHint(mtHint,nPAFieldNotUsed,'Field "Y" not used');
   CheckUseAnalyzerUnexpectedHints;
 end;
 
@@ -2319,7 +2319,7 @@ begin
   Add('begin');
   Add('  Point();');
   AnalyzeProgram;
-  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
+  CheckUseAnalyzerHint(mtHint,nPAFieldNotUsed,'Field "Y" not used');
   CheckUseAnalyzerUnexpectedHints;
 end;
 
@@ -2385,7 +2385,7 @@ begin
   '  specialize Point<word>();',
   '']);
   AnalyzeProgram;
-  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
+  CheckUseAnalyzerHint(mtHint,nPAFieldNotUsed,'Field "Y" not used');
   CheckUseAnalyzerUnexpectedHints;
 end;
 

packages/pastojs/src/fppas2js.pp

@@ -2399,6 +2399,7 @@ const
   TempRefSetPathName = 's';
   TempRefParamName = 'a';
   IdentChars = ['0'..'9', 'A'..'Z', 'a'..'z','_'];
+  AwaitSignature2 = 'function await(aType,TJSPromise):aType';
 
 function CodePointToJSString(u: longword): TJSString;
 begin
@@ -5956,12 +5957,10 @@ end;
 
 function TPas2JSResolver.BI_AWait_OnGetCallCompatibility(
   Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
-// await(T; p: TJSPromise): T;
+// await(T; p: TJSPromise): T
+// await(T; jsvalue): T
+// await(AsyncFuncWithResultT): T
 // await(AsyncProc);
-// await(Proc);
-// await(const Expr: T): T
-const
-  Signature2 = 'function await(aType,TJSPromise):aType';
 var
   Params: TParamsExpr;
   Param: TPasExpr;
@@ -5991,6 +5990,48 @@ begin
     // must be the only parameter
     Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
     if Result=cIncompatible then exit;
+
+    TypeEl:=ParamResolved.LoTypeEl;
+    if (ParamResolved.IdentEl is TPasResultElement) then
+      begin
+      // await(AsyncFuncCall)
+      if not TPasFunctionType(ParamResolved.IdentEl.Parent).IsAsync then
+        begin
+        {$IFDEF VerbosePas2JS}
+        writeln('TPas2JSResolver.BI_AWait_OnGetCallCompatibility ',GetResolverResultDbg(ParamResolved));
+        {$ENDIF}
+        if RaiseOnError then
+          RaiseMsg(20201229232446,nXExpectedButYFound,sXExpectedButYFound,['async function',GetResolverResultDescription(ParamResolved)],Expr)
+        else
+          exit(cIncompatible);
+        end;
+      end
+    else if (ParamResolved.BaseType=btContext)
+        and (TypeEl is TPasProcedureType) then
+      begin
+      // await(AsyncFuncTypeVar)
+      if not TPasProcedureType(TypeEl).IsAsync then
+        begin
+        {$IFDEF VerbosePas2JS}
+        writeln('TPas2JSResolver.BI_AWait_OnGetCallCompatibility ',GetResolverResultDbg(ParamResolved));
+        {$ENDIF}
+        if RaiseOnError then
+          RaiseMsg(20201229232541,nXExpectedButYFound,sXExpectedButYFound,['async function',GetResolverResultDescription(ParamResolved)],Expr)
+        else
+          exit(cIncompatible);
+        end;
+      end
+    else
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPas2JSResolver.BI_AWait_OnGetCallCompatibility ',GetResolverResultDbg(ParamResolved));
+      {$ENDIF}
+      if RaiseOnError then
+        RaiseMsg(20201229224920,nXExpectedButYFound,sXExpectedButYFound,['async function',GetResolverResultDescription(ParamResolved)],Expr)
+      else
+        exit(cIncompatible);
+      end;
+
     end
   else if ParamResolved.BaseType=btProc then
     begin
@@ -6028,7 +6069,7 @@ begin
       begin
       if RaiseOnError then
         RaiseMsg(20200520090749,nWrongNumberOfParametersForCallTo,
-          sWrongNumberOfParametersForCallTo,[Signature2],Params);
+          sWrongNumberOfParametersForCallTo,[AwaitSignature2],Params);
       exit(cIncompatible);
       end;
 
@@ -6062,14 +6103,21 @@ begin
         exit(CheckRaiseTypeArgNo(20200520091707,2,Param,Param2Resolved,
            'instance of TJSPromise',RaiseOnError));
 
-      if (Param2Resolved.BaseType<>btContext)
-          or not (Param2Resolved.LoTypeEl is TPasClassType)
-          or not IsExternalClass_Name(TPasClassType(Param2Resolved.LoTypeEl),'Promise') then
-        exit(CheckRaiseTypeArgNo(20200520091707,2,Param,Param2Resolved,
+      if (Param2Resolved.BaseType=btContext)
+          and (Param2Resolved.LoTypeEl is TPasClassType)
+          and IsExternalClass_Name(TPasClassType(Param2Resolved.LoTypeEl),'Promise') then
+        // await(T,aPromise)
+      else if IsJSBaseType(Param2Resolved,pbtJSValue) then
+        // await(T,jsvalue)
+      else if (Param2Resolved.IdentEl is TPasArgument)
+          and (Param2Resolved.LoTypeEl=nil) then
+        // await(T,UntypedArg)
+      else
+        exit(CheckRaiseTypeArgNo(20200520091708,2,Param,Param2Resolved,
            'TJSPromise',RaiseOnError));
       end;
 
-    Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError,Signature2);
+    Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError,AwaitSignature2);
     end;
 end;
 
@@ -6084,11 +6132,18 @@ begin
   Param:=Params.Params[0];
   if length(Params.Params)=1 then
     begin
-    // await(expr)
+    // await(AsyncFuncCall)
     if CheckCallAsyncFuncResult(Param,ResolvedEl) then
+      begin
       // await(CallAsynFuncResultT): T
+      if (ResolvedEl.BaseType=btContext)
+          and (ResolvedEl.LoTypeEl is TPasClassType)
+          and IsExternalClass_Name(TPasClassType(ResolvedEl.LoTypeEl),'Promise') then
+        // async function returns a promise, await resolve all promises -> need final type as first param
+        RaiseMsg(20201229235932,nWrongNumberOfParametersForCallTo,
+          sWrongNumberOfParametersForCallTo,[AwaitSignature2],Param);
       exit;
-    // await(expr:T):T
+      end;
     end
   else
     begin

packages/pastojs/tests/tcgenerics.pas

@@ -77,7 +77,8 @@ type
     // ToDo: FuncName:= instead of Result:=
 
     // generic methods
-    procedure TestGenMethod_ObjFPC;
+    procedure TestGenMethod_ImplicitSpec_ObjFPC;
+    procedure TestGenMethod_Delphi;
 
     // generic array
     procedure TestGen_Array_OtherUnit;
@@ -2135,7 +2136,7 @@ begin
     '']));
 end;
 
-procedure TTestGenerics.TestGenMethod_ObjFPC;
+procedure TTestGenerics.TestGenMethod_ImplicitSpec_ObjFPC;
 begin
   StartProgram(false);
   Add([
@@ -2166,7 +2167,7 @@ begin
   '  o.{@C}Run(''foo'',''bar'');',
   '']);
   ConvertProgram;
-  CheckSource('TestGenMethod_ObjFPC',
+  CheckSource('TestGenMethod_ImplicitSpec_ObjFPC',
     LinesToStr([ // statements
     'rtl.createClass(this, "TObject", null, function () {',
     '  this.$init = function () {',
@@ -2192,6 +2193,49 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGenMethod_Delphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '    procedure Run<S>;',
+  '  end; ',
+  'procedure TObject.Run<S>;',
+  'begin',
+  'end;',
+  'var o: TObject;',
+  'begin',
+  '  o.Run<word>;',
+  '  o.Run<word>();',
+  '  with o do begin',
+  '    Run<word>;',
+  '    Run<word>();',
+  '  end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenMethod_Delphi',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Run$G1 = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.o.Run$G1();',
+    '$mod.o.Run$G1();',
+    'var $with = $mod.o;',
+    '$with.Run$G1();',
+    '$with.Run$G1();',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_Array_OtherUnit;
 begin
   WithTypeInfo:=true;

packages/pastojs/tests/tcmodules.pas

@@ -883,8 +883,11 @@ type
     Procedure TestAwait_NonPromiseWithTypeFail;
     Procedure TestAwait_AsyncCallTypeMismatch;
     Procedure TestAWait_OutsideAsyncFail;
-    Procedure TestAWait_Result;
+    Procedure TestAWait_IntegerFail;
     Procedure TestAWait_ExternalClassPromise;
+    Procedure TestAWait_JSValue;
+    Procedure TestAWait_Result;
+    Procedure TestAWait_ResultPromiseMissingTypeFail;
     Procedure TestAsync_AnonymousProc;
     Procedure TestAsync_ProcType;
     Procedure TestAsync_ProcTypeAsyncModMismatchFail;
@@ -32619,48 +32622,21 @@ begin
   ConvertProgram;
 end;
 
-procedure TTestModule.TestAWait_Result;
+procedure TTestModule.TestAWait_IntegerFail;
 begin
   StartProgram(false);
   Add([
-  '{$modeswitch externalclass}',
-  'type',
-  '  TJSPromise = class external name ''Promise''',
-  '  end;',
-  'function Crawl(d: double = 1.3): word; ',
+  'function Run: word;',
   'begin',
   'end;',
-  'function Run(d: double = 1.6): word; async;',
+  'procedure Fly(w: word); async;',
   'begin',
-  '  Result:=await(1);',
-  '  Result:=await(Crawl);',
-  '  Result:=await(Crawl(4.5));',
-  '  Result:=await(Run);',
-  '  Result:=await(Run(6.7));',
+  '  await(Run());',
   'end;',
   'begin',
-  '  Run(1);']);
+  '  Fly(1);']);
+  SetExpectedPasResolverError('async function expected, but Result:Word found',nXExpectedButYFound);
   ConvertProgram;
-  CheckSource('TestAWait_Result',
-    LinesToStr([ // statements
-    'this.Crawl = function (d) {',
-    '  var Result = 0;',
-    '  return Result;',
-    '};',
-    'this.Run = async function (d) {',
-    '  var Result = 0;',
-    '  Result = await 1;',
-    '  Result = await $mod.Crawl(1.3);',
-    '  Result = await $mod.Crawl(4.5);',
-    '  Result = await $mod.Run(1.6);',
-    '  Result = await $mod.Run(6.7);',
-    '  return Result;',
-    '};',
-    '']),
-    LinesToStr([
-    '$mod.Run(1);'
-    ]));
-  SetExpectedPasResolverError('Await without promise',nAwaitWithoutPromise);
 end;
 
 procedure TTestModule.TestAWait_ExternalClassPromise;
@@ -32723,6 +32699,110 @@ begin
   CheckResolverUnexpectedHints();
 end;
 
+procedure TTestModule.TestAWait_JSValue;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSPromise = class external name ''Promise''',
+  '  end;',
+  'function Fly(w: word): jsvalue; async;',
+  'begin',
+  'end;',
+  'function Run(d: jsvalue; var e): word; async;',
+  'begin',
+  '  Result:=await(word,d);', // promise needs type
+  '  d:=await(Fly(4));', // async non promise must omit the type
+  '  Result:=await(word,e);', // promise needs type
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAWait_JSValue',
+    LinesToStr([ // statements
+    'this.Fly = async function (w) {',
+    '  var Result = undefined;',
+    '  return Result;',
+    '};',
+    'this.Run = async function (d, e) {',
+    '  var Result = 0;',
+    '  Result = await d;',
+    '  d = await $mod.Fly(4);',
+    '  Result = await e.get();',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    ]));
+  CheckResolverUnexpectedHints();
+end;
+
+procedure TTestModule.TestAWait_Result;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSPromise = class external name ''Promise''',
+  '  end;',
+  'function Crawl(d: double = 1.3): TJSPromise; ',
+  'begin',
+  'end;',
+  'function Run(d: double = 1.6): word; async;',
+  'begin',
+  '  Result:=await(word,Crawl);',
+  '  Result:=await(word,Crawl(4.5));',
+  '  Result:=await(Run);',
+  '  Result:=await(Run(6.7));',
+  'end;',
+  'begin',
+  '  Run(1);']);
+  ConvertProgram;
+  CheckSource('TestAWait_Result',
+    LinesToStr([ // statements
+    'this.Crawl = function (d) {',
+    '  var Result = null;',
+    '  return Result;',
+    '};',
+    'this.Run = async function (d) {',
+    '  var Result = 0;',
+    '  Result = await $mod.Crawl(1.3);',
+    '  Result = await $mod.Crawl(4.5);',
+    '  Result = await $mod.Run(1.6);',
+    '  Result = await $mod.Run(6.7);',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.Run(1);'
+    ]));
+  CheckResolverUnexpectedHints();
+end;
+
+procedure TTestModule.TestAWait_ResultPromiseMissingTypeFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSPromise = class external name ''Promise''',
+  '  end;',
+  'function Run: TJSPromise; async;',
+  'begin',
+  'end;',
+  'procedure Fly(w: word); async;',
+  'begin',
+  '  await(Run());',
+  'end;',
+  'begin',
+  '  Fly(1);']);
+  SetExpectedPasResolverError('Wrong number of parameters specified for call to "function await(aType,TJSPromise):aType"',
+    nWrongNumberOfParametersForCallTo);
+  ConvertProgram;
+end;
+
 procedure TTestModule.TestAsync_AnonymousProc;
 begin
   StartProgram(false);

packages/winunits-base/src/activex.pp

@@ -4541,7 +4541,7 @@ type
   procedure CoTaskMemFree(_para1:PVOID);stdcall; external  'ole32.dll' name 'CoTaskMemFree';
 
 {$ifndef wince}
-  function CreateDataAdviseHolder(_para1:IDataAdviseHolder):HRESULT;stdcall; external  'ole32.dll' name 'CreateDataAdviseHolder';
+  function CreateDataAdviseHolder(out _para1:IDataAdviseHolder):HRESULT;stdcall; external  'ole32.dll' name 'CreateDataAdviseHolder';
   function CreateDataCache(_para1:IUnknown; const _para2:TCLSID; const _para3:TIID; out _para4):HRESULT;stdcall; external  'ole32.dll' name 'CreateDataCache';
 {$endif wince}
 

tests/test/cg/tm128.pp

@@ -1,14 +1,10 @@
 {$ASSERTIONS ON}
-{$packrecords c}
-{$push}
-{$codealign recordmin=16}
 
 type
   tm128 = record
     case byte of
       1 : (m128_f32 : array[0..3] of single;)
-  end;
-{$pop}
+  end align 16;
 
 type
   tm128_unaligned = record

tests/webtbs/tw28927.pp

@@ -0,0 +1,39 @@
+type
+  TRecord1 = record
+  end align 16;
+
+  TRecord2 = record
+  end align 8;
+
+  TRecord3 = record
+  end align 4;
+
+  TRecord1Outer = record  
+    b : Byte;
+    Record1 : TRecord1;
+  end;
+
+  TRecord2Outer = record  
+    b : Byte;
+    Record2 : TRecord2;
+  end;
+
+  TRecord3Outer = record  
+    b : Byte;
+    Record3 : TRecord3;
+  end;
+
+var
+  Record1Outer : TRecord1Outer;
+  Record2Outer : TRecord2Outer;
+  Record3Outer : TRecord3Outer;
+
+begin
+  if PtrUInt(@Record1Outer.Record1) mod 16<>0 then
+    halt(1);
+  if PtrUInt(@Record2Outer.Record2) mod 8<>0 then
+    halt(2);
+  if PtrUInt(@Record3Outer.Record3) mod 4<>0 then
+    halt(3);
+  writeln('ok');
+end.

tests/webtbs/tw38259.pp

@@ -0,0 +1,17 @@
+{ %OPT=-O3 -Sew -vw }
+{$mode objfpc}
+{$inline on}
+
+procedure test; inline;
+begin
+  exit;
+end;
+
+function f: longint;
+begin
+  test; // tt.pp(11,3) Warning: Function result variable does not seem to be initialized
+  result:=4;
+end;
+
+begin
+end.

utils/pas2js/docs/translation.html

@@ -3060,9 +3060,9 @@ End.
     Pas2js supports the JS operators async and await to simplify the use of Promise.
     The await operator corresponds to three intrinsic Pas2js functions:
     <ul>
-    <li><i>function await(AsyncFunctionWithResultT): T;</i>  // implicit promise</li>
+    <li><i>function await(AsyncFunctionWithResultT()): T;</i>  // implicit promise, the inner () can be omitted</li>
     <li><i>function await(aType; p: TJSPromise): aType;</i>  // explicit promise requires the resolved type</li>
-    <li><i>function await(const Expr: T): T;</i>  // implicit promise</li>
+    <li><i>function await(aType; j: jsvalue): aType;</i>  // explicit promise requires the resolved type</li>
     </ul>
     The await function can only be used inside a procedure with the async modifier.<br>
     Example for the explicit promise: