Support for various syntax elements

Source/DelphiAST.pas

@@ -112,6 +112,7 @@   TPasSyntaxTreeBuilder = class(TmwSimplePasParEx)
     procedure DirectiveBindingMessage; override;
     procedure DirectiveCalling; override;
     procedure DirectiveInline; override;
+    procedure DirectiveVarargs; override;
     procedure DispInterfaceForward; override;
     procedure DotOp; override;
     procedure ElseExpression; override;
@@ -294,7 +295,8 @@     TStringStreamHelper = class helper for TStringStream
 type
   TAttributeValue = (atAsm, atTrue, atFunction, atProcedure, atClassOf, atClass,
     atConst, atConstructor, atDestructor, atEnum, atInterface, atNil, atNumeric,
-    atOut, atPointer, atName, atString, atSubRange, atVar, atDispInterface);
+    atOut, atPointer, atName, atString, atSubRange, atVar, atDispInterface,
+    atVarargs, atExternal);
 
 var
   AttributeValues: array[TAttributeValue] of string;
@@ -1076,7 +1078,7 @@ function TPasSyntaxTreeBuilder.DequoteString(const S: string): string;
   QuoteCount, I: Integer;
 begin
   QuoteCount := 0;
-  for I := Low(S) to High(S) do
+  for I := 1 to Length(S) do
     if S[I] = '''' then
       Inc(QuoteCount)
     else
@@ -1151,6 +1153,16 @@ procedure TPasSyntaxTreeBuilder.DirectiveInline;
   inherited;
 end;
 
+procedure TPasSyntaxTreeBuilder.DirectiveVarargs;
+begin
+  FStack.Push(ntExternal).SetAttribute(anType, AttributeValues[atVarArgs]);
+  try
+    inherited;
+  finally
+    FStack.Pop;
+  end;
+end;
+
 procedure TPasSyntaxTreeBuilder.DispInterfaceForward;
 begin
   FStack.Peek.SetAttribute(anForwarded, AttributeValues[atTrue]);
@@ -1345,7 +1357,7 @@ procedure TPasSyntaxTreeBuilder.ExpressionList;
 
 procedure TPasSyntaxTreeBuilder.ExternalDirective;
 begin
-  FStack.Push(ntExternal);
+  FStack.Push(ntExternal).SetAttribute(anType, AttributeValues[atExternal]);
   try
     inherited;
   finally

Source/SimpleParser/SimpleParser.Lexer.pas

@@ -908,7 +908,7 @@ function TmwBasePasLex.Func66: TptTokenKind;
   Result := ptIdentifier;
   if KeyComp('Single') then FExID := ptSingle else
     if KeyComp('Type') then Result := ptType else
-      if KeyComp('Unsafe') then Result := ptUnsafe;
+      if KeyComp('Unsafe') then FExID := ptUnsafe;
 end;
 
 function TmwBasePasLex.Func69: TptTokenKind;
@@ -1703,7 +1703,7 @@ function TmwBasePasLex.EvaluateConditionalExpression(const AParams: String): Boo
   LIsRtlVer: Boolean;
   LOper: string;
   LValue: Integer;
-  p: Integer;
+  p, LBracketLevel: Integer;
 begin
   { TODO : Expand support for <=> evaluations (complicated to do). Expand support for NESTED expressions }
   LEvaluation := leeNone;
@@ -1742,11 +1742,10 @@ function TmwBasePasLex.EvaluateConditionalExpression(const AParams: String): Boo
       end;
     end;
   end else
-  if (Pos('DEFINED(', LParams) = 1) or (Pos('NOT DEFINED(', LParams) = 1) then
+  if (Pos('DEFINED(', LParams) = 1) or (Pos('NOT DEFINED(', LParams) = 1) or (Pos('(', LParams) = 1) then
   begin
     Result := True; // Optimistic
-    while (Pos('DEFINED(', LParams) = 1) or (Pos('NOT DEFINED(', LParams) = 1) do
-    begin
+    repeat
       if Pos('DEFINED(', LParams) = 1 then
       begin
         LDefine := Copy(LParams, 9, Pos(')', LParams) - 9);
@@ -1766,6 +1765,30 @@ function TmwBasePasLex.EvaluateConditionalExpression(const AParams: String): Boo
           leeAnd: Result := Result and (not IsDefined(LDefine));
           leeOr: Result := Result or (not IsDefined(LDefine));
         end;
+      end
+      else if Pos('(', LParams) = 1 then
+      begin
+        LBracketLevel := 1;
+        for p := 2 to Length(LParams) do
+          case LParams[p] of
+            '(': Inc(LBracketLevel);
+            ')':
+            begin
+              Dec(LBracketLevel);
+              if LBracketLevel = 0 then
+                Break;
+            end;
+          end;
+        if LBracketLevel = 0 then // matching closing bracket was found
+        begin
+          LDefine := Copy(LParams, 2, p - 2);
+          LParams := TrimLeft(Copy(LParams, p + 1));
+          case LEvaluation of
+            leeNone: Result := EvaluateConditionalExpression(LDefine);
+            leeAnd: Result := Result and EvaluateConditionalExpression(LDefine);
+            leeOr: Result := Result or EvaluateConditionalExpression(LDefine);
+          end;
+        end;
       end;
       // Determine next Evaluation
       if Pos('AND ', LParams) = 1 then
@@ -1778,7 +1801,7 @@ function TmwBasePasLex.EvaluateConditionalExpression(const AParams: String): Boo
         LEvaluation := leeOr;
         LParams := TrimLeft(Copy(LParams, 3, Length(LParams) - 2));
       end;
-    end;
+    until not ((Pos('DEFINED(', LParams) = 1) or (Pos('NOT DEFINED(', LParams) = 1) or (Pos('(', LParams) = 1));
   end else
     Result := False;
 end;
@@ -1907,8 +1930,13 @@ function TmwBasePasLex.IsIdentifiers(AChar: Char): Boolean;
 begin
   // assuming Delphi identifier may include letters, digits, underscore symbol
   // and any character over 127 except surrogates
+  {$IF RTLVersion >= 25}
+  Result := AChar.IsLetterOrDigit or (AChar = '_')
+    or ((Ord(AChar) > 127) and not AChar.IsHighSurrogate and not AChar.IsLowSurrogate);
+  {$ELSE}
   Result := TCharacter.IsLetterOrDigit(AChar) or (AChar = '_')
     or ((Ord(AChar) > 127) and not TCharacter.IsHighSurrogate(AChar) and not TCharacter.IsLowSurrogate(AChar));
+  {$IFEND}
 end;
 
 procedure TmwBasePasLex.LFProc;
@@ -2849,6 +2877,9 @@ procedure TmwBasePasLex.InitDefinesDefinedByCompiler;
   {$IFDEF ELF}
   AddDefine('ELF');
   {$ENDIF}
+  {$IFDEF MANAGED_RECORD}
+  AddDefine('MANAGED_RECORD');
+  {$ENDIF}
   {$IFDEF NEXTGEN}
   AddDefine('NEXTGEN');
   {$ENDIF}

Source/SimpleParser/SimpleParser.pas

@@ -180,7 +180,8 @@ interface
     ptFinal,
     ptExperimental,
     ptDispId,
-    ptNoreturn
+    ptNoreturn,
+    ptUnsafe
   ];
 
 type
@@ -4387,7 +4388,15 @@ procedure TmwSimplePasPar.RecordAlign;
 
 procedure TmwSimplePasPar.RecordAlignValue;
 begin
-  Expected(ptIntegerConst);
+  if TokenID = ptRoundOpen then
+  begin
+    RoundOpen;
+    if TokenID in [ptIdentifier, ptIntegerConst] then
+      NextToken;
+    RoundClose;
+  end
+  else
+    Expected(ptIntegerConst);
 end;
 
 procedure TmwSimplePasPar.RecordFieldConstant;
@@ -4860,38 +4869,18 @@ procedure TmwSimplePasPar.LabelDeclarationSection;
 procedure TmwSimplePasPar.ProceduralDirective;
 begin
   case GenID of
-    ptAbstract:
-      begin
-        DirectiveBinding;
-      end;
+    ptAbstract, ptDynamic, ptMessage, ptNoreturn, ptOverload, ptOverride, ptReintroduce, ptVirtual:
+      DirectiveBinding;
     ptCdecl, ptPascal, ptRegister, ptSafeCall, ptStdCall:
-      begin
-        DirectiveCalling;
-      end;
+      DirectiveCalling;
     ptExport, ptFar, ptNear:
-      begin
-        Directive16Bit;
-      end;
+      Directive16Bit;
     ptExternal:
-      begin
-        ExternalDirective;
-      end;
-    ptDynamic, ptMessage, ptOverload, ptOverride, ptReintroduce, ptVirtual, ptNoreturn:
-      begin
-        DirectiveBinding;
-      end;
-    ptAssembler:
-      begin
-        NextToken;
-      end;
-    ptStatic:
-      begin
-        NextToken;
-      end;
+      ExternalDirective;
+    ptAssembler, ptFinal, ptExperimental, ptDelayed, ptStatic, ptUnsafe:
+      NextToken;
     ptInline:
-      begin
-        DirectiveInline;
-      end;
+      DirectiveInline;
     ptDeprecated:
       DirectiveDeprecated;
     ptLibrary:
@@ -4902,12 +4891,8 @@ procedure TmwSimplePasPar.ProceduralDirective;
       DirectiveLocal;
     ptVarargs:
       DirectiveVarargs;
-    ptFinal, ptExperimental, ptDelayed:
-      NextToken;
   else
-    begin
-      SynError(InvalidProceduralDirective);
-    end;
+    SynError(InvalidProceduralDirective);
   end;
 end;
 
@@ -5588,6 +5573,13 @@ procedure TmwSimplePasPar.AnonymousMethod;
           FormalParameterList;
       end;
   end;
+
+  while ExID in [ptCdecl, ptExport, ptFar, ptNear, ptOverload, ptOverride,
+    ptPascal, ptRegister, ptSafeCall, ptStdCall, ptStatic, ptVarargs] do
+  begin
+    ProceduralDirective;
+  end;
+
   Block;
 end;
 
@@ -5596,21 +5588,27 @@ procedure TmwSimplePasPar.AnonymousMethodType;
   ExpectedEx(ptReference);
   Expected(ptTo);
   case TokenID of
-    ptProcedure:
+    ptFunction:
       begin
         NextToken;
         if TokenID = ptRoundOpen then
           FormalParameterList;
+        Expected(ptColon);
+        ReturnType;
       end;
-    ptFunction:
+    ptProcedure:
       begin
         NextToken;
         if TokenID = ptRoundOpen then
           FormalParameterList;
-        Expected(ptColon);
-        ReturnType;
       end;
   end;
+
+  while ExID in [ptCdecl, ptExport, ptFar, ptNear, ptOverload, ptOverride,
+    ptPascal, ptRegister, ptSafeCall, ptStdCall, ptStatic, ptVarargs] do
+  begin
+    ProceduralDirective;
+  end;
 end;
 
 procedure TmwSimplePasPar.AddDefine(const ADefine: string);
@@ -5915,4 +5913,4 @@ procedure TmwSimplePasPar.CustomAttribute;
   AttributeSections;
 end;
 
-end.
+end.