fcl-passrc: scanner: added modeswitch prefixedattributes, parser: skip attributes

git-svn-id: trunk@37597 -

packages/fcl-passrc/src/pasresolver.pp

@@ -165,6 +165,9 @@ Works:
   - array var
 
 ToDo:
+- Warning: An inherited method is hidden by "constructor Create(TComponent);
+- mode delphi: Error: Not all declarations of "Create" are declared with OVERLOAD
+-
 - for..in..do
    - function: enumerator
    - class

packages/fcl-passrc/src/pparser.pp

@@ -3256,7 +3256,7 @@ begin
             ParseLabels(Declarations);
         end;
       tkSquaredBraceOpen:
-        if msIgnoreAttributes in CurrentModeSwitches then
+        if [msPrefixedAttributes,msIgnoreAttributes]*CurrentModeSwitches<>[] then
           ParseAttribute(Declarations)
         else
           ParseExcSyntaxError;
@@ -4460,10 +4460,11 @@ begin
     // Writeln(modcount, curtokentext);
     LastToken:=CurToken;
     NextToken;
-    if (ModCount in [1,2,3]) and (CurToken = tkEqual) then
+    if (ModCount<=3) and (CurToken = tkEqual) and not (Parent is TPasProcedure) then
       begin
       // for example: const p: procedure = nil;
       UngetToken;
+      Engine.FinishScope(stProcedureHeader,Element);
       exit;
       end;
     If CurToken=tkSemicolon then
@@ -4489,8 +4490,8 @@ begin
           end;
       end;
       ExpectTokens([tkSemicolon,tkEqual]);
-      if curtoken=tkEqual then
-        ungettoken;
+      if CurToken=tkEqual then
+        UngetToken;
       end
     else if IsProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
@@ -4520,20 +4521,19 @@ begin
       end
     else if (CurToken = tkSquaredBraceOpen) then
       begin
-      // [] can be an attribute or FPC's [] modifier
-      if IsProc and ([msFpc, msObjfpc]*CurrentModeswitches<>[]) then
+      if ([msPrefixedAttributes,msIgnoreAttributes]*CurrentModeswitches<>[]) then
+        begin
+        // [attribute]
+        UngetToken;
+        break;
+        end
+      else
         begin
-        // FPC's [] modifier
+        // ToDo: read FPC's [] modifiers, e.g. [public,alias:'']
         repeat
           NextToken
         until CurToken = tkSquaredBraceClose;
         ExpectToken(tkSemicolon);
-        end
-      else
-        begin
-        // attribute
-        UngetToken;
-        Exit;
         end;
       end
     else
@@ -5994,7 +5994,7 @@ begin
         HaveClass:=False;
         end;
       tkSquaredBraceOpen:
-        if msIgnoreAttributes in CurrentModeswitches then
+        if [msPrefixedAttributes,msIgnoreAttributes]*CurrentModeswitches<>[] then
           ParseAttribute(AType)
         else
           CheckToken(tkIdentifier);

packages/fcl-passrc/src/pscanner.pp

@@ -263,6 +263,7 @@ type
     msISOLikeProgramsPara, { program parameters as it required by an ISO compatible compiler }
     msISOLikeMod,          { mod operation as it is required by an iso compatible compiler }
     msExternalClass,       { Allow external class definitions }
+    msPrefixedAttributes,  { Allow attributes, disable proc modifier [] }
     msIgnoreInterfaces,    { workaround til resolver/converter supports interfaces }
     msIgnoreAttributes     { workaround til resolver/converter supports attributes }
   );
@@ -822,6 +823,7 @@ const
     'ISOPROGRAMPARAS',
     'ISOMOD',
     'EXTERNALCLASS',
+    'PREFIXEDATTRIBUTES',
     'IGNOREINTERFACES',
     'IGNOREATTRIBUTES'
     );
@@ -857,7 +859,7 @@ const
 const
   AllLanguageModes = [msFPC,msObjFPC,msDelphi,msTP7,msMac,msISO,msExtPas];
 
-Const
+const
   MessageTypeNames : Array[TMessageType] of string = (
     'Fatal','Error','Warning','Note','Hint','Info','Debug'
   );
@@ -866,33 +868,37 @@ const
   // all mode switches supported by FPC
   msAllFPCModeSwitches = [low(TModeSwitch)..High(TModeSwitch)];
 
-  DelphiModeSwitches = [msDelphi,msClass,msObjpas,msresult,msstringpchar,
-     mspointer2procedure,msautoderef,msTPprocvar,msinitfinal,msdefaultansistring,
-     msout,msdefaultpara,msduplicatenames,mshintdirective,
-     msproperty,msdefaultinline,msexcept,msadvancedrecords,mstypehelpers];
+  DelphiModeSwitches = [msDelphi,msClass,msObjpas,msResult,msStringPchar,
+     msPointer2Procedure,msAutoDeref,msTPProcVar,msInitFinal,msDefaultAnsistring,
+     msOut,msDefaultPara,msDuplicateNames,msHintDirective,
+     msProperty,msDefaultInline,msExcept,msAdvancedRecords,msTypeHelpers,
+     msPrefixedAttributes
+     ];
 
