Browse Source

* patch from Dmitry for bug #16342, slightly extended by me.
Fixes const node deprecated problems from that bugreport.

git-svn-id: trunk@15726 -

marco 15 years ago
parent
commit
a39525f341
2 changed files with 53 additions and 46 deletions
  1. 1 1
      packages/fcl-passrc/src/pastree.pp
  2. 52 45
      packages/fcl-passrc/src/pparser.pp

+ 1 - 1
packages/fcl-passrc/src/pastree.pp

@@ -173,7 +173,7 @@ type
   TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
   TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
 
 
   TPasMemberVisibilities = set of TPasMemberVisibility;
   TPasMemberVisibilities = set of TPasMemberVisibility;
-  TPasMemberHint = (hDeprecated,hLibrary,hPlatform);
+  TPasMemberHint = (hDeprecated,hLibrary,hPlatform,hExperimental,hUnimplemented);
   TPasMemberHints = set of TPasMemberHint; 
   TPasMemberHints = set of TPasMemberHint; 
 
 
   TPTreeElement = class of TPasElement;
   TPTreeElement = class of TPasElement;

+ 52 - 45
packages/fcl-passrc/src/pparser.pp

@@ -121,7 +121,8 @@ type
       AParent: TPasElement): TPasElement;overload;
       AParent: TPasElement): TPasElement;overload;
     function CreateElement(AClass: TPTreeElement; const AName: String;
     function CreateElement(AClass: TPTreeElement; const AName: String;
       AParent: TPasElement; AVisibility: TPasMemberVisibility): TPasElement;overload;
       AParent: TPasElement; AVisibility: TPasMemberVisibility): TPasElement;overload;
-    Function IsHint(Const S : String; var AHint : TPasMemberHint) : Boolean;
+    Function IsCurTokenHint(out AHint : TPasMemberHint) : Boolean; overload;
+    Function IsCurTokenHint: Boolean; overload;
     Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
     Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
 
 
     function ParseParams(paramskind: TPasExprKind): TParamsExpr;
     function ParseParams(paramskind: TPasExprKind): TParamsExpr;
@@ -143,6 +144,7 @@ type
     function ParseComplexType(Parent : TPasElement = Nil): TPasType;
     function ParseComplexType(Parent : TPasElement = Nil): TPasType;
     procedure ParseArrayType(Element: TPasArrayType);
     procedure ParseArrayType(Element: TPasArrayType);
     procedure ParseFileType(Element: TPasFileType);
     procedure ParseFileType(Element: TPasFileType);
+    function isEndOfExp: Boolean;
     function DoParseExpression(InitExpr: TPasExpr=nil): TPasExpr;
     function DoParseExpression(InitExpr: TPasExpr=nil): TPasExpr;
     function DoParseConstValueExpression: TPasExpr;
     function DoParseConstValueExpression: TPasExpr;
     function ParseExpression: String;
     function ParseExpression: String;
@@ -340,30 +342,37 @@ begin
   Result:=ParseType(Parent,'');
   Result:=ParseType(Parent,'');
 end;
 end;
 
 
-Function TPasParser.IsHint(Const S : String; var AHint : TPasMemberHint) : Boolean;
-
+Function TPasParser.IsCurTokenHint(out AHint : TPasMemberHint) : Boolean;
 Var
 Var
   T : string;
   T : string;
-
 begin
 begin
-  T:=LowerCase(S);
-  Result:=(T='deprecated');
-  If Result then
-    Ahint:=hDeprecated
-  else
+  if CurToken=tklibrary then
     begin
     begin
