Merged revisions 849 and 861

git-svn-id: branches/fixes_2_0@862 -

fcl/passrc/pparser.pp

@@ -36,6 +36,7 @@ resourcestring
   SParserExpectedColonSemicolon = 'Expected ":" or ";"';
   SParserExpectedSemiColonEnd = 'Expected ";" or "End"';
   SParserExpectedConstVarID = 'Expected "const", "var" or identifier';
+  SParserExpectedColonID = 'Expected ":" or identifier';
   SParserSyntaxError = 'Syntax error';
   SParserTypeSyntaxError = 'Syntax error in type';
   SParserArrayTypeSyntaxError = 'Syntax error in array type';
@@ -85,7 +86,7 @@ uses Classes, PScanner;
 
 type
 
-  TDeclType = (declNone, declConst, declResourcestring, declType, declVar);
+  TDeclType = (declNone, declConst, declResourcestring, declType, declVar, declThreadvar);
 
   TProcType = (ptProcedure, ptFunction, ptOperator);
 
@@ -690,6 +691,8 @@ begin
         CurBlock := declType;
       tkVar:
         CurBlock := declVar;
+      tkThreadVar:
+        CurBlock := declThreadVar;
       tkProcedure:
         begin
           AddProcOrFunction(Section, ParseProcedureOrFunctionDecl(Section, ptProcedure));
@@ -757,7 +760,7 @@ begin
                     Section.Types.Add(TypeEl);
                 end;
               end;
-            declVar:
+            declVar, declThreadVar:
               begin
                 List := TList.Create;
                 try
@@ -1343,9 +1346,15 @@ begin
     ptOperator:
       begin
 	ParseArgList(Element, Element.Args, tkBraceClose);
-	TPasFunctionType(Element).ResultEl.Name := ExpectIdentifier;
-	if CurToken <> tkColon then
-	  ParseExc(SParserExpectedLBracketColon);
+        NextToken;
+        if (CurToken=tkIdentifier) then begin
+	  TPasFunctionType(Element).ResultEl.Name := CurTokenName;
+          ExpectToken(tkColon);
+        end
+        else if (CurToken=tkColon) then
+          TPasFunctionType(Element).ResultEl.Name := 'Result'
+        else
+          ParseExc(SParserExpectedColonID);
 	if Assigned(Element) then        // !!!
 	  TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
 	else
@@ -1362,7 +1371,8 @@ begin
     UngetToken;
 
   NextToken;
-  if CurToken = tkEqual then begin
+  if CurToken = tkEqual then
+  begin
     // for example: const p: procedure = nil;
     UngetToken;
     exit;
@@ -1382,15 +1392,29 @@ begin
     begin
 {      El['calling-conv'] := 'stdcall';}
       ExpectToken(tkSemicolon);
+    end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'COMPILERPROC') then
+    begin
+{      El['calling-conv'] := 'compilerproc';}
+      ExpectToken(tkSemicolon);
+    end else if (CurToken = tkInline) then
+    begin
+{      TPasProcedure(Parent).IsInline := True;}
+      ExpectToken(tkSemicolon);
     end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'DEPRECATED') then
     begin
-{      El['calling-conv'] := 'cdecl';}
+{      El['calling-conv'] := 'deprecated';}
       ExpectToken(tkSemicolon);
     end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'EXTERNAL') then
     begin
       repeat
         NextToken
       until CurToken = tkSemicolon;
+    end else if (CurToken = tkSquaredBraceOpen) then
+    begin
+      repeat
+        NextToken
+      until CurToken = tkSquaredBraceClose;
+      ExpectToken(tkSemicolon);
     end else if Parent.InheritsFrom(TPasProcedure) and
       (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'OVERLOAD') then
     begin
@@ -1529,6 +1553,7 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
   ProcType: TProcType): TPasProcedure;
 var
   Name: String;
+  i: Integer;
 begin
   case ProcType of
     ptFunction:
@@ -1547,7 +1572,8 @@ begin
       end;
     ptOperator:
       begin