-  DelphiUnicodeModeSwitches = delphimodeswitches + [mssystemcodepage,msdefaultunicodestring];
+  DelphiUnicodeModeSwitches = delphimodeswitches + [msSystemCodePage,msDefaultUnicodestring];
 
   // mode switches of $mode FPC, don't confuse with msAllFPCModeSwitches
-  FPCModeSwitches = [msfpc,msstringpchar,msnestedcomment,msrepeatforward,
-    mscvarsupport,msinitfinal,mshintdirective, msproperty,msdefaultinline];
+  FPCModeSwitches = [msFpc,msStringPchar,msNestedComment,msRepeatForward,
+    msCVarSupport,msInitFinal,msHintDirective,msProperty,msDefaultInline];
 
-  OBJFPCModeSwitches =  [msobjfpc,msclass,msobjpas,msresult,msstringpchar,msnestedcomment,
-    msrepeatforward,mscvarsupport,msinitfinal,msout,msdefaultpara,mshintdirective,
-    msproperty,msdefaultinline,msexcept];
+  OBJFPCModeSwitches =  [msObjfpc,msClass,msObjpas,msResult,msStringPchar,msNestedComment,
+    msRepeatForward,msCVarSupport,msInitFinal,msOut,msDefaultPara,msHintDirective,
+    msProperty,msDefaultInline,msExcept];
 
-  TPModeSwitches = [mstp7,mstpprocvar,msduplicatenames];
+  TPModeSwitches = [msTP7,msTPProcVar,msDuplicateNames];
 
-  GPCModeSwitches = [msgpc,mstpprocvar];
+  GPCModeSwitches = [msGPC,msTPProcVar];
 
-  MacModeSwitches = [msmac,mscvarsupport,msmacprocvar,msnestedprocvars,msnonlocalgoto,
-    msisolikeunaryminus,msdefaultinline];
+  MacModeSwitches = [msMac,msCVarSupport,msMacProcVar,msNestedProcVars,
+    msNonLocalGoto,msISOLikeUnaryMinus,msDefaultInline];
 
-  ISOModeSwitches =  [msiso,mstpprocvar,msduplicatenames,msnestedprocvars,msnonlocalgoto,msisolikeunaryminus,msisolikeio,
-    msisolikeprogramspara, msisolikemod];
+  ISOModeSwitches =  [msIso,msTPProcVar,msDuplicateNames,msNestedProcVars,
+    msNonLocalGoto,msISOLikeUnaryMinus,msISOLikeIO,msISOLikeProgramsPara,
+    msISOLikeMod];
 
-  ExtPasModeSwitches = [msextpas,mstpprocvar,msduplicatenames,msnestedprocvars,msnonlocalgoto,msisolikeunaryminus,msisolikeio,
-    msisolikeprogramspara, msisolikemod];
+  ExtPasModeSwitches = [msExtpas,msTPProcVar,msDuplicateNames,msNestedProcVars,
+    msNonLocalGoto,msISOLikeUnaryMinus,msISOLikeIO,msISOLikeProgramsPara,
+    msISOLikeMod];
 
 function StrToModeSwitch(aName: String): TModeSwitch;
 function FilenameIsAbsolute(const TheFilename: string):boolean;

packages/fcl-passrc/tests/tcresolver.pas

@@ -11065,7 +11065,7 @@ procedure TTestResolver.TestAttributes_Ignore;
 begin
   StartProgram(false);
   Add([
-  '{$modeswitch ignoreattributes}',
+  '{$modeswitch IgnoreAttributes}',
   'type',
   '  [custom1, custom2(1+3,''foo'')] [mod1.custom3]',
   '  TObject = class',
@@ -11077,6 +11077,10 @@ begin
   '  [Attr]',
   '  TBird = class(TObject)',
   '  end;',
+  '[Attr]',
+  'procedure DoA; forward;',
+  '[Attr]',
+  'procedure DoA; begin end;',
   'var',
   '  [custom6]',
   '  o: TObject;',

packages/fcl-passrc/tests/tcscanner.pas

@@ -446,8 +446,7 @@ begin
     if (tk=tkLineEnding) and not (t in [tkEOF,tkLineEnding]) then
       tk:=FScanner.FetchToken;
     AssertEquals('EOF reached.',tkEOF,FScanner.FetchToken);
-    end
-
+    end;
 end;
 
 procedure TTestScanner.TestToken(t: TToken; const ASource: String;
@@ -463,7 +462,7 @@ begin
     DoTestToken(t,S);
     end;
   DoTestToken(t,UpperCase(ASource));
-  DoTestToken(t,LowerCase(ASource));
+  DoTestToken(t,LowerCase(ASource),CheckEOF);
 end;
 
 procedure TTestScanner.TestTokens(t: array of TToken; const ASource: String;