-    Result:=(T='library');
-    if Result then
-      Ahint:=hLibrary
-    else
-      begin
-      Result:=(T='platform');
-      If result then
-        AHint:=hPlatform;
-      end;
-    end;  
+    AHint:=hLibrary;
+    Result:=True;
+    end
+  else if CurToken=tkIdentifier then
+    begin
+      T:=LowerCase(CurTokenString);
+      Result:=True;
+      if (T='deprecated') then ahint:=hDeprecated
+      else if (T='platform') then ahint:=hPlatform
+      else if (T='experimental') then ahint:=hExperimental
+      else if (T='unimplemented') then ahint:=hUnimplemented
+      else Result:=False;
+    end
+  else
+    Result:=False;
+end;
+
+Function TPasParser.IsCurTokenHint: Boolean;
+var
+  dummy : TPasMemberHint;
+begin
+  Result:=IsCurTokenHint(dummy);
 end;
 end;
 
 
+
 Function TPasParser.CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
 Function TPasParser.CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
 
 
 Var
 Var
@@ -374,7 +383,7 @@ begin
   Result:=[];
   Result:=[];
   Repeat
   Repeat
     NextToken;
     NextToken;
-    Found:=IsHint(CurTokenString,h);
+    Found:=IsCurTokenHint(h);
     If Found then
     If Found then
       Include(Result,h)
       Include(Result,h)
   Until Not Found;
   Until Not Found;
@@ -577,7 +586,7 @@ begin
         Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
         Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
         ParseProcedureOrFunctionHeader(Result,
         ParseProcedureOrFunctionHeader(Result,
           TPasProcedureType(Result), ptProcedure, True);
           TPasProcedureType(Result), ptProcedure, True);
-        UngetToken;        // Unget semicolon
+        if CurToken = tkSemicolon then UngetToken;        // Unget semicolon
       end;
       end;
     tkFunction:
     tkFunction:
       begin
       begin
@@ -641,12 +650,15 @@ begin
     Element.ElType := ParseType(nil);
     Element.ElType := ParseType(nil);
 end;
 end;
 
 
+function TPasParser.isEndOfExp:Boolean;
 const
 const
   EndExprToken = [
   EndExprToken = [
     tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma, tkColon,
     tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma, tkColon,
     tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
     tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
   ];
   ];
-
+begin
+  Result:=(CurToken in EndExprToken) or IsCurTokenHint;
+end;
 
 
 function TPasParser.ParseParams(paramskind: TPasExprKind): TParamsExpr;
 function TPasParser.ParseParams(paramskind: TPasExprKind): TParamsExpr;
 var
 var
@@ -666,7 +678,7 @@ begin
   params:=TParamsExpr.Create(paramskind);
   params:=TParamsExpr.Create(paramskind);
   try
   try
     NextToken;
     NextToken;
-    if not (CurToken in EndExprToken) then begin
+    if not isEndOfExp then begin
       repeat
       repeat
         p:=DoParseExpression;
         p:=DoParseExpression;
         if not Assigned(p) then Exit; // bad param syntax
         if not Assigned(p) then Exit; // bad param syntax
@@ -819,10 +831,15 @@ var
   x         : TPasExpr;
   x         : TPasExpr;
   i         : Integer;
   i         : Integer;
   tempop    : TToken;
   tempop    : TToken;
-  AllowEnd  : Boolean;
+  NotBinary : Boolean;
   
   
 const
 const
   PrefixSym = [tkPlus, tkMinus, tknot, tkAt]; // + - not @
   PrefixSym = [tkPlus, tkMinus, tknot, tkAt]; // + - not @
+  BinaryOP  = [tkMul, tkDivision, tkdiv, tkmod,
+               tkand, tkShl,tkShr, tkas, tkPower,
+               tkPlus, tkMinus, tkor, tkxor, tkSymmetricalDifference,
+               tkEqual, tkNotEqual, tkLessThan, tkLessEqualThan,
+               tkGreaterThan, tkGreaterEqualThan, tkin, tkis];
 
 
   function PopExp: TPasExpr; inline;
   function PopExp: TPasExpr; inline;
   begin
   begin
