fcl-passrc: nicer error position on cant find unit

git-svn-id: trunk@37485 -

packages/fcl-passrc/src/pasresolveeval.pas

@@ -143,6 +143,7 @@ const
   nRangeCheckInSetConstructor = 3070;
   nIncompatibleTypesGotParametersExpected = 3071;
   nAddingIndexSpecifierRequiresNewX = 3072;
+  nCantFindUnitX = 3073;
 
 // resourcestring patterns of messages
 resourcestring
@@ -218,6 +219,7 @@ resourcestring
   sRangeCheckInSetConstructor = 'range check error in set constructor or duplicate set element';
   sIncompatibleTypesGotParametersExpected = 'Incompatible types, got %s parameters, expected %s';
   sAddingIndexSpecifierRequiresNewX = 'adding index specifier requires new "%s" specifier';
+  sCantFindUnitX = 'can''t find unit "%s"';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

packages/fcl-passrc/src/pasresolver.pp

@@ -158,6 +158,7 @@ Works:
   - enum: low(), high(), pred(), succ()
 
 ToDo:
+- typecast longint(value) -> (value+0) & $ffffffff
 - custom ranges
   - enum: ord(), rg(int), int(rg), enum:=rg, rg:=enum, rg:=rg,
      rgbig:=rgsmall, rgsmall:=rgbig
@@ -9552,6 +9553,8 @@ begin
     // resolved when finished
   else if AClass.InheritsFrom(TPasImplBlock) then
     // resolved when finished
+  else if AClass=TPasUnresolvedUnitRef then
+    RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
   else
     RaiseNotYetImplemented(20160922163544,El);
 end;

packages/fcl-passrc/src/pparser.pp

@@ -801,15 +801,19 @@ end;
 
 procedure TPasParser.ParseExc(MsgNumber: integer; const Fmt: String;
   Args: array of const);
+var
+  p: TPasSourcePos;
 begin
   {$IFDEF VerbosePasParser}
   writeln('TPasParser.ParseExc Token="',CurTokenText,'"');
   {$ENDIF}
+  writeln('TPasParser.ParseExc ',Scanner.CurColumn,' ',Scanner.CurSourcePos.Column,' ',Scanner.CurTokenPos.Column);
   SetLastMsg(mtError,MsgNumber,Fmt,Args);
+  p:=Scanner.CurTokenPos;
   raise EParserError.Create(SafeFormat(SParserErrorAtToken,
-    [FLastMsg, CurTokenName, Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn])
-    {$ifdef addlocation}+' ('+inttostr(scanner.currow)+' '+inttostr(scanner.curcolumn)+')'{$endif},
-    Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
+    [FLastMsg, CurTokenName, p.FileName, p.Row, p.Column])
+    {$ifdef addlocation}+' ('+IntToStr(p.Row)+' '+IntToStr(p.Column)+')'{$endif},
+    p.FileName, p.Row, p.Column);
 end;
 
 procedure TPasParser.ParseExcExpectedIdentifier;
@@ -3292,12 +3296,12 @@ begin
     if ASection.ClassType=TImplementationSection then
       CheckDuplicateInUsesList(AUnitName,CurModule.InterfaceSection.UsesClause);
 
-    UnitRef := Engine.FindModule(AUnitName);  // should we resolve module here when "IN" filename is not known yet?
+    UnitRef := Engine.FindModule(AUnitName);  // ToDo: "in" filename
     if Assigned(UnitRef) then
       UnitRef.AddRef
     else
       UnitRef := TPasUnresolvedUnitRef(CreateElement(TPasUnresolvedUnitRef,
-        AUnitName, ASection));
+        AUnitName, ASection, NamePos));
 
     UsesUnit:=TPasUsesUnit(CreateElement(TPasUsesUnit,AUnitName,ASection,NamePos));
     Result:=ASection.AddUnitToUsesList(AUnitName,NameExpr,InFileExpr,UnitRef,UsesUnit);
@@ -3386,8 +3390,8 @@ begin
   finally
     if FreeExpr then
       begin
-      NameExpr.Release;
-      InFileExpr.Release;
+      ReleaseAndNil(TPasElement(NameExpr));
+      ReleaseAndNil(TPasElement(InFileExpr));
       end;
   end;
 

packages/fcl-passrc/src/pscanner.pp

@@ -486,7 +486,7 @@ type
     po_ArrayRangeExpr,       // enable: create TPasArrayType.IndexRange, disable: create TPasArrayType.Ranges
     po_SelfToken,            // Self is a token. For backward compatibility.
     po_CheckModeSwitches,    // stop on unknown modeswitch with an error