-        Name := TokenInfos[CurToken];
+        NextToken;
+        Name := 'operator ' + TokenInfos[CurToken];
 	Result := TPasOperator(CreateElement(TPasOperator, Name, Parent));
 	Result.ProcType := Engine.CreateFunctionType('', '__INVALID__', Result,
 	  True, Scanner.CurFilename, Scanner.CurRow);
@@ -1555,6 +1581,20 @@ begin
   end;
 
   ParseProcedureOrFunctionHeader(Result, Result.ProcType, ProcType, False);
+
+  if ProcType = ptOperator then
+  begin
+    Result.Name := Result.Name + '(';
+    for i := 0 to Result.ProcType.Args.Count - 1 do
+    begin
+      if i > 0 then
+        Result.Name := Result.Name + ', ';
+      Result.Name := Result.Name +
+        TPasArgument(Result.ProcType.Args[i]).ArgType.Name;
+    end;
+    Result.Name := Result.Name + '): ' +
+      TPasFunctionType(Result.ProcType).ResultEl.ResultType.Name;
+  end;
 end;
 
 
@@ -1621,9 +1661,10 @@ begin
 	  Variant.Members.Free;
 	  raise;
 	end;
-	ExpectToken(tkSemicolon);
 	NextToken;
-	if CurToken = tkEnd then
+	if CurToken = tkSemicolon then
+	  NextToken;
+	if (CurToken = tkEnd) or (CurToken = tkBraceClose) then
 	  break
 	else
 	  UngetToken;
@@ -1792,10 +1833,6 @@ begin
                 VarList := TList.Create;
                 try
                   ParseInlineVarDecl(Result, VarList, CurVisibility, False);
-	          NextToken;
-	          // Records may be terminated with end, no semicolon
-		  if (CurToken <> tkEnd) and (CurToken <> tkSemicolon) then
-		    ParseExc(SParserExpectedSemiColonEnd);
                   for i := 0 to VarList.Count - 1 do
                   begin
                     Element := TPasElement(VarList[i]);

fcl/passrc/pscanner.pp

@@ -61,6 +61,9 @@ type
     tkDotDot,           // '..'
     tkAssign,           // ':='
     tkNotEqual,         // '<>'
+    tkLessEqualThan,	// '<='
+    tkGreaterEqualThan,	// '>='
+    tkPower,            // '**'
     // Reserved words
     tkabsolute,
     tkand,
@@ -118,6 +121,7 @@ type
     tkshr,
 //    tkstring,
     tkthen,
+    tkthreadvar,
     tkto,
     tktrue,
     tktry,
@@ -238,6 +242,9 @@ const
     '..',
     ':=',
     '<>',
+    '<=',
+    '>=',
+    '**',
     // Reserved words
     'absolute',
     'and',
@@ -295,6 +302,7 @@ const
     'shr',
 //    'string',
     'then',
+    'threadvar',
     'to',
     'true',
     'try',
@@ -643,7 +651,12 @@ begin
     '*':
       begin
         Inc(TokenStr);
-        Result := tkMul;
+        if TokenStr[0] = '*' then
+        begin
+          Inc(TokenStr);
+          Result := tkPower;
+        end else
+          Result := tkMul;
       end;
     '+':
       begin
@@ -749,7 +762,11 @@ begin
         begin
           Inc(TokenStr);
           Result := tkNotEqual;
-        end else
+        end else if TokenStr[0] = '=' then
+	begin
+	  Inc(TokenStr);
+	  Result := tkLessEqualThan;
+	end else
           Result := tkLessThan;
       end;
     '=':
@@ -760,7 +777,12 @@ begin
     '>':
       begin
         Inc(TokenStr);
-        Result := tkGreaterThan;
+	if TokenStr[0] = '=' then
+	begin
+	  Inc(TokenStr);
+	  Result := tkGreaterEqualThan;
+	end else
+	  Result := tkGreaterThan;
       end;
     '@':
       begin

