--- Merging r21930 into '.':

U    packages/fcl-passrc/src/pscanner.pp
U    packages/fcl-passrc/src/pparser.pp
--- Merging r21931 into '.':
U    packages/fcl-passrc/tests/tcscanner.pas
--- Merging r21932 into '.':
G    packages/fcl-passrc/src/pscanner.pp
--- Merging r21933 into '.':
U    packages/fcl-passrc/src/pastree.pp
--- Merging r21934 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Merging r21938 into '.':
U    packages/fcl-passrc/examples/test_parser.pp
--- Merging r21939 into '.':
G    packages/fcl-passrc/src/pastree.pp
--- Merging r21942 into '.':
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pparser.pp
--- Merging r21946 into '.':
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pparser.pp

# revisions: 21930,21931,21932,21933,21934,21938,21939,21942,21946
r21930 | michael | 2012-07-18 00:38:04 +0200 (Wed, 18 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-passrc/src/pparser.pp
   M /trunk/packages/fcl-passrc/src/pscanner.pp

* Fixed $UNDEF
r21931 | michael | 2012-07-18 00:39:22 +0200 (Wed, 18 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-passrc/tests/tcscanner.pas

* Test case for undefine and define
r21932 | michael | 2012-07-18 00:47:04 +0200 (Wed, 18 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-passrc/src/pscanner.pp

* Fix access violation when file not found. Better GetCurColumn
r21933 | michael | 2012-07-18 01:18:03 +0200 (Wed, 18 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-passrc/src/pastree.pp

* Fixed memory leak
r21934 | michael | 2012-07-18 01:43:25 +0200 (Wed, 18 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-passrc/src/pparser.pp

* Fixed memory leak with unary expressions
r21938 | michael | 2012-07-19 08:29:38 +0200 (Thu, 19 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-passrc/examples/test_parser.pp

* Fixed compilation and finalization
r21939 | michael | 2012-07-19 18:39:01 +0200 (Thu, 19 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-passrc/src/pastree.pp

* Fix access violation in case statement
r21942 | michael | 2012-07-21 10:54:35 +0200 (Sat, 21 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-passrc/src/pastree.pp
   M /trunk/packages/fcl-passrc/src/pparser.pp

* Fixed last known access violations
r21946 | michael | 2012-07-22 16:57:30 +0200 (Sun, 22 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-passrc/src/pastree.pp
   M /trunk/packages/fcl-passrc/src/pparser.pp

* Keep variable information in a more structured way

git-svn-id: branches/fixes_2_6@22303 -

packages/fcl-passrc/examples/test_parser.pp

@@ -1304,7 +1304,6 @@ procedure GetTypes(pe:TPasElement; lindent:integer);
    if pmAssembler in Mfs then WriteFmt(true,'assembler;',false);
    if pmVarargs in Mfs then WriteFmt(true,'varargs;',false);
    if pmCompilerProc in Mfs then WriteFmt(true,'compilerproc;',false);
-   if pmExtdecl in Mfs then WriteFmt(true,'extdecl;',false);
   end; 
 
   procedure GetTPasProcedure(lpp:TPasProcedure; indent:integer);
@@ -1655,7 +1654,7 @@ begin
           writeln(s,'ResourceString');
           x:=ResStrings;
          end;
-        writeln(s,pe.Name,'=',DelQuot(TPasResString(pe).Value),';'); //too much '''
+        writeln(s,pe.Name,'=',DelQuot(TPasResString(pe).Expr.GetDeclaration(false)),';'); //too much '''
        end
      else if pe is TPasConst then
        begin
@@ -1911,7 +1910,7 @@ begin
   E := TSimpleEngine.Create;
   try
     try
-      M := ParseSource(E, cmdl ,TargetOS ,TargetCPU);
+      M := ParseSource(E, cmdl ,TargetOS ,TargetCPU,False);
     except
       on excep:EParserError do
         begin
@@ -1966,6 +1965,8 @@ begin
         Writeln('Initialization');
         if not Unformated then writeln;
         GetTPasImplBlock(M.InitializationSection as TPasImplBlock,1,0,false,false);
+       end;
+      
         if assigned(M.FinalizationSection) then
          begin
           isim:=true;
@@ -1974,7 +1975,6 @@ begin
           if not Unformated then writeln;
           GetTPasImplBlock(M.FinalizationSection as TPasImplBlock,1,0,false,false);
          end;
-       end;
     end;
     if not Unformated then writeln('end.')
      else

packages/fcl-passrc/src/pastree.pp

@@ -616,6 +616,8 @@ type
   end;
 
   { TPasVariable }
+  TVariableModifier = (vmCVar, vmExternal, vmPublic, vmExport);
+  TVariableModifiers = set of TVariableModifier;
 
   TPasVariable = class(TPasElement)
   public
@@ -625,6 +627,8 @@ type
   public
     VarType: TPasType;
     Value: string;
+    VarModifiers : TVariableModifiers;
+    LibraryName,ExportName : string;
     Modifiers : string;
     AbsoluteLocation : String;
     Expr: TPasExpr;
@@ -2668,6 +2672,8 @@ end;
 destructor TProcedureBody.Destroy;
 begin
   FreeAndNil(Labels);
+  if Assigned(Body) then
+    Body.Release;
   inherited Destroy;
 end;
 
@@ -2684,7 +2690,10 @@ procedure TPasImplWhileDo.AddElement(Element: TPasImplElement);
 begin
   inherited AddElement(Element);
   if Body=nil then
-    Body:=Element
+    begin
+    Body:=Element;
+    Body.AddRef;
+    end
   else
     raise Exception.Create('TPasImplWhileDo.AddElement body already set - please report this bug');
 end;
@@ -2700,6 +2709,8 @@ end;
 
 procedure TPasImplCaseOf.AddElement(Element: TPasImplElement);
 begin
+  if (ElseBranch<>Nil) and (Element=ElseBranch) then
+    ElseBranch.AddRef;
   inherited AddElement(Element);
 end;
 
@@ -2739,7 +2750,10 @@ procedure TPasImplCaseStatement.AddElement(Element: TPasImplElement);
 begin
   inherited AddElement(Element);
   if Body=nil then
+    begin
     Body:=Element;
+    Body.AddRef;
+    end
 end;
 
 procedure TPasImplCaseStatement.AddExpression(const Expr: string);
@@ -2767,7 +2781,10 @@ procedure TPasImplWithDo.AddElement(Element: TPasImplElement);
 begin
   inherited AddElement(Element);
   if Body=nil then
+    begin
     Body:=Element;
+    Body.AddRef;
+    end;
 end;
 
 procedure TPasImplWithDo.AddExpression(const Expression: string);

packages/fcl-passrc/src/pparser.pp

@@ -131,7 +131,7 @@ type
     FTokenBufferSize: Integer; // maximum valid index in FTokenBuffer
     function CheckOverloadList(AList: TFPList; AName: String; out OldMember: TPasElement): TPasOverloadedProc;
     procedure DumpCurToken(Const Msg : String);
-    function GetVariableModifiers(Parent: TPasElement): string;
+    function GetVariableModifiers(Parent: TPasElement; Out VarMods : TVariableModifiers; Out Libname,ExportName : string): string;
     function GetVariableValueAndLocation(Parent : TPasElement; out Value, Location: String): Boolean;
     procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean);
   protected
@@ -1373,7 +1373,7 @@ begin
             expstack.Add(x);
             end
            else
-            expstack.Add( TUnaryExpr.Create(AParent, PopExp, TokenToExprOp(tempop) ));
+            expstack.Add( TUnaryExpr.Create(AParent, x, TokenToExprOp(tempop) ));
         end;
 
       end else
@@ -1864,7 +1864,7 @@ begin
   while True do
   begin
     NextToken;
-    //writeln('TPasParser.ParseSection Token=',Scanner.CurTokenString,' ',CurToken);
+  //  writeln('TPasParser.ParseSection Token=',CurTokenString,' ',CurToken, ' ',scanner.CurFilename);
     case CurToken of
       tkend:
         begin
@@ -2218,6 +2218,8 @@ Var
   E : TPasExportSymbol;
 begin
   Repeat
+    if List.Count<>0 then
+      ExpectIdentifier;
     E:=TPasExportSymbol(CreateElement(TPasExportSymbol,CurtokenString,Parent));
     List.Add(E);
     NextToken;
@@ -2304,16 +2306,18 @@ begin
     UngetToken;
 end;
 
-Function TPasParser.GetVariableModifiers(Parent : TPasElement) : string;
+Function TPasParser.GetVariableModifiers(Parent : TPasElement; Out Varmods : TVariableModifiers; Out Libname,ExportName : string) : string;
 
 Var
   S : String;
 begin
   Result := '';
+  VarMods := [];
   NextToken;
   If CurTokenIsIdentifier('cvar') then
     begin
     Result:=';cvar';
+    Include(VarMods,vmcvar);
     ExpectToken(tkSemicolon);
     NextToken;
     end;
@@ -2322,16 +2326,24 @@ begin
     UngetToken
   else
     begin
+    if s='external' then
+      Include(VarMods,vmexternal)
+    else if (s='public') then
+      Include(varMods,vmpublic)
+    else if (s='export') then
+      Include(varMods,vmexport);
     Result:=Result+';'+CurTokenText;
     NextToken;
     if (Curtoken<>tksemicolon) then
       begin
       if (s='external') then
         begin
+        Include(VarMods,vmexternal);
         if (CurToken in [tkString,tkIdentifier])
             and Not (CurTokenIsIdentifier('name')) then
           begin
           Result := Result + ' ' + CurTokenText;
+          LibName:=CurTokenText;
           NextToken;
           end;
         end;
@@ -2343,6 +2355,7 @@ begin
           Result := Result + CurTokenText
         else
           ParseExc(SParserSyntaxError);
+        ExportName:=CurTokenText;
         NextToken;
         end
       else
@@ -2361,7 +2374,8 @@ var
   VarType: TPasType;
   VarEl: TPasVariable;
   H : TPasMemberHints;
-  Mods,Value,Loc : string;
+  varmods: TVariableModifiers;
+  Mods,Value,Loc,alibname,aexpname : string;
 
 begin
   VarNames := TStringList.Create;
@@ -2382,16 +2396,24 @@ begin
       GetVariableValueAndLocation(Parent,Value,Loc);
     H:=CheckHint(Nil,Full);
     if full then
-      Mods:=GetVariableModifiers(Parent)
+      Mods:=GetVariableModifiers(Parent,varmods,alibname,aexpname)
     else
       NextToken;
     for i := 0 to VarNames.Count - 1 do
       begin
       VarEl:=TPasVariable(CreateElement(TPasVariable,VarNames[i],Parent,AVisibility));
       VarEl.VarType := VarType;
-      VarEl.Hints:=H;
+      // Procedure declaration eats the hints.
+      if Assigned(VarType) and (VarType is TPasprocedureType) then
+        VarEl.Hints:=VarType.Hints
+      else
+        VarEl.Hints:=H;
+      Varel.Modifiers:=Mods;
+      Varel.VarModifiers:=VarMods;
       VarEl.Value:=Value;
       VarEl.AbsoluteLocation:=Loc;
+      VarEl.LibraryName:=alibName;
+      VarEl.ExportName:=aexpname;
       if (i>0) then
         VarType.AddRef;
       VarList.Add(VarEl);
@@ -2942,12 +2964,12 @@ var
   BeginBlock: TPasImplBeginBlock;
   SubBlock: TPasImplElement;
 begin
-  //writeln('TPasParser.ParseProcBeginBlock ');
 
   BeginBlock := TPasImplBeginBlock(CreateElement(TPasImplBeginBlock, '', Parent));
   Parent.Body := BeginBlock;
   repeat
     NextToken;
+//    writeln('TPasParser.ParseProcBeginBlock ',curtokenstring);
     if CurToken=tkend then
       break
     else if CurToken<>tkSemiColon then
@@ -2959,6 +2981,7 @@ begin
     end;
   until false;
   ExpectToken(tkSemicolon);
+//  writeln('TPasParser.ParseProcBeginBlock ended ',curtokenstring);
 end;
 
 // Next token is start of (compound) statement
@@ -3159,7 +3182,9 @@ begin
           tkelse:
             begin
               // create case-else block
-              CurBlock:=TPasImplCaseOf(CurBlock).AddElse;
+              el:=TPasImplCaseElse(CreateElement(TPasImplCaseElse,'',CurBlock));
+              TPasImplCaseOf(CurBlock).ElseBranch:=TPasImplCaseElse(el);
+              CreateBlock(TPasImplCaseElse(el));
               break;
             end
           else
@@ -3224,7 +3249,6 @@ begin
         begin
           el:=TPasImplTryFinally(CreateElement(TPasImplTryFinally,'',Curblock));
           TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryFinally(el);
-          CurBlock.AddElement(el);
           CurBlock:=TPasImplTryFinally(el);
         end else
           ParseExc(SParserSyntaxError);
@@ -3241,7 +3265,6 @@ begin
           //writeln(i,'EXCEPT');
           el:=TPasImplTryExcept(CreateElement(TPasImplTryExcept,'',CurBlock));
           TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryExcept(el);
-//          CurBlock.AddElement(el);
           CurBlock:=TPasImplTryExcept(el);
         end else
           ParseExc(SParserSyntaxError);

packages/fcl-passrc/src/pscanner.pp

@@ -928,6 +928,7 @@ Var
   FN : String;
 
 begin
+  Result:=Nil;
   FN:=FindIncludeFileName(ANAme);
   If (FN<>'') then
     try
@@ -1049,6 +1050,7 @@ begin
         break;
     end; // Case
   end;
+//  Writeln(Result, '(',CurTokenString,')');
 end;
 
 procedure TPascalScanner.Error(const Msg: string);
@@ -1152,7 +1154,7 @@ begin
        param:=copy(param,2,length(param)-2);
     end;
   FCurSourceFile := FileResolver.FindIncludeFile(Param);
-  if not Assigned(CurSourceFile) then
+  if not Assigned(FCurSourceFile) then
     Error(SErrIncludeFileNotFound, [Param]);
   FCurFilename := Param;
   if FCurSourceFile is TFileLineReader then
@@ -1210,7 +1212,7 @@ Var
 begin
   Param := UpperCase(Param);
   Index:=FDefines.IndexOf(Param);
-  If (Index<0) then
+  If (Index>=0) then
     RemoveDefine(Param)
   else
     begin
@@ -1764,7 +1766,10 @@ end;
 
 function TPascalScanner.GetCurColumn: Integer;
 begin
-  Result := TokenStr - PChar(CurLine);
+  If (TokenStr<>Nil) then
+    Result := TokenStr - PChar(CurLine)
+  else
+    Result:=0;
 end;
 
 procedure TPascalScanner.DoLog(const Msg: String;SkipSourceInfo : Boolean = False);

packages/fcl-passrc/tests/tcscanner.pas

@@ -181,6 +181,7 @@ type
     Procedure TestTokenSeriesNoWhiteSpace;
     Procedure TestTokenSeriesComments;
     Procedure TestTokenSeriesNoComments;
+    Procedure TestDefine0;
     Procedure TestDefine1;
     Procedure TestDefine2;
     Procedure TestDefine3;
@@ -195,6 +196,7 @@ type
     Procedure TestDefine12;
     Procedure TestInclude;
     Procedure TestInclude2;
+    Procedure TestUnDefine1;
     Procedure TestMacro1;
     procedure TestMacro2;
     procedure TestMacro3;
@@ -1202,6 +1204,13 @@ begin
   TestTokens([tkin,tkWhitespace,tkOf,tkWhiteSpace,tkWhiteSpace,tkIdentifier],'in of {then} aninteger')
 end;
 
+procedure TTestScanner.TestDefine0;
+begin
+  TestTokens([tkComment],'{$DEFINE NEVER}');
+  If FSCanner.Defines.IndexOf('NEVER')=-1 then
+    Fail('Define not defined');
+end;
+
 procedure TTestScanner.TestDefine1;
 begin
   TestTokens([tkComment],'{$IFDEF NEVER} of {$ENDIF}');
@@ -1297,6 +1306,13 @@ begin
   TestTokens([tkIf,tkTrue,tkThen,tkElse],'{$I myinclude.inc} else',True,False);
 end;
 
+procedure TTestScanner.TestUnDefine1;
+begin
+  FSCanner.Defines.Add('ALWAYS');
+  TestTokens([tkComment],'{$UNDEF ALWAYS}');
+  AssertEquals('No more define',-1,FScanner.Defines.INdexOf('ALWAYS'));
+end;
+
 procedure TTestScanner.TestMacro1;
 begin
   FScanner.SkipWhiteSpace:=True;