-    po_CheckCondFunction     // stop on unknown function in conditional expression, default: return '0'
+    po_CheckCondFunction    // stop on unknown function in conditional expression, default: return '0'
     );
   TPOptions = set of TPOption;
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -315,6 +315,8 @@ type
     Procedure TestUnit_DuplicateUsesDiffNameFail;
     Procedure TestUnit_Unit1DotUnit2Fail;
     Procedure TestUnit_InFilename; // ToDo
+    Procedure TestUnit_MissingUnitErrorPos;
+    Procedure TestUnit_UnitNotFoundErrorPos;
 
     // procs
     Procedure TestProcParam;
@@ -1245,6 +1247,7 @@ end;
 procedure TCustomTestResolver.CheckResolverException(Msg: string; MsgNumber: integer);
 var
   ok: Boolean;
+  Full: String;
 begin
   ok:=false;
   try
@@ -1254,13 +1257,14 @@ begin
       begin
       AssertEquals('Expected {'+Msg+'}, but got msg {'+E.Message+'} number',
         MsgNumber,E.MsgNumber);
-      if (Msg<>E.Message) and (Msg<>E.MsgPattern) then
+      Full:=E.Message+' at '+E.SourcePos.FileName+' ('+IntToStr(E.SourcePos.Row)+','+IntToStr(E.SourcePos.Column)+')';
+      if (Msg<>E.Message) and (Msg<>E.MsgPattern) and (Msg<>Full) then
         begin
         {$IFDEF VerbosePasResolver}
         writeln('TCustomTestResolver.CheckResolverException E.MsgPattern={',E.MsgPattern,'}');
         {$ENDIF}
         AssertEquals('Expected message ('+IntToStr(MsgNumber)+')',
-          '{'+Msg+'}','{'+E.Message+'}');
+          '{'+Msg+'}','{'+E.Message+'} OR {'+E.MsgPattern+'} OR {'+Full+'}');
         end;
       ok:=true;
       end;
@@ -1278,8 +1282,8 @@ begin
   except
     on E: EParserError do
       begin
-      if (Parser.LastMsg<>Msg) and (Parser.LastMsgPattern<>Msg) then
-        Fail('Expected msg {'+Msg+'}, but got {'+Parser.LastMsg+'} OR pattern {'+Parser.LastMsgPattern+'}');
+      if (Parser.LastMsg<>Msg) and (Parser.LastMsgPattern<>Msg) and (E.Message<>Msg) then
+        Fail('Expected msg {'+Msg+'}, but got {'+Parser.LastMsg+'} OR pattern {'+Parser.LastMsgPattern+'} OR E.Message {'+E.Message+'}');
       AssertEquals('Expected {'+Msg+'}, but got msg {'+E.Message+'} number',
         MsgNumber,Parser.LastMsgNumber);
       ok:=true;
@@ -1718,8 +1722,9 @@ begin
     end;
   Result:=FindUnit(aUnitName);
   if Result<>nil then exit;
+  {$IFDEF VerbosePasResolver}
   writeln('TTestResolver.OnPasResolverFindUnit missing unit "',aUnitName,'"');
-  Fail('can''t find unit "'+aUnitName+'"');
+  {$ENDIF}
 end;
 
 procedure TCustomTestResolver.OnFindReference(El: TPasElement; FindData: pointer);
@@ -4557,6 +4562,30 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestUnit_MissingUnitErrorPos;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var j1: longint;']),
+    LinesToStr([
+    '']));
+  StartProgram(true);
+  Add([
+  'uses unit2, ;',
+  'begin']);
+  CheckParserException('Expected "Identifier" at token ";" in file afile.pp at line 2 column 13',
+    nParserExpectTokenError);
+end;
+
+procedure TTestResolver.TestUnit_UnitNotFoundErrorPos;
+begin
+  StartProgram(true);
+  Add([
+  'uses foo   ;',
+  'begin']);
+  CheckResolverException('can''t find unit "foo" at afile.pp (2,9)',nCantFindUnitX);
+end;
+
 procedure TTestResolver.TestProcParam;
 begin
   StartProgram(false);
@@ -5570,15 +5599,15 @@ begin
   '    {#C}c: longint;',
   '  end;',
   '  {$M-}',
-  //'  TPic = class',
-  //'    {#D}d: longint;',
-  //'  end;',
-  //'  TComponent = class(TPersistent)',
-  //'    {#E}e: longint;',
-  //'  end;',
-  //'  TControl = class(TComponent)',
-  //'    {#F}f: longint;',
-  //'  end;',
+  '  TPic = class',
+  '    {#D}d: longint;',
+  '  end;',
+  '  TComponent = class(TPersistent)',
+  '    {#E}e: longint;',
+  '  end;',
+  '  TControl = class(TComponent)',
+  '    {#F}f: longint;',
+  '  end;',
   'begin']);
   ParseProgram;
   aMarker:=FirstSrcMarker;

utils/fpdoc/fpdoc.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
@@ -17,9 +17,6 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
     </BuildModes>