# revisions: 43409,43473,43474,43482

git-svn-id: branches/fixes_3_2@43944 -

.gitattributes

@@ -13437,6 +13437,8 @@ 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/tismngd1.pp svneol=native#text/pascal
+tests/test/tismngd2.pp svneol=native#text/pascal
 tests/test/tisobuf1.pp svneol=native#text/pascal
 tests/test/tisobuf2.pp svneol=native#text/pascal
 tests/test/tisoext1.pp svneol=native#text/pascal

compiler/compinnr.pas

@@ -117,6 +117,7 @@ type
      in_not_assign_x      = 95,
      in_gettypekind_x     = 96,
      in_faraddr_x         = 97,
+     in_ismanagedtype_x   = 99,
 
 { Internal constant functions }
      in_const_sqr        = 100,

compiler/ninl.pas

@@ -3057,6 +3057,14 @@ implementation
                   resultdef:=typekindtype;
                 end;
 
+              in_ismanagedtype_x:
+                begin
+                  if target_info.system in systems_managed_vm then
+                    message(parser_e_feature_unsupported_for_vm);
+                  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 }
@@ -3732,6 +3740,14 @@ implementation
               result:=genenumnode(tenumsym(sym));
             end;
 
+          in_ismanagedtype_x:
+            begin
+              if left.resultdef.needs_inittable 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

@@ -473,9 +473,10 @@ implementation
 
           in_typeinfo_x,
           in_objc_encode_x,
-          in_gettypekind_x:
+          in_gettypekind_x,
+          in_ismanagedtype_x:
             begin
-              if (l in [in_typeinfo_x,in_gettypekind_x]) or
+              if (l in [in_typeinfo_x,in_gettypekind_x,in_ismanagedtype_x]) or
                  (m_objectivec1 in current_settings.modeswitches) then
                 begin
                   consume(_LKLAMMER);
@@ -494,7 +495,7 @@ implementation
                   begin
                     ttypenode(p1).allowed:=true;
                     { allow helpers for TypeInfo }
-                    if l in [in_typeinfo_x,in_gettypekind_x] then
+                    if l in [in_typeinfo_x,in_gettypekind_x,in_ismanagedtype_x] then
                       ttypenode(p1).helperallowed:=true;
                   end;
     {              else

compiler/psystem.pas

@@ -110,6 +110,7 @@ implementation
         systemunit.insert(csyssym.create('Insert',in_insert_x_y_z));
         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(cconstsym.create_ord('False',constord,0,pasbool1type));
         systemunit.insert(cconstsym.create_ord('True',constord,1,pasbool1type));
       end;

tests/test/tismngd1.pp

@@ -0,0 +1,89 @@
+program tismngd1;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+uses
+  TypInfo;
+
+var
+  gError: LongInt = 0;
+
+function NextErrorCode: LongInt; inline;
+begin
+  Inc(gError);
+  Result := gError;
+end;
+
+generic procedure TestType<T>(aIsMngd: Boolean); inline;
+begin
+  if IsManagedType(T) <> aIsMngd then begin
+    Writeln('IsManagedType(', PTypeInfo(TypeInfo(T))^.Name, ') failure; expected: ', aIsMngd, ', got: ', IsManagedType(T));
+    Halt(NextErrorCode);
+  end;
+  NextErrorCode;
+end;
+
+type
+  TTestLongInt = record
+    a: LongInt;
+  end;
+
+  TTestAnsiString = record
+    a: AnsiString;
+  end;
+
+  TTestManaged = record
+    a: LongInt;
+    class operator Initialize(var aTestManaged: TTestManaged);
+  end;
+
+  TTestObj = object
+    a: LongInt;
+  end;
+
+  TTestObjAnsiString = object
+    a: AnsiString;
+  end;
+
+class operator TTestManaged.Initialize(var aTestManaged: TTestManaged);
+begin
+  aTestManaged.a := 42;
+end;
+
+type
+  TProcVar = procedure;
+  TMethodVar = procedure of object;
+
+  TDynArrayLongInt = array of LongInt;
+  TStaticArrayLongInt = array[0..4] of LongInt;
+  TStaticArrayAnsiString = array[0..4] of AnsiString;
+
+  TEnum = (eOne, eTwo, eThree);
+  TSet = set of (sOne, sTwo, sThree);
+
+begin
+  specialize TestType<LongInt>(False);
+  specialize TestType<Boolean>(False);
+  specialize TestType<ShortString>(False);
+  specialize TestType<AnsiString>(True);
+  specialize TestType<UnicodeString>(True);
+  specialize TestType<WideString>(True);
+  specialize TestType<Single>(False);
+  specialize TestType<TProcVar>(False);
+  specialize TestType<TMethodVar>(False);
+  specialize TestType<Pointer>(False);
+  specialize TestType<IInterface>(True);
+  specialize TestType<TObject>(False);
+  specialize TestType<TTestLongInt>(False);
+  specialize TestType<TTestAnsiString>(True);
+  specialize TestType<TTestManaged>(True);
+  specialize TestType<TTestObj>(False);
+  specialize TestType<TTestObjAnsiString>(True);
+  specialize TestType<TDynArrayLongInt>(True);
+  specialize TestType<TStaticArrayLongInt>(False);
+  specialize TestType<TStaticArrayAnsiString>(True);
+  specialize TestType<TEnum>(False);
+  specialize TestType<TSet>(False);
+  Writeln('Ok');
+end.

tests/test/tismngd2.pp

@@ -0,0 +1,15 @@
+program tismngd2;
+
+var
+  l: LongInt;
+  o: TObject;
+  _as: AnsiString;
+begin
+  if IsManagedType(l) then
+    Halt(1);
+  if IsManagedType(o) then
+    Halt(2);
+  if not IsManagedType(_as) then
+    Halt(3);
+  Writeln('Ok');
+end.