fcl-passrc: resolver: fixed setofint:=[0]

git-svn-id: trunk@39395 -

packages/fcl-passrc/src/pasresolver.pp

@@ -209,14 +209,17 @@ Works:
   - float*currency and currency*float computes to currency
 - type alias type overloads
 - $writeableconst off $J-
+- $warn identifier ON|off|error|default
 
 ToDo:
-- $warn identifier ON|off|error|default
 - $H-hintpos$H+
 - $pop, $push
 - $RTTI inherited|explicit
 - range checking:
   - property defaultvalue
+  - IntSet:=[-1]
+  - CharSet:=[#13]
+- Include/Exclude for set of int/char/bool
 - proc: check if forward and impl default values match
 - call array of proc without ()
 - array+array
@@ -4701,7 +4704,7 @@ var
   C: TClass;
   EnumType: TPasType;
 begin
-  EnumType:=El.EnumType;
+  EnumType:=ResolveAliasType(El.EnumType);
   C:=EnumType.ClassType;
   if C=TPasEnumType then
     begin
@@ -12028,7 +12031,8 @@ begin
     exit(cIncompatible);
   Params:=TParamsExpr(Expr);
 
-  // first param: variable of set of enumtype
+  // first param: set variable
+  // todo set of int, set of char, set of bool
   Param:=Params.Params[0];
   ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
   EnumType:=nil;
@@ -16489,7 +16493,19 @@ begin
             and HasExactType(RHS) then
           Result:=cExact
         else if LHS.SubType=RHS.SubType then
-          Result:=cAliasExact;
+          Result:=cAliasExact
+        else if (LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans) then
+          Result:=cCompatible
+        else if (LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger) then
+          begin
+          // ToDo: range check
+          Result:=cCompatible;
+          end
+        else if (LHS.SubType in btAllChars) and (RHS.SubType in btAllChars) then
+          begin
+          // ToDo: range check
+          Result:=cCompatible;
+          end;
         end;
       end
     else if LBT in [btArrayLit,btArrayOrSet,btModule,btProc] then

packages/fcl-passrc/tests/tcresolver.pas

@@ -270,6 +270,7 @@ type
     Procedure TestEnumSet_AnonymousEnumtypeName;
     Procedure TestEnumSet_Const;
     Procedure TestSet_IntRange_Const;
+    Procedure TestSet_Byte_Const;
     Procedure TestEnumRange;
     Procedure TestEnum_ForIn;
     Procedure TestEnum_ForInRangeFail;
@@ -1616,6 +1617,7 @@ begin
 end;
 
 procedure TCustomTestResolver.CheckParamsExpr_pkSet_Markers;
+// e.g. {#a_set}  {#b_array}
 var
   aMarker: PSrcMarker;
   p: SizeInt;
@@ -3768,15 +3770,49 @@ begin
   '  TIntRg = 2..6;',
   '  TFiveSet = set of TIntRg;',
   'const',
-  '  a: TFiveSet = [2..3,5]+[4];',
+  '  Three = 3;',
+  '  a: TFiveSet = [2..Three,5]+[4];',
   '  b = low(TIntRg)+high(TIntRg);',
   '  c = [low(TIntRg)..high(TIntRg)];',
   'var',
   '  s: TFiveSet;',
   'begin',
+  '  s:= {#s1_set}[];',
+  '  s:= {#s2_set}[3];',
+  '  s:= {#s3_set}[3..4];',
+  '  s:= {#s4_set}[Three];',
   '  if 3 in a then ;',
   '  s:=c;']);
   ParseProgram;
+  CheckParamsExpr_pkSet_Markers;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestSet_Byte_Const;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TIntRg = byte;',
+  '  TFiveSet = set of TIntRg;',
+  'const',
+  '  Three = 3;',
+  '  a: TFiveSet = [2..Three,5]+[4];',
+  '  b = low(TIntRg)+high(TIntRg);',
+  '  c = [low(TIntRg)..high(TIntRg)];',
+  'var',
+  '  s: TFiveSet;',
+  'begin',
+  '  s:= {#s1_set}[];',
+  '  s:= {#s2_set}[3];',
+  '  s:= {#s3_set}[3..4];',
+  '  s:= {#s4_set}[Three];',
+  '  if 3 in a then ;',
+  '  s:=c;',
+  //'  Include(s,Three);', // ToDo
+  '']);
+  ParseProgram;
+  CheckParamsExpr_pkSet_Markers;
   CheckResolverUnexpectedHints;
 end;
 

