fcl-passrc: started test for method param attributes

packages/fcl-passrc/src/pasresolver.pp

@@ -11994,38 +11994,35 @@ end;
 
 procedure TPasResolver.DeanonymizeType(El: TPasType);
 
-  procedure InsertInFront(NewParent: TPasElement; List: TFPList);
+  procedure InsertInFront(NewParent, Child: TPasElement; List: TFPList);
   var
     i: Integer;
     p, Prev: TPasElement;
   begin
-    p:=El.Parent;
-    if NewParent=p.Parent then
+    // e.g. m,n:array of longint; -> insert n$a in front of m
+    i:=List.Count-1;
+    while (i>=0) and (List[i]<>Pointer(Child)) do
+      dec(i);
+    // skip preview variables with shared type
+    if Child is TPasVariable then
       begin
-      // e.g. m,n:array of longint; -> insert n$a in front of m
-      i:=List.Count-1;
-      while (i>=0) and (List[i]<>Pointer(p)) do
-        dec(i);
-      if P is TPasVariable then
+      while (i>0) do
         begin
-        while (i>0) do
-          begin
-          Prev:=TPasElement(List[i-1]);
-          if (Prev.ClassType=P.ClassType) and (TPasVariable(Prev).VarType=TPasVariable(P).VarType) then
-            dec(i) // e.g. m,n: array of longint
-          else
-            break;
-          end;
+        Prev:=TPasElement(List[i-1]);
+        if (Prev.ClassType=Child.ClassType)
+            and (TPasVariable(Prev).VarType=TPasVariable(Child).VarType) then
+          dec(i) // e.g. m,n: array of longint
+        else
+          break;
         end;
-      if i<0 then
-        List.Add(El)
-      else
-        List.Insert(i,El);
-      end
-    else
-      begin
-      List.Add(El);
       end;
+    // skip attributes
+    while (i>0) and (TPasElement(List[i-1]).ClassType=TPasAttributes) do
+      dec(i);
+    if i<0 then
+      List.Add(El)
+    else
+      List.Insert(i,El);
     {$IFDEF VerbosePasResolver}
     if El.Parent<>NewParent then writeln('TPasResolver.DeanonymizeType.InsertInFront OldParent=',GetObjName(El.Parent),' -> ',GetObjPath(NewParent));
     {$ENDIF}
@@ -12034,7 +12031,7 @@ procedure TPasResolver.DeanonymizeType(El: TPasType);
 
 var
   Decl: TPasDeclarations;
-  p: TPasElement;
+  Child, p: TPasElement;
   MembersType: TPasMembersType;
   CurName: String;
 begin
@@ -12042,8 +12039,10 @@ begin
     exit;
   if (El.Name<>'') then
     RaiseNotYetImplemented(20220320121923,El);
+  if El.ClassType=TPasSpecializeType then exit;
 
   CurName:='';
+  Child:=El;
   p:=El.Parent;
   repeat
     if p=nil then
@@ -12059,13 +12058,13 @@ begin
       if p is TPasDeclarations then
         begin
         Decl:=TPasDeclarations(p);
-        InsertInFront(Decl,Decl.Declarations);
+        InsertInFront(Decl,Child,Decl.Declarations);
         Decl.Types.Add(El);
         end
       else if p is TPasMembersType then
         begin
         MembersType:=TPasMembersType(p);
-        InsertInFront(MembersType,MembersType.Members);
+        InsertInFront(MembersType,Child,MembersType.Members);
         end;
       break;
       end
@@ -12076,6 +12075,7 @@ begin
       else
         CurName:=p.Name;
       end;
+    Child:=p;
     p:=p.Parent;
   until false;
 end;
@@ -28019,7 +28019,7 @@ begin
       pekStringMultiLine:
         begin
         {$IFDEF VerbosePasResolver}
-        writeln('TPasResolver.ComputeElement pekStringMultiLine Value="',LeftStr(TPrimitiveExpr(El).Value,1,500),'"');
+        writeln('TPasResolver.ComputeElement pekStringMultiLine Value="',LeftStr(TPrimitiveExpr(El).Value,500),'"');
         {$ENDIF}
         SetResolverValueExpr(ResolvedEl,btString,
                              FBaseTypes[btString],FBaseTypes[btString],

packages/fcl-passrc/src/pparser.pp

@@ -4935,14 +4935,13 @@ begin
   ExportName:=DoParseExpression(Parent);
 end;
 
-
 // Full means that a full variable declaration is being parsed.
 procedure TPasParser.ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility;
   VarParseType: TDeclParseType);
 // on Exception the VarList is restored, no need to Release the new elements
 
 var
