Browse Source

--- Merging r15178 into '.':
U packages/fcl-passrc/src/pastree.pp
U packages/fcl-passrc/src/pparser.pp
--- Merging r15179 into '.':
G packages/fcl-passrc/src/pastree.pp
G packages/fcl-passrc/src/pparser.pp
--- Merging r15180 into '.':
G packages/fcl-passrc/src/pparser.pp
--- Merging r15181 into '.':
U utils/fpdoc/dglobals.pp

# revisions: 15178,15179,15180,15181
------------------------------------------------------------------------
r15178 | marco | 2010-04-26 10:20:16 +0200 (Mon, 26 Apr 2010) | 3 lines
Changed paths:
M /trunk/packages/fcl-passrc/src/pastree.pp
M /trunk/packages/fcl-passrc/src/pparser.pp

* Patch for class abstract and class sealed support by Dimitry Boyarintsev.
Mnatis 16340

------------------------------------------------------------------------
------------------------------------------------------------------------
r15179 | marco | 2010-04-26 10:25:10 +0200 (Mon, 26 Apr 2010) | 2 lines
Changed paths:
M /trunk/packages/fcl-passrc/src/pastree.pp
M /trunk/packages/fcl-passrc/src/pparser.pp

* patch from Dmitry Boyarintsev for Mantis 16346. Strict private/protected support for fcl pascal parser

------------------------------------------------------------------------
------------------------------------------------------------------------
r15180 | marco | 2010-04-26 10:28:38 +0200 (Mon, 26 Apr 2010) | 3 lines
Changed paths:
M /trunk/packages/fcl-passrc/src/pparser.pp

* fix for mantis 16347, support for filename in 'xxx' in unit clause
Partial patch by Dmitry Boyarintsev (filename is not stored in parse hierarchy)

------------------------------------------------------------------------
------------------------------------------------------------------------
r15181 | marco | 2010-04-26 12:08:02 +0200 (Mon, 26 Apr 2010) | 2 lines
Changed paths:
M /trunk/utils/fpdoc/dglobals.pp

* fixing fpdoc for strict protected/private additions.

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@16361 -

marco 14 years ago
parent
commit
7f3a963559
3 changed files with 53 additions and 3 deletions
  1. 10 2
      packages/fcl-passrc/src/pastree.pp
  2. 42 0
      packages/fcl-passrc/src/pparser.pp
  3. 1 1
      utils/fpdoc/dglobals.pp

+ 10 - 2
packages/fcl-passrc/src/pastree.pp

@@ -78,7 +78,8 @@ type
   TPasModule = class;
 
   TPasMemberVisibility = (visDefault, visPrivate, visProtected, visPublic,
-    visPublished, visAutomated);
+    visPublished, visAutomated,
+    visStrictPrivate, visStrictProtected);
 
   TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
 
@@ -349,6 +350,9 @@ type
     IsForward : Boolean;
     Members: TList;     // array of TPasElement objects
     InterfaceGUID : string; // 15/06/07 - Inoussa
+
+    ClassVars: TList;   // class vars
+    Modifiers: TStringList;
   end;
 
   TArgumentAccess = (argDefault, argConst, argVar, argOut);
@@ -844,7 +848,7 @@ const
       visPublished, visAutomated];
 
   VisibilityNames: array[TPasMemberVisibility] of string = (
-    'default', 'private', 'protected', 'public', 'published', 'automated');
+    'default', 'private', 'protected', 'public', 'published', 'automated','strict private', 'strict protected');
 
   ObjKindNames: array[TPasObjKind] of string = (
     'object', 'class', 'interface');
@@ -1170,6 +1174,8 @@ begin
   inherited Create(AName, AParent);
   IsPacked := False;                     // 12/04/04 - Dave - Added
   Members := TList.Create;
+  Modifiers := TStringList.Create;
+  ClassVars := TList.Create;
 end;
 
 destructor TPasClassType.Destroy;
@@ -1181,6 +1187,8 @@ begin
   Members.Free;
   if Assigned(AncestorType) then
     AncestorType.Release;
+  Modifiers.Free;
+  ClassVars.Free;
   inherited Destroy;
 end;
 

+ 42 - 0
packages/fcl-passrc/src/pparser.pp

@@ -1131,6 +1131,13 @@ begin
     ASection.UsesList.Add(Element);
 
     NextToken;
+
+    if CurToken = tkin then begin
+      // todo: store unit's file name somewhere
+      NextToken; // skip in
+      ExpectToken(tkString); // skip unit's real file name
+    end;
+
     if CurToken = tkSemicolon then
       break
     else if CurToken <> tkComma then
@@ -2736,7 +2743,10 @@ var
   i, SourceLinenumber: Integer;
   VarList: TList;
   Element: TPasElement;
+  isStrict: Boolean;
 begin
+  isStrict:=False;
+
   // Save current parsing position to get it correct in all cases
   SourceFilename := Scanner.CurFilename;
   SourceLinenumber := Scanner.CurRow;
@@ -2761,6 +2771,16 @@ begin
   try
     TPasClassType(Result).ObjKind := AObjKind;
 
+    // nettism/new delphi features
+    if (CurToken = tkIdentifier) and (AObjKind = okClass) then begin
+      s := LowerCase(CurTokenString);
+      if (s = 'sealed') or (s = 'abstract') then begin
+        TPasClassType(Result).Modifiers.Add(s);
+        NextToken;
+      end else
+        ExpectToken(tkSemicolon);
+    end;
+
     // Parse ancestor list
     if CurToken = tkBraceOpen then
     begin
@@ -2795,6 +2815,15 @@ begin
           tkIdentifier:
             begin
               s := LowerCase(CurTokenString);
+              if s = 'strict' then
+              begin
+                isStrict:=True;
+                NextToken;
+                s := LowerCase(CurTokenString);
+              end
+              else
+                isStrict:=False;
+
               if s = 'private' then
                 CurVisibility := visPrivate
               else if s = 'protected' then
@@ -2820,6 +2849,16 @@ begin
                   VarList.Free;
                 end;
               end;
+              if isStrict then
+              begin
+                case CurVisibility of
+                  visPrivate   : CurVisibility:=visStrictPrivate;
+                  visProtected : CurVisibility:=visStrictProtected;
+                else
+                  ParseExc('strange strict visiblity');
+                end;
+              end;
+
             end;
           tkProcedure:
             ProcessMethod('procedure', False);
@@ -2836,6 +2875,9 @@ begin
               TPasClassType(Result).Members.Add(Element);
               ParseProperty(Element);
             end;
+          tkVar: // vars (nettism/new delphi features)
+            if AObjKind<>okClass then ExpectToken(tkSemicolon);
+          //todo: class vars
         end; // end case
         NextToken;
       end;

+ 1 - 1
utils/fpdoc/dglobals.pp

@@ -160,7 +160,7 @@ resourcestring
 Const
   SVisibility: array[TPasMemberVisibility] of string =
        ('Default', 'Private', 'Protected', 'Public',
-       'Published', 'Automated');
+       'Published', 'Automated','Strict Private','Strict Protected');
 
 type