packages/pastojs/tests/tcmodules.pas

@@ -333,7 +333,7 @@ type
     Procedure TestEnumRange_Array;
     Procedure TestEnum_ForIn;
     Procedure TestEnum_ScopedNumber;
-    Procedure TestSet;
+    Procedure TestSet_Enum;
     Procedure TestSet_Operators;
     Procedure TestSet_Operator_In;
     Procedure TestSet_Functions;
@@ -341,6 +341,7 @@ type
     Procedure TestSet_AsParams;
     Procedure TestSet_Property;
     Procedure TestSet_EnumConst;
+    Procedure TestSet_IntConst;
     Procedure TestSet_AnonymousEnumType;
     Procedure TestSet_AnonymousEnumTypeChar; // ToDo
     Procedure TestSet_ConstEnum;
@@ -4166,7 +4167,7 @@ begin
     '$mod.e = 1;']));
 end;
 
-procedure TTestModule.TestSet;
+procedure TTestModule.TestSet_Enum;
 begin
   StartProgram(false);
   Add([
@@ -4554,21 +4555,22 @@ end;
 procedure TTestModule.TestSet_EnumConst;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TEnum = (Red,Blue);');
-  Add('  TEnums = set of TEnum;');
-  Add('const');
-  Add('  Orange = red;');
-  Add('var');
-  Add('  Enum: tenum;');
-  Add('  Enums: tenums;');
-  Add('begin');
-  Add('  Include(enums,orange);');
-  Add('  Exclude(enums,orange);');
-  Add('  if orange in enums then;');
-  Add('  if orange in [orange,red] then;');
+  Add([
+  'type',
+  '  TEnum = (Red,Blue);',
+  '  TEnums = set of TEnum;',
+  'const',
+  '  Orange = red;',
+  'var',
+  '  Enum: tenum;',
+  '  Enums: tenums;',
+  'begin',
+  '  Include(enums,orange);',
+  '  Exclude(enums,orange);',
+  '  if orange in enums then;',
+  '  if orange in [orange,red] then;']);
   ConvertProgram;
-  CheckSource('TestEnumConst',
+  CheckSource('TestSet_EnumConst',
     LinesToStr([ // statements
     'this.TEnum = {',
     '  "0": "Red",',
@@ -4588,6 +4590,41 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestSet_IntConst;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEnums = set of Byte;',
+  'const',
+  '  Orange = 0;',
+  'var',
+  '  Enum: byte;',
+  '  Enums: tenums;',
+  'begin',
+  '  Enums:=[];',
+  '  Enums:=[0];',
+  '  Enums:=[1..2];',
+  //'  Include(enums,orange);',
+  //'  Exclude(enums,orange);',
+  '  if orange in enums then;',
+  '  if orange in [orange,1] then;']);
+  ConvertProgram;
+  CheckSource('TestSet_IntConst',
+    LinesToStr([ // statements
+    'this.Orange = 0;',
+    'this.Enum = 0;',
+    'this.Enums = {};',
+    '']),
+    LinesToStr([
+    '$mod.Enums = {};',
+    '$mod.Enums = rtl.createSet(0);',
+    '$mod.Enums = rtl.createSet(null, 1, 2);',
+    'if (0 in $mod.Enums) ;',
+    'if (0 in rtl.createSet(0, 1)) ;',
+    '']));
+end;
+
 procedure TTestModule.TestSet_AnonymousEnumType;
 begin
   StartProgram(false);

packages/pastojs/tests/tcprecompile.pas

@@ -34,15 +34,18 @@ type
 
   TCustomTestCLI_Precompile = class(TCustomTestCLI)
   private
-    FFormat: TPas2JSPrecompileFormat;
+    FPCUFormat: TPas2JSPrecompileFormat;
+    FUnitOutputDir: string;
   protected
+    procedure SetUp; override;
     procedure CheckPrecompile(MainFile, UnitPaths: string;
       SharedParams: TStringList = nil;
       FirstRunParams: TStringList = nil;
       SecondRunParams: TStringList = nil; ExpExitCode: integer = 0);
   public
     constructor Create; override;
-    property Format: TPas2JSPrecompileFormat read FFormat write FFormat;
+    property PCUFormat: TPas2JSPrecompileFormat read FPCUFormat write FPCUFormat;
+    property UnitOutputDir: string read FUnitOutputDir write FUnitOutputDir;
   end;
 
   { TTestCLI_Precompile }
@@ -57,6 +60,7 @@ type
     procedure TestPCU_ClassForward;
     procedure TestPCU_ClassConstructor;
     procedure TestPCU_ClassInterface;
+    procedure TestPCU_Namespace;
   end;
 
 function LinesToList(const Lines: array of string): TStringList;
@@ -73,15 +77,20 @@ end;
 
 { TCustomTestCLI_Precompile }
 
+procedure TCustomTestCLI_Precompile.SetUp;
+begin
+  inherited SetUp;
+  UnitOutputDir:='units';
+end;
+
 procedure TCustomTestCLI_Precompile.CheckPrecompile(MainFile,
   UnitPaths: string; SharedParams: TStringList; FirstRunParams: TStringList;
   SecondRunParams: TStringList; ExpExitCode: integer);
 var
-  UnitOutputDir, JSFilename, OrigSrc, NewSrc, s: String;
+  JSFilename, OrigSrc, NewSrc, s: String;
   JSFile: TCLIFile;
 begin
   try
-    UnitOutputDir:='units';
     AddDir(UnitOutputDir);
     // compile, create  .pcu files
     {$IFDEF VerbosePCUFiler}
@@ -92,8 +101,8 @@ begin
       Params.Assign(SharedParams);
     if FirstRunParams<>nil then
       Params.AddStrings(FirstRunParams);
-    Compile([MainFile,'-Jc','-Fu'+UnitPaths,'-JU'+Format.Ext,'-FU'+UnitOutputDir]);
-    AssertFileExists('units/system.'+Format.Ext);
+    Compile([MainFile,'-Jc','-Fu'+UnitPaths,'-JU'+PCUFormat.Ext,'-FU'+UnitOutputDir]);
+    AssertFileExists(UnitOutputDir+'/system.'+PCUFormat.Ext);
     JSFilename:=UnitOutputDir+PathDelim+ExtractFilenameOnly(MainFile)+'.js';
     AssertFileExists(JSFilename);
     JSFile:=FindFile(JSFilename);
@@ -129,7 +138,7 @@ end;
 constructor TCustomTestCLI_Precompile.Create;
 begin
   inherited Create;
-  FFormat:=PrecompileFormats[0];
+  FPCUFormat:=PrecompileFormats[0];
 end;
 
 { TTestCLI_Precompile }
@@ -384,6 +393,35 @@ begin
   CheckPrecompile('test1.pas','src');
 end;
 
+procedure TTestCLI_Precompile.TestPCU_Namespace;
+begin
+  AddUnit('src/system.pp',[
+    'type integer = longint;',
+    'procedure Writeln; varargs;'],
+    ['procedure Writeln; begin end;']);
+  AddUnit('src/Web.Unit1.pp',[
+    'var i: integer;',
+    ''],[
+    '']);
+  AddUnit('src/Unit2.pp',[
+    'uses WEB.uNit1;',
+    'procedure DoIt;',
+    ''],[
+    'procedure DoIt;',
+    'begin',
+    '  writeln(i);',
+    'end;',
+    '']);
+  AddFile('test1.pas',[
+    'uses unIT2;',
+    'begin',
+    '  DoIt;',
+    'end.']);
+  CheckPrecompile('test1.pas','src');
+  AssertFileExists(UnitOutputDir+'/Unit2.'+PCUFormat.Ext);
+  AssertFileExists(UnitOutputDir+'/Web.Unit1.'+PCUFormat.Ext);
+end;
+
 Initialization
   {$IFDEF EnablePas2jsPrecompiled}
   RegisterTests([TTestCLI_Precompile]);