From ab533f43aa3869feae036ddb0984cce48b6493be Mon Sep 17 00:00:00 2001 From: marco Date: Tue, 14 Jan 2020 13:28:25 +0000 Subject: [PATCH] # revisions: 43409,43473,43474,43482 git-svn-id: branches/fixes_3_2@43944 - --- .gitattributes | 2 + compiler/compinnr.pas | 1 + compiler/ninl.pas | 16 ++++++++ compiler/pexpr.pas | 7 ++-- compiler/psystem.pas | 1 + tests/test/tismngd1.pp | 89 ++++++++++++++++++++++++++++++++++++++++++ tests/test/tismngd2.pp | 15 +++++++ 7 files changed, 128 insertions(+), 3 deletions(-) create mode 100644 tests/test/tismngd1.pp create mode 100644 tests/test/tismngd2.pp diff --git a/.gitattributes b/.gitattributes index a2e79235ac..a8ccbf48b5 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/compinnr.pas b/compiler/compinnr.pas index cda8a0fafd..d51608ccd1 100644 --- a/compiler/compinnr.pas +++ b/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, diff --git a/compiler/ninl.pas b/compiler/ninl.pas index fa8a5aec6f..f29931452b 100644 --- a/compiler/ninl.pas +++ b/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; diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 4e3061711d..4b60f7e997 100644 --- a/compiler/pexpr.pas +++ b/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 diff --git a/compiler/psystem.pas b/compiler/psystem.pas index 08a267a54a..5886de338c 100644 --- a/compiler/psystem.pas +++ b/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; diff --git a/tests/test/tismngd1.pp b/tests/test/tismngd1.pp new file mode 100644 index 0000000000..0d7be0bf95 --- /dev/null +++ b/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(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(False); + specialize TestType(False); + specialize TestType(False); + specialize TestType(True); + specialize TestType(True); + specialize TestType(True); + specialize TestType(False); + specialize TestType(False); + specialize TestType(False); + specialize TestType(False); + specialize TestType(True); + specialize TestType(False); + specialize TestType(False); + specialize TestType(True); + specialize TestType(True); + specialize TestType(False); + specialize TestType(True); + specialize TestType(True); + specialize TestType(False); + specialize TestType(True); + specialize TestType(False); + specialize TestType(False); + Writeln('Ok'); +end. diff --git a/tests/test/tismngd2.pp b/tests/test/tismngd2.pp new file mode 100644 index 0000000000..ee86d73547 --- /dev/null +++ b/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.