@@ -868,7 +885,7 @@ begin
   opstack := TList.Create;
   opstack := TList.Create;
   try
   try
     repeat
     repeat
-      AllowEnd:=True;
+      NotBinary:=True;
       pcount:=0;
       pcount:=0;
 
 
       if not Assigned(InitExpr) then
       if not Assigned(InitExpr) then
@@ -914,9 +931,9 @@ begin
         InitExpr:=nil;
         InitExpr:=nil;
       end;
       end;
 
 
-      if not (CurToken in EndExprToken) then begin
+      if (CurToken in BinaryOP) then begin
         // Adjusting order of the operations
         // Adjusting order of the operations
-        AllowEnd:=False;
+        NotBinary:=False;
         tempop:=PeekOper;
         tempop:=PeekOper;
         while (opstack.Count>0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin
         while (opstack.Count>0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin
           PopAndPushOperator;
           PopAndPushOperator;
@@ -926,7 +943,9 @@ begin
         NextToken;
         NextToken;
       end;
       end;
 
 
-    until AllowEnd and (CurToken in EndExprToken);
+    until NotBinary or isEndOfExp;
+
+    if not NotBinary then ParseExc(SParserExpectedIdentifier);
 
 
     while opstack.Count>0 do PopAndPushOperator;
     while opstack.Count>0 do PopAndPushOperator;
 
 
@@ -1583,7 +1602,6 @@ var
   Prefix : String;
   Prefix : String;
   HadPackedModifier : Boolean;           // 12/04/04 - Dave - Added
   HadPackedModifier : Boolean;           // 12/04/04 - Dave - Added
   IsBitPacked : Boolean;
   IsBitPacked : Boolean;
-  H : TPasMemberHint;
   
   
 begin
 begin
   TypeName := CurTokenString;
   TypeName := CurTokenString;
@@ -1652,7 +1670,7 @@ begin
           end
           end
         else
         else
           Prefix:='';
           Prefix:='';
-        if (CurToken = tkSemicolon) or IsHint(CurtokenString,h)then
+        if (CurToken = tkSemicolon) or IsCurTokenHint then
         begin
         begin
           UngetToken;
           UngetToken;
           UngetToken;
           UngetToken;
@@ -2062,10 +2080,9 @@ procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
   Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
   Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
 
 
 procedure ConsumeSemi;
 procedure ConsumeSemi;
-var bl : TPasMemberHint;
 begin
 begin
   NextToken;
   NextToken;
-  if (CurToken <> tksemicolon) and ishint(curtokenstring,bl) then
+  if (CurToken <> tksemicolon) and IsCurTokenHint then
     ungettoken;
     ungettoken;
 end;
 end;
 
 
@@ -2073,7 +2090,7 @@ Var
   Tok : String;
   Tok : String;
   i: Integer;
   i: Integer;
   Proc: TPasProcedure;
   Proc: TPasProcedure;
-
+  ahint : TPasMemberHint;
 begin
 begin
   NextToken;
   NextToken;
   case ProcType of
   case ProcType of
@@ -2223,19 +2240,9 @@ begin
         TPasProcedure(Parent).AddModifier(pmVarArgs);
         TPasProcedure(Parent).AddModifier(pmVarArgs);
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end
         end
-      else if (tok='DEPRECATED') then
-        begin
-        element.hints:=element.hints+[hDeprecated];
-        consumesemi;
-        end
-      else if (tok='PLATFORM') then
-        begin
-        element.hints:=element.hints+[hPlatform];
-        consumesemi;
-        end
-      else if (tok='LIBRARY') then
+      else if IsCurTokenHint(ahint) then  // deprecated,platform,experimental,library, unimplemented etc
         begin
         begin
-        element.hints:=element.hints+[hLibrary];
+        element.hints:=element.hints+[ahint];
         consumesemi;
         consumesemi;
         end
         end
       else if (tok='OVERLOAD') then
       else if (tok='OVERLOAD') then