-  i, VarCnt: Integer;
+  i, AttrCnt, VarCnt: Integer;
   Value , aLibName, aExpName, AbsoluteExpr: TPasExpr;
   VarType: TPasType;
   VarEl: TPasVariable;
@@ -4958,6 +4957,7 @@ begin
   aExpName:=nil;
   AbsoluteExpr:=nil;
   AbsoluteLocString:='';
+  AttrCnt:=0;
   VarCnt:=0;
   ok:=false;
   IsUntyped:=False;
@@ -4971,6 +4971,7 @@ begin
       if msPrefixedAttributes in CurrentModeswitches then
         begin
         VarList.Add(ParseAttributes(Parent,false));
+        inc(AttrCnt);
         NextToken;
         end
       else
@@ -5002,14 +5003,19 @@ begin
 
     // read type
     VarType:=nil;
+
+    // VarEl is the last created TPasVariable
     if CurToken=tkColon then
       begin
       OldForceCaret:=Scanner.SetForceCaret(True);
       try
         VarType := ParseVarType(VarEl); // Note: this can insert elements into VarList!
+        if VarList[VarList.Count-1]<>Pointer(VarEl) then
+          raise Exception.Create('20241121115919'); // some element was added at end instead of in front (candidate: resolver DeanonymizeType)
       finally
         Scanner.SetForceCaret(OldForceCaret);
       end;
+
       // read type
       for i := VarList.Count-VarCnt to VarList.Count - 1 do
         begin
@@ -5022,6 +5028,7 @@ begin
     // read hints
     H:=CheckHint(Nil,False);
     // read value and location
+    // VarEl is the last created TPasVariable
     If VarParseType in [dptFull,dptInline]then
       GetVariableValueAndLocation(VarEl,IsUnTyped,Value,AbsoluteExpr,AbsoluteLocString);
     if VarCnt>1 then
@@ -5067,7 +5074,6 @@ begin
     for i := VarList.Count-VarCnt to VarList.Count - 1 do
       begin
       VarEl:=TPasVariable(VarList[i]);
-      // Writeln(VarEl.Name, AVisibility);
       // Procedure declaration eats the hints.
       if Assigned(VarType) and (VarType is TPasProcedureType) then
         VarEl.Hints:=VarType.Hints
@@ -5095,9 +5101,7 @@ begin
     ok:=true;
   finally
     if not ok then
-      begin
-      VarList.Count:=VarList.Count-VarCnt;
-      end;
+      VarList.Count:=VarList.Count-VarCnt-AttrCnt;
   end;
 end;
 
@@ -8449,25 +8453,7 @@ begin
   VarSt:=TPasInlineVarDeclStatement(CreateElement(TPasInlineVarDeclStatement,SrcPos));
   NewImplElement:=VarSt;
   CurBlock.AddElement(VarSt);
-  List := TFPList.Create;
-  try
-    Parser.ParseVarList(VarSt,List,visDefault,dptInline);
-    For I:=0 to List.Count-1 do
-      begin
-      V:=TPasVariable(List[i]);
-      List[i]:=Nil;
-      VarSt.Declarations.Add(V);
-      end;
-  finally
-     For I:=0 to List.count-1 do
-       if List[i]<>Nil then
-         begin
-         Obj:=TObject(List[I]);
-         Obj.Free;
-         end;
-     List.Free;
-  end;
-
+  Parser.ParseVarList(VarSt,VarSt.Declarations,visDefault,dptInline);
 end;
 
 function TPasParser.TParseStatementParams.ParseOn: boolean;

packages/fcl-passrc/tests/tcresolver.pas

@@ -1005,6 +1005,7 @@ type
     Procedure TestAttributes_NonConstParam_Fail;
     Procedure TestAttributes_UnknownAttrWarning;
     Procedure TestAttributes_Members;
+    Procedure TestAttributes_MethodParams; // todo
 
     // library
     Procedure TestLibrary_Empty;
@@ -19271,6 +19272,34 @@ begin
   CheckAttributeMarkers;
 end;
 
+procedure TTestResolver.TestAttributes_MethodParams;
+begin
+  exit;
+
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor {#create}Create;',
+  '  end;',
+  '  {#custom}TCustomAttribute = class',
+  '  end;',
+  '  TMyClass = class',
+  '    procedure Fly([{#attr__custom__create__size}TCustom]Size: word);',
+  '  end;',
+  'constructor TObject.Create;',
+  'begin',
+  'end;',
+  'procedure TMyClass.Fly(Size: word);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckAttributeMarkers;
+end;
+
 procedure TTestResolver.TestLibrary_Empty;
 begin
   StartLibrary(false);