fcl-passrc: resolver+useanalyzer: implemented resourcestring

git-svn-id: trunk@37392 -

packages/fcl-passrc/src/pasresolver.pp

@@ -982,6 +982,7 @@ type
     procedure AddRecordType(El: TPasRecordType); virtual;
     procedure AddClassType(El: TPasClassType); virtual;
     procedure AddVariable(El: TPasVariable); virtual;
+    procedure AddResourceString(El: TPasResString); virtual;
     procedure AddEnumType(El: TPasEnumType); virtual;
     procedure AddEnumValue(El: TPasEnumValue); virtual;
     procedure AddProperty(El: TPasProperty); virtual;
@@ -1035,6 +1036,7 @@ type
     procedure FinishClassOfType(El: TPasClassOfType); virtual;
     procedure FinishArrayType(El: TPasArrayType); virtual;
     procedure FinishConstDef(El: TPasConst); virtual;
+    procedure FinishResourcestring(El: TPasResString); virtual;
     procedure FinishProcedure(aProc: TPasProcedure); virtual;
     procedure FinishProcedureType(El: TPasProcedureType); virtual;
     procedure FinishMethodDeclHeader(Proc: TPasProcedure); virtual;
@@ -3484,6 +3486,16 @@ begin
     Eval(El.Expr,[refConst])
 end;
 
+procedure TPasResolver.FinishResourcestring(El: TPasResString);
+var
+  ResolvedEl: TPasResolverResult;
+begin
+  ResolveExpr(El.Expr,rraRead);
+  ComputeElement(El.Expr,ResolvedEl,[rcConstant]);
+  if not (ResolvedEl.BaseType in btAllStringAndChars) then
+    RaiseXExpectedButYFound(20171004135753,'string',GetTypeDescription(ResolvedEl),El.Expr);
+end;
+
 procedure TPasResolver.FinishProcedure(aProc: TPasProcedure);
 var
   i: Integer;
@@ -6159,6 +6171,21 @@ begin
   AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
 end;
 
+procedure TPasResolver.AddResourceString(El: TPasResString);
+var
+  C: TClass;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddResourceString ',GetObjName(El));
+  {$ENDIF}
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(20171004092114,El);
+  C:=El.Parent.ClassType;
+  if not C.InheritsFrom(TPasSection) then
+    RaiseNotYetImplemented(20171004092518,El);
+  AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+end;
+
 procedure TPasResolver.AddEnumType(El: TPasEnumType);
 var
   CanonicalSet: TPasSetType;
@@ -9383,6 +9410,8 @@ begin
   if (AClass=TPasVariable)
       or (AClass=TPasConst) then
     AddVariable(TPasVariable(El))
+  else if AClass=TPasResString then
+    AddResourceString(TPasResString(El))
   else if (AClass=TPasProperty) then
     AddProperty(TPasProperty(El))
   else if AClass=TPasArgument then
@@ -9435,7 +9464,7 @@ begin
   else if AClass.InheritsFrom(TPasExpr) then
     // resolved when finished
   else if AClass.InheritsFrom(TPasImplBlock) then
-    // resolved finished
+    // resolved when finished
   else
     RaiseNotYetImplemented(20160922163544,El);
 end;
@@ -13447,6 +13476,8 @@ begin
     if BaseTypes[btShortString]=nil then
       RaiseMsg(20170419203146,nIllegalQualifier,sIllegalQualifier,['['],El);
     end
+  else if ElClass=TPasResString then
+    SetResolverIdentifier(ResolvedEl,btString,El,nil,[rrfReadable])
   else
     RaiseNotYetImplemented(20160922163705,El);
 end;

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -205,6 +205,7 @@ type
     procedure UseClassType(El: TPasClassType; Mode: TPAUseMode); virtual;
     procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
+    procedure UseResourcestring(El: TPasResString); virtual;
     procedure UseArgument(El: TPasArgument; Access: TResolvedRefAccess); virtual;
     procedure UseResultElement(El: TPasResultElement; Access: TResolvedRefAccess); virtual;
     // create hints for a unit, program or library
@@ -607,6 +608,8 @@ begin
     UseArgument(TPasArgument(El),Access)
   else if C=TPasResultElement then
     UseResultElement(TPasResultElement(El),Access)
+  else if C=TPasResString then
+    UseResourcestring(TPasResString(El))
   else if C.InheritsFrom(TPasProcedure) then
     UseProcedure(TPasProcedure(El))
   else if C.InheritsFrom(TPasExpr) then
@@ -753,6 +756,7 @@ var
   Decl: TPasElement;
   OnlyExports: Boolean;
   UsesClause: TPasUsesClause;
+  C: TClass;
 begin
   // Section is TProgramSection, TLibrarySection, TInterfaceSection, TImplementationSection
   if Mode=paumElement then
@@ -798,20 +802,23 @@ begin
     {$IFDEF VerbosePasAnalyzer}
     writeln('TPasAnalyzer.UseSection ',Section.ClassName,' Decl=',GetElModName(Decl),' Mode=',Mode);
     {$ENDIF}
-    if Decl is TPasProcedure then
+    C:=Decl.ClassType;
+    if C.InheritsFrom(TPasProcedure) then
       begin
       if OnlyExports and ([pmExport,pmPublic]*TPasProcedure(Decl).Modifiers=[]) then
         continue;
       UseProcedure(TPasProcedure(Decl))
       end
