* fix for Mantis #37251: apply patches by Bi0T1N to implement the IsConstValue() intrinsic

+ added tests

git-svn-id: trunk@45695 -

.gitattributes

@@ -15121,6 +15121,10 @@ tests/test/tintfcdecl1.pp svneol=native#text/plain
 tests/test/tintfcdecl2.pp svneol=native#text/plain
 tests/test/tintfdef.pp svneol=native#text/plain
 tests/test/tintuint.pp svneol=native#text/plain
+tests/test/tisconstvalue1.pp svneol=native#text/pascal
+tests/test/tisconstvalue2.pp svneol=native#text/pascal
+tests/test/tisconstvalue3.pp svneol=native#text/pascal
+tests/test/tisconstvalue4.pp svneol=native#text/pascal
 tests/test/tismngd1.pp svneol=native#text/pascal
 tests/test/tismngd2.pp svneol=native#text/pascal
 tests/test/tisobuf1.pp svneol=native#text/pascal

compiler/compinnr.pas

@@ -163,12 +163,15 @@ type
      in_mmx_pcmpeqd      = 202,
      in_mmx_pcmpgtb      = 203,
      in_mmx_pcmpgtw      = 204,
-     in_mmx_pcmpgtd      = 205
+     in_mmx_pcmpgtd      = 205,
 
      { 3DNow }
 
      { SSE }
 
+{ More internal functions }
+     in_isconstvalue_x    = 1000
+
 {$if defined(X86)}
      ,
      {$i x86/cx86innr.inc}

compiler/ninl.pas

@@ -3169,6 +3169,12 @@ implementation
                   resultdef:=pasbool1type;
                 end;
 
+              in_isconstvalue_x:
+                begin
+                  set_varstate(left,vs_read,[vsf_must_be_valid]);
+                  resultdef:=pasbool1type;
+                end;
+
               in_assigned_x:
                 begin
                   { the parser has already made sure the expression is valid }
@@ -3863,6 +3869,14 @@ implementation
                 result:=cordconstnode.create(0,resultdef,false);
             end;
 
+          in_isconstvalue_x:
+            begin
+              if is_constnode(left) then
+                result:=cordconstnode.create(1,resultdef,false)
+              else
+                result:=cordconstnode.create(0,resultdef,false);
+            end;
+
           in_assigned_x:
             begin
               result:=first_assigned;

compiler/pexpr.pas

@@ -524,6 +524,16 @@ implementation
                 end;
             end;
 