utils/fpdoc/dglobals.pp

@@ -131,6 +131,7 @@ resourcestring
   SNeedPackageName            = 'No package name specified. Please specify one using the --package option.';
   SDone                       = 'Done.';
   SErrCouldNotCreateOutputDir = 'Could not create output directory "%s"';
+  SErrCouldNotCreateFile      = 'Could not create file "%s": %s';
 
 Const
   SVisibility: array[TPasMemberVisibility] of string =

utils/fpdoc/dw_html.pp

@@ -302,6 +302,7 @@ end;
 function TLongNameFileAllocator.GetFilename(AElement: TPasElement;
   ASubindex: Integer): String;
 var
+  s: String;
   i: Integer;
 begin
   if AElement.ClassType = TPasPackage then
@@ -309,20 +310,68 @@ begin
   else if AElement.ClassType = TPasModule then
     Result := LowerCase(AElement.Name) + PathDelim + 'index'
   else
+  begin
+    if AElement is TPasOperator then
     begin
-    Result := LowerCase(AElement.PathName);
-    i := 1;
-    if (Length(Result)>0) and (Result[1]='#') then
+      Result := LowerCase(AElement.Parent.PathName) + '.op-';
+      s := Copy(AElement.Name, Pos(' ', AElement.Name) + 1, Length(AElement.Name));
+      s := Copy(s, 1, Pos('(', s) - 1);
+      if s = ':=' then
+        s := 'assign'
+      else if s = '+' then
+        s := 'add'
+      else if s = '-' then
+        s := 'sub'
+      else if s = '*' then
+        s := 'mul'
+      else if s = '/' then
+        s := 'div'
+      else if s = '**' then
+        s := 'power'
+      else if s = '=' then
+        s := 'equal'
+      else if s = '<>' then
+        s := 'unequal'
+      else if s = '<' then
+        s := 'less'
+      else if s = '<=' then
+        s := 'lessequal'
+      else if s = '>' then
+        s := 'greater'
+      else if s = '>=' then
+        s := 'greaterthan';
+      Result := Result + s + '-';
+      s := '';
+      i := 1;
+      while AElement.Name[i] <> '(' do
+        Inc(i);
+      Inc(i);
+      while AElement.Name[i] <> ')' do
       begin
-      while Result[i] <> '.' do
+        if AElement.Name[i] = ',' then
+	begin
+	  s := s + '-';
+	  Inc(i);
+	end else
+	  s := s + AElement.Name[i];
         Inc(i);
-      Result:=Copy(Result,i+1,Length(Result));
       end;
+      Result := Result + LowerCase(s) + '-' + LowerCase(Copy(AElement.Name,
+        Pos('):', AElement.Name) + 3, Length(AElement.Name)));
+    end else
+      Result := LowerCase(AElement.PathName);
     i := 1;
-    while (I<=Length(Result)) and (Result[i]<>'.') do
+    if (Length(Result) > 0) and (Result[1] = '#') then
+    begin
+      while Result[i] <> '.' do
+        Inc(i);
+      Result := Copy(Result, i + 1, Length(Result));
+    end;
+    i := 1;
+    while (i <= Length(Result)) and (Result[i] <> '.') do
       Inc(i);
-    If (I<=Length(Result)) and (I>0) then
-      Result[i]:= PathDelim;
+    if (i <= Length(Result)) and (i > 0) then
+      Result[i] := PathDelim;
   end;
 
   if ASubindex > 0 then
@@ -610,8 +659,13 @@ begin
       PageDoc := CreateHTMLPage(Element, SubpageIndex);
       try
         Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex);
-        CreatePath(Filename);
-        WriteHTMLFile(PageDoc, Filename);
+        try
+          CreatePath(Filename);
+          WriteHTMLFile(PageDoc, Filename);
+        except
+	  on E: Exception do
+            WriteLn(Format(SErrCouldNotCreateFile, [FileName, e.Message]));
+        end;
       finally
         PageDoc.Free;
       end;