-    else if Decl is TPasType then
+    else if C.InheritsFrom(TPasType) then
       UseType(TPasType(Decl),Mode)
-    else if Decl is TPasVariable then
+    else if C.InheritsFrom(TPasVariable) then
       begin
       if OnlyExports and ([vmExport,vmPublic]*TPasVariable(Decl).VarModifiers=[]) then
         continue;
       UseVariable(TPasVariable(Decl),rraNone,true);
       end
+    else if C=TPasResString then
+      UseResourcestring(TPasResString(Decl))
     else
       RaiseNotSupported(20170306165213,Decl);
     end;
@@ -1491,6 +1498,12 @@ begin
     end;
 end;
 
+procedure TPasAnalyzer.UseResourcestring(El: TPasResString);
+begin
+  if MarkElementAsUsed(El) then
+    UseExpr(El.Expr);
+end;
+
 procedure TPasAnalyzer.UseArgument(El: TPasArgument; Access: TResolvedRefAccess
   );
 var

packages/fcl-passrc/src/pparser.pp

@@ -78,6 +78,7 @@ const
   nParserExpectedExternalClassName = 2051;
   nParserNoConstRangeAllowed = 2052;
   nErrRecordVariablesNotAllowed = 2053;
+  nParserResourcestringsMustBeGlobal = 2054;
 
 // resourcestring patterns of messages
 resourcestring
@@ -134,6 +135,7 @@ resourcestring
   SParserPropertyArgumentsCanNotHaveDefaultValues = 'Property arguments can not have default values';
   SParserExpectedExternalClassName = 'Expected external class name';
   SParserNoConstRangeAllowed = 'Const ranges are not allowed';
+  SParserResourcestringsMustBeGlobal = 'Resourcestrings can be only static or global';
 
 type
   TPasScopeType = (
@@ -2998,7 +3000,15 @@ begin
       tkexports:
         SetBlock(declExports);
       tkResourcestring:
-        SetBlock(declResourcestring);
+        if Declarations is TPasSection then
+          SetBlock(declResourcestring)
+        else
+          begin
+          { $IFDEF VerbosePasParser}
+          writeln('TPasParser.ParseDeclarations ',Declarations.Parent.ClassName);
+          { $ENDIF}
+          ParseExc(nParserResourcestringsMustBeGlobal,SParserResourcestringsMustBeGlobal);
+          end;
       tkType:
         SetBlock(declType);
       tkVar:

packages/fcl-passrc/tests/tcresolver.pas

@@ -619,6 +619,13 @@ type
     Procedure TestPointer_TypecastMethod_proMethodAddrAsPointer;
     Procedure TestPointer_OverloadSignature;
 
+    // resourcestrings
+    Procedure TestResourcestring;
+    Procedure TestResourcestringAssignFail;
+    Procedure TestResourcestringLocalFail;
+    Procedure TestResourcestringInConstFail;
+    Procedure TestResourcestringPassVarArgFail;
+
     // hints
     Procedure TestHint_ElementHints;
     Procedure TestHint_ElementHintsMsg;
@@ -10397,6 +10404,70 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestResourcestring;
+begin
+  StartProgram(false);
+  Add([
+  'const Foo = ''foo'';',
+  'Resourcestring',
+  '  Bar = foo;',
+  '  Red = ''Red'';',
+  '  r = ''Rd''+foo;',
+  'procedure DoIt(s: string; const h: string); begin end;',
+  'begin',
+  '  if bar=red then ;',
+  '  if bar=''a'' then ;',
+  '  doit(r,r);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestResourcestringAssignFail;
+begin
+  StartProgram(false);
+  Add([
+  'Resourcestring Foo = ''bar'';',
+  'begin',
+  '  Foo:=''a'';',
+  '']);
+  CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
+end;
+
+procedure TTestResolver.TestResourcestringLocalFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'Resourcestring Foo = ''bar'';',
+  'begin end;',
+  'begin;',
+  '']);
+  CheckParserException(SParserResourcestringsMustBeGlobal,nParserResourcestringsMustBeGlobal);
+end;
+
+procedure TTestResolver.TestResourcestringInConstFail;
+begin
+  StartProgram(false);
+  Add([
+  'Resourcestring Foo = ''foo'';',
+  'const Bar = ''Prefix''+Foo;',
+  'begin',
+  '']);
+  CheckResolverException(sConstantExpressionExpected,nConstantExpressionExpected);
+end;
+
+procedure TTestResolver.TestResourcestringPassVarArgFail;
+begin
+  StartProgram(false);
+  Add([
+  'Resourcestring Bar = ''foo'';',
+  'procedure DoIt(var s: string); begin end;',
+  'begin',
+  '  doit(bar);',
+  '']);
+  CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
+end;
+
 procedure TTestResolver.TestHint_ElementHints;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -545,6 +545,7 @@ end;
 procedure TTestUseAnalyzer.TestM_Const;
 begin
   StartProgram(false);
+  Add('resourcestring {#rs_used}rs = ''txt'';');
   Add('procedure {#DoIt_used}DoIt;');
   Add('var');
   Add('  {#a_used}a: longint;');
@@ -555,7 +556,7 @@ begin
   Add('  a:=+1;');
   Add('  b:=true;');
   Add('  c:=nil;');
-  Add('  d:=''foo'';');
+  Add('  d:=''foo''+rs;');
   Add('end;');
   Add('begin');
   Add('  DoIt;');