+          in_isconstvalue_x:
+            begin
+              consume(_LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr([ef_accept_equal]);
+              consume(_RKLAMMER);
+              p2:=geninlinenode(l,false,p1);
+              statement_syssym:=p2;
+            end;
+
           in_aligned_x,
           in_unaligned_x,
           in_volatile_x:

compiler/psystem.pas

@@ -112,6 +112,7 @@ implementation
         systemunit.insert(csyssym.create('Delete',in_delete_x_y_z));
         systemunit.insert(csyssym.create('GetTypeKind',in_gettypekind_x));
         systemunit.insert(csyssym.create('IsManagedType',in_ismanagedtype_x));
+        systemunit.insert(csyssym.create('IsConstValue',in_isconstvalue_x));
         systemunit.insert(csyssym.create('fpc_eh_return_data_regno', in_const_eh_return_data_regno));
         systemunit.insert(cconstsym.create_ord('False',constord,0,pasbool1type));
         systemunit.insert(cconstsym.create_ord('True',constord,1,pasbool1type));

tests/test/tisconstvalue1.pp

@@ -0,0 +1,148 @@
+program tisconstvalue1;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TTestLongInt = record
+    a: LongInt;
+  end;
+
+  TTestAnsiString = record
+    a: AnsiString;
+  end;
+{
+  TTestManaged = record
+    a: LongInt;
+    class operator Initialize(var aTestManaged: TTestManaged);
+  end;
+
+  class operator TTestManaged.Initialize(var aTestManaged: TTestManaged);
+  begin
+    aTestManaged.a := 42;
+  end;
+}
+type
+  TDynArrayLongInt = array of LongInt;
+  TStaticArrayAnsiString = array[0..4] of AnsiString;
+
+  TEnum = (eOne, eTwo, eThree);
+  TSet = set of (sOne, sTwo, sThree);
+
+const
+  // untyped
+  Number = 100;
+  Str = 'Hello World!';
+  Dbl = 1.1;
+  NilPtr = nil;
+  IsConst = True;
+  GUID = '{10101010-1010-0101-1001-110110110110}';
+  // typed
+  IntConst: Integer = 13;
+  RealConst: Real = 12;
+  Alphabet: array [1..26] of char =
+       ('A','B','C','D','E','F','G','H','I',
+        'J','K','L','M','N','O','P','Q','R',
+        'S','T','U','V','W','X','Y','Z');
+  MyGUID: TGUID = '{10101010-1010-0101-1001-110110110110}';
+  Bool: Boolean = False;
+
+var
+  l: LongInt;
+  o: TObject;
+  _as: AnsiString;
+  lir: TTestLongInt;
+  asr: TTestAnsiString;
+  //mr: TTestManaged;
+  liarr: TDynArrayLongInt;
+  sasarr: TStaticArrayAnsiString;
+
+begin
+  l := 1;
+  if IsConstValue(l) then
+    Halt(1);
+
+  o := TObject.Create;
+  try
+    if IsConstValue(o) then
+      Halt(2);
+  finally
+    o.Free;
+  end;
+
+  _as := 'Hello World!';
+  if IsConstValue(_as) then
+    Halt(3);
+
+  if not IsConstValue(eOne) then
+    Halt(4);
+  if not IsConstValue(eTwo) then
+    Halt(5);
+  if not IsConstValue(eThree) then
+    Halt(6);
+
+  if not IsConstValue(Number) then
+    Halt(7);
+  if not IsConstValue(Str) then
+    Halt(8);
+
+  lir.a := 5;
+  if IsConstValue(lir) then
+    Halt(9);
+
+  asr.a := 'Hello World!';
+  if IsConstValue(asr) then
+    Halt(10);
+{
+  if IsConstValue(mr) then
+    Halt(11);
+}
+  SetLength(liarr, 2);
+  liarr[0] := 1;
+  liarr[1] := 2;
+  if IsConstValue(liarr) then
+    Halt(12);
+
+  sasarr[0] := 'Hell';
+  sasarr[1] := 'o ';
+  sasarr[2] := 'Wor';
+  sasarr[3] := 'ld!';
+  if IsConstValue(sasarr) then
+    Halt(13);
+
+  if not IsConstValue(sOne) then
+    Halt(14);
+  if not IsConstValue(sTwo) then
+    Halt(15);
+  if not IsConstValue(sThree) then
+    Halt(16);
+
+  if not IsConstValue(Dbl) then
+    Halt(17);
+
+  if not IsConstValue(NilPtr) then
+    Halt(18);
+
+  if not IsConstValue(IsConst) then
+    Halt(19);
+
+  if not IsConstValue(GUID) then
+    Halt(20);
+
+  if IsConstValue(IntConst) then
+    Halt(21);
+
+  if IsConstValue(RealConst) then
+    Halt(22);
+
+  if IsConstValue(Alphabet) then
+    Halt(23);
+
+  if IsConstValue(MyGUID) then
+    Halt(24);
+
+  if IsConstValue(Bool) then
+    Halt(25);
+
+  Writeln('Ok');
+end.

tests/test/tisconstvalue2.pp

@@ -0,0 +1,62 @@
+program tisconstvalue2;
+
+{$mode Delphi}
+
+// example taken from https://stackoverflow.com/a/30417597
+
+type
+  TFlavor = (Tasty, Nasty);
+
+  TIntegerHelper = record helper for Integer
+  private
+    function GetTastyPoint: Integer;
+    function GetNastyPoint: Integer;
+  public
+    function GetSomething(Flavor: TFlavor): Integer; inline;
+  end;
+
+  function TIntegerHelper.GetTastyPoint: Integer;
+  begin
+    Result := 10;
+  end;
+
+  function TIntegerHelper.GetNastyPoint: Integer;
+  begin
+    Result := -10;
+  end;
+
+  function TIntegerHelper.GetSomething(Flavor: TFlavor): Integer;
+  begin
+    if IsConstValue(Flavor) then
+    begin
+      if Flavor = Tasty then
+        Result := Self.GetTastyPoint
+      else
+        Result := Self.GetNastyPoint;
+    end
+    else
+    begin
+      Result := 0;
+    end;
+  end;
+
+var
+  i: Integer;
+  n: TFlavor;
+
+begin
+  i := 100000.GetSomething(Tasty);
+  if i <> 10 then
+    Halt(1);
+
+  n := Tasty;
+  i := 100000.GetSomething(Nasty);
+  if i <> -10 then
+    Halt(2);
+
+  i := 100000.GetSomething(n);
+  if i <> 0 then
+    Halt(3);
+
+  Writeln('Ok');
+end.

tests/test/tisconstvalue3.pp

@@ -0,0 +1,131 @@
+program tisconstvalue3;
+
+{$IFDEF FPC}
+  {$mode Delphi}
+{$ENDIF}
+
+type
+  TMyClass = class
+  const
+    PI = 3.14;
+  private
+    FNumber: Integer;
+  public
+    function DoMathAndReturn(const AValue: Integer): Integer;
+  published
+    property MyNumber: Integer read FNumber;
+  end;
+
+  TClassOf = class of TMyClass;
+
+  function TMyClass.DoMathAndReturn(const AValue: Integer): Integer;
+  begin
+    Result := FNumber * 2;
+  end;
+
+function WorldCopy(AInput: String): String;
+begin
+  if IsConstValue(AInput) then
+    Halt(9);
+
+  Result := 'Hello ' + AInput;
+end;
+
+function WorldConst(const AInput: String): String;
+begin
+  if IsConstValue(AInput) then
+    Halt(10);
+
+  Result := 'Hello ' + AInput;
+end;
+
+function WorldVar(var AInput: String): String;
+begin
+  if IsConstValue(AInput) then
+    Halt(11);
+
+  Result := 'Hello ' + AInput;
+end;
+
+function WorldOut(out AInput: String): String;
+begin
+  AInput := 'Test';
+  if IsConstValue(AInput) then
+    Halt(12);
+
+  Result := 'Hello ' + AInput;
+end;
+
+var
+  MyClass: TMyClass;
+  MyString: String;
+
+const
+  SomeClass: TClass = TMyClass;
+
+begin
+  if IsConstValue(TMyClass) then
+    Halt(1);
+
+  MyClass := TMyClass.Create;
+  try
+    if IsConstValue(MyClass) then
+      Halt(3);
+
+    if IsConstValue(MyClass.MyNumber) then
+      Halt(4);
+
+    if not IsConstValue(MyClass.PI) then
+      Halt(5);
+
+    if IsConstValue(MyClass.DoMathAndReturn(5)) then
+      Halt(6);
+
+    if IsConstValue(@MyClass) then
+      Halt(7);
+  finally
+    MyClass.Free;
+  end;
+
+  if IsConstValue(@WorldCopy) then
+    Halt(8);
+
+  WorldCopy('World');
+  WorldConst('World');
+  MyString := 'World';
+  WorldVar(MyString);
+  WorldOut(MyString);
+
+  if IsConstValue(WorldCopy('World')) then
+    Halt(13);
+
+  if IsConstValue(MyString) then
+    Halt(14);
+
+  if IsConstValue(@MyString) then
+    Halt(15);
+
+  UniqueString(MyString);
+  if IsConstValue(MyString) then
+    Halt(16);
+
+  if not IsConstValue('Hello') then
+    Halt(17);
+
+  if not IsConstValue(3.14) then
+    Halt(17);
+
+  if not IsConstValue(12345) then
+    Halt(18);
+
+  if not IsConstValue(5 <> 2) then
+    Halt(19);
+
+  if not IsConstValue(5 - 5 = 0) then
+    Halt(20);
+
+  if IsConstValue(SomeClass) then
+    Halt(21);
+
+  Writeln('Ok');
+end.

tests/test/tisconstvalue4.pp

@@ -0,0 +1,34 @@
+{ %FAIL }
+program tisconstvalue4;
+
+{$IFDEF FPC}
+  {$mode Delphi}
+{$ENDIF}
+
+type
+  TMyClass = class
+  const
+    PI = 3.14;
+  private
+    FNumber: Integer;
+  public
+    function DoMathAndReturn(const AValue: Integer): Integer;
+  published
+    property MyNumber: Integer read FNumber;
+  end;
+
+  TClassOf = class of TMyClass;
+
+  function TMyClass.DoMathAndReturn(const AValue: Integer): Integer;
+  begin
+    Result := FNumber * 2;
+  end;
+
+begin
+  // Error: type identifier not allowed here
+  if IsConstValue(TClassOf) then
+    Halt(1);
+
+  Writeln('Ok');
+end.
+