* Better parsing and declaration of record types

git-svn-id: trunk@31183 -

packages/fcl-passrc/src/pastree.pp

@@ -481,6 +481,7 @@ type
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
+    function GetDeclaration(full : boolean) : string; override;
   public
     Values: TFPList;
     Members: TPasRecordType;
@@ -489,6 +490,8 @@ type
   { TPasRecordType }
 
   TPasRecordType = class(TPasType)
+  private
+    procedure GetMembers(S: TStrings);
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
@@ -502,11 +505,12 @@ type
     Variants: TFPList;	// array of TPasVariant elements, may be nil!
     Function IsPacked: Boolean;
     Function IsBitPacked : Boolean;
+    Function IsAdvancedRecord : Boolean;
   end;
 
   TPasGenericTemplateType = Class(TPasElement);
   TPasObjKind = (okObject, okClass, okInterface, okGeneric, okSpecialize,
-                 okClassHelper,okRecordHelper);
+                 okClassHelper,okRecordHelper,okTypeHelper);
 
   { TPasClassType }
 
@@ -1168,7 +1172,7 @@ const
     'default', 'private', 'protected', 'public', 'published', 'automated','strict private', 'strict protected');
 
   ObjKindNames: array[TPasObjKind] of string = (
-    'object', 'class', 'interface','class','class','class helper','record helper');
+    'object', 'class', 'interface','class','class','class helper','record helper','type helper');
   
   OpcodeStrings : Array[TExprOpCode] of string = 
        ('','+','-','*','/','div','mod','**',
@@ -1765,6 +1769,31 @@ begin
   inherited Destroy;
 end;
 
+function TPasVariant.GetDeclaration(full: boolean): string;
+
+Var
+  i : Integer;
+  S : TStrings;
+
+begin
+  Result:='';
+  For I:=0 to Values.Count-1 do
+    begin
+    if (Result<>'') then
+      Result:=Result+', ';
+    Result:=Result+TPasElement(Values[i]).GetDeclaration(False);
+    Result:=Result+': ('+sLineBreak;
+    S:=TStringList.Create;
+    try
+      Members.GetMembers(S);
+      Result:=Result+S.Text;
+    finally
+      S.Free;
+    end;
+    Result:=Result+');';
+    end;
+end;
+
 
 constructor TPasRecordType.Create(const AName: string; AParent: TPasElement);
 begin
@@ -2471,16 +2500,70 @@ begin
     ProcessHints(False,Result);
 end;
 
+procedure TPasRecordType.GetMembers(S: TStrings);
+
+Var
+  T : TStringList;
+  temp : string;
+  I,J : integer;
+  E : TPasElement;
+  CV : TPasMemberVisibility ;
+
+begin
+  T:=TStringList.Create;
+  try
+
+  CV:=visDefault;
+  For I:=0 to Members.Count-1 do
+    begin
+    E:=TPasElement(Members[i]);
+    if E.Visibility<>CV then
+      begin
+      CV:=E.Visibility;
+      if CV<>visDefault then
+        S.Add(VisibilityNames[CV]);
+      end;
+    Temp:=E.GetDeclaration(True);
+    If E is TPasProperty then
+      Temp:='property '+Temp;
+    If Pos(LineEnding,Temp)>0 then
+      begin
+      T.Text:=Temp;
+      For J:=0 to T.Count-1 do
+        if J=T.Count-1 then
+          S.Add('  '+T[J]+';')
+        else
+          S.Add('  '+T[J])
+      end
+    else
+      S.Add('  '+Temp+';');
+    end;
+  if Variants<>nil then
+    begin
+    temp:='case ';
+    if (VariantName<>'') then
+      temp:=Temp+variantName+' : ';
+    if (VariantType<>Nil) then
+      temp:=temp+VariantType.Name;
+    S.Add(temp+' of');
+    T.Clear;
+    For I:=0 to Variants.Count-1 do
+      T.Add(TPasVariant(Variants[i]).GetDeclaration(True));
+    S.AddStrings(T);
+    end;
+  finally
+    T.Free;
+  end;
+end;
+
 function TPasRecordType.GetDeclaration (full : boolean) : string;
 
 Var
-  S,T : TStringList;
+  S : TStringList;
   temp : string;
-  I,J : integer;
 
 begin
   S:=TStringList.Create;
-  T:=TStringList.Create;
   Try
     Temp:='record';
     If IsPacked then
@@ -2491,27 +2574,12 @@ begin
     If Full then
       Temp:=Name+' = '+Temp;
     S.Add(Temp);
-    For I:=0 to Members.Count-1 do
+    GetMembers(S);
-      begin
-      Temp:=TPasVariable(Members[i]).GetDeclaration(True);
-      If Pos(LineEnding,Temp)>0 then
-        begin
-        T.Text:=Temp;
-        For J:=0 to T.Count-1 do
-          if J=T.Count-1 then
-            S.Add('  '+T[J]+';')
-          else
-            S.Add('  '+T[J])
-        end
-      else
-        S.Add('  '+Temp+';');
-      end;
     S.Add('end');
     Result:=S.Text;
     ProcessHints(False, Result);
   finally
     S.free;
-    T.free;
   end;
 end;
 
@@ -2525,6 +2593,22 @@ begin
   Result:=(PackMode=pmBitPacked)
 end;
 
+function TPasRecordType.IsAdvancedRecord: Boolean;
+
+Var
+  I : Integer;
+
+begin
+  Result:=False;
+  I:=0;
+  While (Not Result) and (I<Members.Count) do
+    begin
+    Result:=TPasElement(Members[i]).InheritsFrom(TPasProcedureBase) or
+            TPasElement(Members[i]).InheritsFrom(TPasProperty);
+    Inc(I);
+    end;
+end;
+
 procedure TPasProcedureType.GetArguments(List : TStrings);
 
 Var

packages/fcl-passrc/src/pparser.pp

@@ -2510,6 +2510,7 @@ begin
     SaveComments(D);
     for i := 0 to VarNames.Count - 1 do
       begin
+      // Writeln(VarNames[i], AVisibility);
       VarEl:=TPasVariable(CreateElement(TPasVariable,VarNames[i],Parent,AVisibility));
       VarEl.VarType := VarType;
       // Procedure declaration eats the hints.
@@ -3756,7 +3757,7 @@ Var
   Prop : TPasProperty;
 
 begin
-  v:=visPublic;
+  v:=visDefault;
   while CurToken<>AEndToken do
     begin
     SaveComments;
@@ -3783,7 +3784,6 @@ begin
         end;
       tkIdentifier :
         begin
-        v:=visDefault;
 //        If (po_delphi in Scanner.Options) then
           if CheckVisibility(CurtokenString,v) then
             begin

packages/fcl-passrc/tests/testpassrc.lpi

@@ -30,7 +30,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestStatementParser.TestCallComment"/>
+        <CommandLineParams Value="--suite=TTestStatementParser.TestAsm"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">
@@ -74,11 +74,11 @@
       <Unit7>
         <Filename Value="tcvarparser.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="tcvarparser"/>
       </Unit7>
       <Unit8>
         <Filename Value="tcclasstype.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcclasstype"/>
       </Unit8>
       <Unit9>
         <Filename Value="tcexprparser.pas"/>
@@ -88,17 +88,18 @@
       <Unit10>
         <Filename Value="tcprocfunc.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcprocfunc"/>
       </Unit10>
       <Unit11>
         <Filename Value="tcpassrcutil.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcpassrcutil"/>
       </Unit11>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
+    <Target>
+      <Filename Value="testpassrc"/>
+    </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
       <OtherUnitFiles Value="../src"/>