Delphi 7 bindings generator for IBM System Object Model 2.1
Revision | bfeeb6eebca5504427713fcc788bb61ec25af545 (tree) |
---|---|
Zeit | 2016-10-30 05:08:16 |
Autor | Ivan Levashev <bo_ <gen@octa...> |
Commiter | Ivan Levashev <bo_ |
Hiding or reintroducing methods from TObject in hardwired SOMObjectBase and
TypeCode, but not in generated classes yet
@@ -784,17 +784,79 @@ | ||
784 | 784 | |
785 | 785 | { Classes } |
786 | 786 | SOMObjectBase = class |
787 | - private | |
788 | - { hide TObject methods } | |
789 | - procedure Create; reintroduce; | |
787 | + { hide or reimplement TObject methods } | |
788 | + protected | |
789 | + class procedure Create; reintroduce; | |
790 | + public | |
791 | + procedure Free; reintroduce; | |
792 | + protected | |
793 | + class procedure InitInstance; reintroduce; | |
794 | + public | |
795 | + procedure CleanupInstance; reintroduce; | |
796 | + function ClassType: SOMClass; reintroduce; | |
797 | + protected | |
798 | + class procedure ClassName; reintroduce; | |
799 | + class procedure ClassNameIs; reintroduce; | |
800 | + class procedure ClassParent; reintroduce; | |
801 | + class procedure ClassInfo; reintroduce; | |
802 | + class procedure InstanceSize; reintroduce; | |
803 | + class procedure InheritsFrom; reintroduce; | |
804 | + class procedure MethodAddress; reintroduce; | |
805 | + class procedure MethodName; reintroduce; | |
806 | + procedure FieldAddress; reintroduce; | |
807 | + procedure GetInterface; reintroduce; | |
808 | + class procedure GetInterfaceEntry; reintroduce; | |
809 | + class procedure GetInterfaceTable; reintroduce; | |
810 | + procedure SafeCallException; reintroduce; | |
811 | + public | |
812 | + procedure AfterConstruction; reintroduce; | |
813 | + procedure BeforeDestruction; reintroduce; | |
814 | + protected | |
815 | + procedure Dispatch; reintroduce; | |
816 | + procedure DefaultHandler; reintroduce; | |
817 | + class procedure NewInstance; reintroduce; | |
818 | + public | |
819 | + procedure FreeInstance; reintroduce; | |
790 | 820 | procedure Destroy; reintroduce; |
791 | - public | |
821 | + | |
822 | + { Upcasting } | |
792 | 823 | function As_SOMObject: SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF} |
793 | 824 | end; |
794 | 825 | |
795 | 826 | TypeCode = class |
796 | - private | |
797 | - { hide TObject methods } | |
827 | + { hide or reimplement TObject methods } | |
828 | + public | |
829 | + procedure Free; reintroduce; | |
830 | + protected | |
831 | + class procedure InitInstance; reintroduce; | |
832 | + public | |
833 | + procedure CleanupInstance; reintroduce; | |
834 | + protected | |
835 | + procedure ClassType; reintroduce; | |
836 | + public | |
837 | + class function ClassName: string; reintroduce; | |
838 | + class function ClassNameIs(const Name: string): Boolean; reintroduce; | |
839 | + protected | |
840 | + class procedure ClassParent; reintroduce; | |
841 | + class procedure ClassInfo; reintroduce; | |
842 | + class procedure InstanceSize; reintroduce; | |
843 | + class procedure InheritsFrom; reintroduce; | |
844 | + class procedure MethodAddress; reintroduce; | |
845 | + class procedure MethodName; reintroduce; | |
846 | + procedure FieldAddress; reintroduce; | |
847 | + procedure GetInterface; reintroduce; | |
848 | + class procedure GetInterfaceEntry; reintroduce; | |
849 | + class procedure GetInterfaceTable; reintroduce; | |
850 | + procedure SafeCallException; reintroduce; | |
851 | + public | |
852 | + procedure AfterConstruction; reintroduce; | |
853 | + procedure BeforeDestruction; reintroduce; | |
854 | + protected | |
855 | + procedure Dispatch; reintroduce; | |
856 | + procedure DefaultHandler; reintroduce; | |
857 | + class procedure NewInstance; reintroduce; | |
858 | + public | |
859 | + procedure FreeInstance; reintroduce; | |
798 | 860 | procedure Destroy; reintroduce; |
799 | 861 | protected |
800 | 862 | function GetKind: TCKind; |
@@ -834,7 +896,6 @@ | ||
834 | 896 | class function TC_FullInterfaceDescription: TypeCode; |
835 | 897 | function Equal(y: TypeCode): CORBABoolean; |
836 | 898 | function Copy: TypeCode; |
837 | - procedure Free; | |
838 | 899 | procedure Print; |
839 | 900 | class function Create(tag: TCKind): TypeCode; overload; |
840 | 901 | class function Create(tag: TCKind; const Arguments: array of const): TypeCode; overload; |
@@ -5897,14 +5958,129 @@ | ||
5897 | 5958 | var |
5898 | 5959 | DLLLoad_CriticalSection : Windows.TRTLCriticalSection; |
5899 | 5960 | |
5900 | -procedure SOMObjectBase.Create; | |
5961 | +class procedure SOMObjectBase.Create; | |
5901 | 5962 | begin |
5902 | 5963 | { hide this method } |
5903 | 5964 | end; |
5904 | 5965 | |
5966 | +procedure SOMObjectBase.Free; | |
5967 | +begin | |
5968 | + if Assigned(Self) then SOMObject(Self).somFree; | |
5969 | +end; | |
5970 | + | |
5971 | +class procedure SOMObjectBase.InitInstance; | |
5972 | +begin | |
5973 | + { hide this method } | |
5974 | +end; | |
5975 | + | |
5976 | +procedure SOMObjectBase.CleanupInstance; | |
5977 | +begin | |
5978 | + { in SOM, everything is being cleaned up by destructors } | |
5979 | +end; | |
5980 | + | |
5981 | +function SOMObjectBase.ClassType: SOMClass; | |
5982 | +begin | |
5983 | + Result := SOMObject(Self).somGetClass; | |
5984 | +end; | |
5985 | + | |
5986 | +class procedure SOMObjectBase.ClassName; | |
5987 | +begin | |
5988 | + { hide this method } | |
5989 | +end; | |
5990 | + | |
5991 | +class procedure SOMObjectBase.ClassNameIs; | |
5992 | +begin | |
5993 | + { hide this method } | |
5994 | +end; | |
5995 | + | |
5996 | +class procedure SOMObjectBase.ClassParent; | |
5997 | +begin | |
5998 | + { hide this method } | |
5999 | +end; | |
6000 | + | |
6001 | +class procedure SOMObjectBase.ClassInfo; | |
6002 | +begin | |
6003 | + { hide this method } | |
6004 | +end; | |
6005 | + | |
6006 | +class procedure SOMObjectBase.InstanceSize; | |
6007 | +begin | |
6008 | + { hide this method } | |
6009 | +end; | |
6010 | + | |
6011 | +class procedure SOMObjectBase.InheritsFrom; | |
6012 | +begin | |
6013 | + { hide this method } | |
6014 | +end; | |
6015 | + | |
6016 | +class procedure SOMObjectBase.MethodAddress; | |
6017 | +begin | |
6018 | + { hide this method } | |
6019 | +end; | |
6020 | + | |
6021 | +class procedure SOMObjectBase.MethodName; | |
6022 | +begin | |
6023 | + { hide this method } | |
6024 | +end; | |
6025 | + | |
6026 | +procedure SOMObjectBase.FieldAddress; | |
6027 | +begin | |
6028 | + { hide this method } | |
6029 | +end; | |
6030 | + | |
6031 | +procedure SOMObjectBase.GetInterface; | |
6032 | +begin | |
6033 | + { hide this method } | |
6034 | +end; | |
6035 | + | |
6036 | +class procedure SOMObjectBase.GetInterfaceEntry; | |
6037 | +begin | |
6038 | + { hide this method } | |
6039 | +end; | |
6040 | + | |
6041 | +class procedure SOMObjectBase.GetInterfaceTable; | |
6042 | +begin | |
6043 | + { hide this method } | |
6044 | +end; | |
6045 | + | |
6046 | +procedure SOMObjectBase.SafeCallException; | |
6047 | +begin | |
6048 | + { hide this method } | |
6049 | +end; | |
6050 | + | |
6051 | +procedure SOMObjectBase.AfterConstruction; | |
6052 | +begin | |
6053 | + { in SOM that is being done by cooperative metaclass } | |
6054 | +end; | |
6055 | + | |
6056 | +procedure SOMObjectBase.BeforeDestruction; | |
6057 | +begin | |
6058 | + { in SOM that is being done by cooperative metaclass } | |
6059 | +end; | |
6060 | + | |
6061 | +procedure SOMObjectBase.Dispatch; | |
6062 | +begin | |
6063 | + { hide this method } | |
6064 | +end; | |
6065 | + | |
6066 | +procedure SOMObjectBase.DefaultHandler; | |
6067 | +begin | |
6068 | + { hide this method } | |
6069 | +end; | |
6070 | + | |
6071 | +class procedure SOMObjectBase.NewInstance; | |
6072 | +begin | |
6073 | + { hide this method } | |
6074 | +end; | |
6075 | + | |
6076 | +procedure SOMObjectBase.FreeInstance; | |
6077 | +begin | |
6078 | + SOMObject(Self).somGetClass.somDeallocate(PAnsiChar(Pointer(Self))); | |
6079 | +end; | |
6080 | + | |
5905 | 6081 | procedure SOMObjectBase.Destroy; |
5906 | 6082 | begin |
5907 | - { hide this method } | |
6083 | + SOMObject(Self).somFree; | |
5908 | 6084 | end; |
5909 | 6085 | |
5910 | 6086 | function SOMObjectBase.As_SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF} |
@@ -5931,11 +6107,135 @@ | ||
5931 | 6107 | Pointer(V_Pointer) := Windows.GetProcAddress(SOMTC_DLL, PAnsiChar(Var_Name)); |
5932 | 6108 | end; |
5933 | 6109 | |
5934 | -procedure TypeCode.Destroy; | |
6110 | +procedure TypeCode.Free; | |
6111 | +begin | |
6112 | + if Assigned(Self) then | |
6113 | + begin | |
6114 | + FreeInstance; | |
6115 | + end; | |
6116 | +end; | |
6117 | + | |
6118 | +class procedure TypeCode.InitInstance; | |
5935 | 6119 | begin |
5936 | 6120 | { hide this method } |
5937 | 6121 | end; |
5938 | 6122 | |
6123 | +procedure TypeCode.CleanupInstance; | |
6124 | +begin | |
6125 | + { TypeCode_free does everything at the same time, so no separate Cleanup } | |
6126 | +end; | |
6127 | + | |
6128 | +procedure TypeCode.ClassType; | |
6129 | +begin | |
6130 | + { hide this method } | |
6131 | +end; | |
6132 | + | |
6133 | +class function TypeCode.ClassName: string; | |
6134 | +begin | |
6135 | + Result := 'TypeCode'; | |
6136 | +end; | |
6137 | + | |
6138 | +class function TypeCode.ClassNameIs(const Name: string): Boolean; | |
6139 | +begin | |
6140 | + Result := Name = 'TypeCode'; | |
6141 | +end; | |
6142 | + | |
6143 | +class procedure TypeCode.ClassParent; | |
6144 | +begin | |
6145 | + { hide this method } | |
6146 | +end; | |
6147 | + | |
6148 | +class procedure TypeCode.ClassInfo; | |
6149 | +begin | |
6150 | + { hide this method } | |
6151 | +end; | |
6152 | + | |
6153 | +class procedure TypeCode.InstanceSize; | |
6154 | +begin | |
6155 | + { hide this method } | |
6156 | +end; | |
6157 | + | |
6158 | +class procedure TypeCode.InheritsFrom; | |
6159 | +begin | |
6160 | + { hide this method } | |
6161 | +end; | |
6162 | + | |
6163 | +class procedure TypeCode.MethodAddress; | |
6164 | +begin | |
6165 | + { hide this method } | |
6166 | +end; | |
6167 | + | |
6168 | +class procedure TypeCode.MethodName; | |
6169 | +begin | |
6170 | + { hide this method } | |
6171 | +end; | |
6172 | + | |
6173 | +procedure TypeCode.FieldAddress; | |
6174 | +begin | |
6175 | + { hide this method } | |
6176 | +end; | |
6177 | + | |
6178 | +procedure TypeCode.GetInterface; | |
6179 | +begin | |
6180 | + { hide this method } | |
6181 | +end; | |
6182 | + | |
6183 | +class procedure TypeCode.GetInterfaceEntry; | |
6184 | +begin | |
6185 | + { hide this method } | |
6186 | +end; | |
6187 | + | |
6188 | +class procedure TypeCode.GetInterfaceTable; | |
6189 | +begin | |
6190 | + { hide this method } | |
6191 | +end; | |
6192 | + | |
6193 | +procedure TypeCode.SafeCallException; | |
6194 | +begin | |
6195 | + { hide this method } | |
6196 | +end; | |
6197 | + | |
6198 | +procedure TypeCode.AfterConstruction; | |
6199 | +begin | |
6200 | + { nothing to do } | |
6201 | +end; | |
6202 | + | |
6203 | +procedure TypeCode.BeforeDestruction; | |
6204 | +begin | |
6205 | + { nothing to do } | |
6206 | +end; | |
6207 | + | |
6208 | +procedure TypeCode.Dispatch; | |
6209 | +begin | |
6210 | + { hide this method } | |
6211 | +end; | |
6212 | + | |
6213 | +procedure TypeCode.DefaultHandler; | |
6214 | +begin | |
6215 | + { hide this method } | |
6216 | +end; | |
6217 | + | |
6218 | +class procedure TypeCode.NewInstance; | |
6219 | +begin | |
6220 | + { hide this method } | |
6221 | +end; | |
6222 | + | |
6223 | +procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree'; | |
6224 | + | |
6225 | +procedure TypeCode.FreeInstance; | |
6226 | +var | |
6227 | + LocalEnv: Environment; | |
6228 | +begin | |
6229 | + SOM_InitEnvironment(@LocalEnv); | |
6230 | + TypeCode_free(Self, @LocalEnv); | |
6231 | + SOM_UninitEnvironmentOrRaise(@LocalEnv); | |
6232 | +end; | |
6233 | + | |
6234 | +procedure TypeCode.Destroy; | |
6235 | +begin | |
6236 | + FreeInstance; | |
6237 | +end; | |
6238 | + | |
5939 | 6239 | function TypeCode_kind(t: TypeCode; ev: PEnvironment): TCKind; stdcall; external SOMTC_DLL_Name name 'tcKind'; |
5940 | 6240 | |
5941 | 6241 | function TypeCode.GetKind: TCKind; |
@@ -6416,17 +6716,6 @@ | ||
6416 | 6716 | SOM_UninitEnvironmentOrRaise(@LocalEnv); |
6417 | 6717 | end; |
6418 | 6718 | |
6419 | -procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree'; | |
6420 | - | |
6421 | -procedure TypeCode.Free; | |
6422 | -var | |
6423 | - LocalEnv: Environment; | |
6424 | -begin | |
6425 | - SOM_InitEnvironment(@LocalEnv); | |
6426 | - TypeCode_free(Self, @LocalEnv); | |
6427 | - SOM_UninitEnvironmentOrRaise(@LocalEnv); | |
6428 | -end; | |
6429 | - | |
6430 | 6719 | procedure TypeCode_print(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcPrint'; |
6431 | 6720 | |
6432 | 6721 | procedure TypeCode.Print; |
@@ -2686,18 +2686,80 @@ | ||
2686 | 2686 | WriteLn(F); |
2687 | 2687 | WriteLn(F, ' { Classes }'); |
2688 | 2688 | WriteLn(F, ' SOMObjectBase = class'); |
2689 | - WriteLn(F, ' private'); | |
2690 | - WriteLn(F, ' { hide TObject methods }'); | |
2691 | - WriteLn(F, ' procedure Create; reintroduce;'); | |
2692 | - WriteLn(F, ' procedure Destroy; reintroduce;'); // TODO hide others | |
2689 | + WriteLn(F, ' { hide or reimplement TObject methods }'); | |
2690 | + WriteLn(F, ' protected'); | |
2691 | + WriteLn(F, ' class procedure Create; reintroduce;'); | |
2693 | 2692 | WriteLn(F, ' public'); |
2693 | + WriteLn(F, ' procedure Free; reintroduce;'); | |
2694 | + WriteLn(F, ' protected'); | |
2695 | + WriteLn(F, ' class procedure InitInstance; reintroduce;'); | |
2696 | + WriteLn(F, ' public'); | |
2697 | + WriteLn(F, ' procedure CleanupInstance; reintroduce;'); | |
2698 | + WriteLn(F, ' function ClassType: SOMClass; reintroduce;'); | |
2699 | + WriteLn(F, ' protected'); | |
2700 | + WriteLn(F, ' class procedure ClassName; reintroduce;'); | |
2701 | + WriteLn(F, ' class procedure ClassNameIs; reintroduce;'); | |
2702 | + WriteLn(F, ' class procedure ClassParent; reintroduce;'); | |
2703 | + WriteLn(F, ' class procedure ClassInfo; reintroduce;'); | |
2704 | + WriteLn(F, ' class procedure InstanceSize; reintroduce;'); | |
2705 | + WriteLn(F, ' class procedure InheritsFrom; reintroduce;'); | |
2706 | + WriteLn(F, ' class procedure MethodAddress; reintroduce;'); | |
2707 | + WriteLn(F, ' class procedure MethodName; reintroduce;'); | |
2708 | + WriteLn(F, ' procedure FieldAddress; reintroduce;'); | |
2709 | + WriteLn(F, ' procedure GetInterface; reintroduce;'); | |
2710 | + WriteLn(F, ' class procedure GetInterfaceEntry; reintroduce;'); | |
2711 | + WriteLn(F, ' class procedure GetInterfaceTable; reintroduce;'); | |
2712 | + WriteLn(F, ' procedure SafeCallException; reintroduce;'); | |
2713 | + WriteLn(F, ' public'); | |
2714 | + WriteLn(F, ' procedure AfterConstruction; reintroduce;'); | |
2715 | + WriteLn(F, ' procedure BeforeDestruction; reintroduce;'); | |
2716 | + WriteLn(F, ' protected'); | |
2717 | + WriteLn(F, ' procedure Dispatch; reintroduce;'); | |
2718 | + WriteLn(F, ' procedure DefaultHandler; reintroduce;'); | |
2719 | + WriteLn(F, ' class procedure NewInstance; reintroduce;'); | |
2720 | + WriteLn(F, ' public'); | |
2721 | + WriteLn(F, ' procedure FreeInstance; reintroduce;'); | |
2722 | + WriteLn(F, ' procedure Destroy; reintroduce;'); | |
2723 | + WriteLn(F); | |
2724 | + WriteLn(F, ' { Upcasting }'); | |
2694 | 2725 | WriteLn(F, ' function As_SOMObject: SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}'); |
2695 | 2726 | WriteLn(F, ' end;'); |
2696 | 2727 | WriteLn(F); |
2697 | 2728 | WriteLn(F, ' TypeCode = class'); |
2698 | - WriteLn(F, ' private'); | |
2699 | - WriteLn(F, ' { hide TObject methods }'); | |
2700 | - WriteLn(F, ' procedure Destroy; reintroduce;'); // TODO hide others | |
2729 | + WriteLn(F, ' { hide or reimplement TObject methods }'); | |
2730 | + WriteLn(F, ' public'); | |
2731 | + WriteLn(F, ' procedure Free; reintroduce;'); | |
2732 | + WriteLn(F, ' protected'); | |
2733 | + WriteLn(F, ' class procedure InitInstance; reintroduce;'); | |
2734 | + WriteLn(F, ' public'); | |
2735 | + WriteLn(F, ' procedure CleanupInstance; reintroduce;'); | |
2736 | + WriteLn(F, ' protected'); | |
2737 | + WriteLn(F, ' procedure ClassType; reintroduce;'); | |
2738 | + WriteLn(F, ' public'); | |
2739 | + WriteLn(F, ' class function ClassName: string; reintroduce;'); | |
2740 | + WriteLn(F, ' class function ClassNameIs(const Name: string): Boolean; reintroduce;'); | |
2741 | + WriteLn(F, ' protected'); | |
2742 | + WriteLn(F, ' class procedure ClassParent; reintroduce;'); | |
2743 | + WriteLn(F, ' class procedure ClassInfo; reintroduce;'); | |
2744 | + WriteLn(F, ' class procedure InstanceSize; reintroduce;'); | |
2745 | + WriteLn(F, ' class procedure InheritsFrom; reintroduce;'); | |
2746 | + WriteLn(F, ' class procedure MethodAddress; reintroduce;'); | |
2747 | + WriteLn(F, ' class procedure MethodName; reintroduce;'); | |
2748 | + WriteLn(F, ' procedure FieldAddress; reintroduce;'); | |
2749 | + WriteLn(F, ' procedure GetInterface; reintroduce;'); | |
2750 | + WriteLn(F, ' class procedure GetInterfaceEntry; reintroduce;'); | |
2751 | + WriteLn(F, ' class procedure GetInterfaceTable; reintroduce;'); | |
2752 | + WriteLn(F, ' procedure SafeCallException; reintroduce;'); | |
2753 | + WriteLn(F, ' public'); | |
2754 | + WriteLn(F, ' procedure AfterConstruction; reintroduce;'); | |
2755 | + WriteLn(F, ' procedure BeforeDestruction; reintroduce;'); | |
2756 | + WriteLn(F, ' protected'); | |
2757 | + WriteLn(F, ' procedure Dispatch; reintroduce;'); | |
2758 | + WriteLn(F, ' procedure DefaultHandler; reintroduce;'); | |
2759 | + WriteLn(F, ' class procedure NewInstance; reintroduce;'); | |
2760 | + WriteLn(F, ' public'); | |
2761 | + WriteLn(F, ' procedure FreeInstance; reintroduce;'); | |
2762 | + WriteLn(F, ' procedure Destroy; reintroduce;'); | |
2701 | 2763 | WriteLn(F, ' protected'); |
2702 | 2764 | WriteLn(F, ' function GetKind: TCKind;'); |
2703 | 2765 | WriteLn(F, ' function GetParamCount: LongInt;'); |
@@ -2736,7 +2798,6 @@ | ||
2736 | 2798 | WriteLn(F, ' class function TC_FullInterfaceDescription: TypeCode;'); |
2737 | 2799 | WriteLn(F, ' function Equal(y: TypeCode): CORBABoolean;'); |
2738 | 2800 | WriteLn(F, ' function Copy: TypeCode;'); |
2739 | - WriteLn(F, ' procedure Free;'); | |
2740 | 2801 | WriteLn(F, ' procedure Print;'); |
2741 | 2802 | WriteLn(F, ' class function Create(tag: TCKind): TypeCode; overload;'); |
2742 | 2803 | WriteLn(F, ' class function Create(tag: TCKind; const Arguments: array of const): TypeCode; overload;'); |
@@ -3025,14 +3086,129 @@ | ||
3025 | 3086 | WriteLn(F, 'var'); |
3026 | 3087 | WriteLn(F, ' DLLLoad_CriticalSection : Windows.TRTLCriticalSection;'); |
3027 | 3088 | WriteLn(F); |
3028 | - WriteLn(F, 'procedure SOMObjectBase.Create;'); | |
3089 | + WriteLn(F, 'class procedure SOMObjectBase.Create;'); | |
3029 | 3090 | WriteLn(F, 'begin'); |
3030 | 3091 | WriteLn(F, ' { hide this method }'); |
3031 | 3092 | WriteLn(F, 'end;'); |
3032 | 3093 | WriteLn(F); |
3094 | + WriteLn(F, 'procedure SOMObjectBase.Free;'); | |
3095 | + WriteLn(F, 'begin'); | |
3096 | + WriteLn(F, ' if Assigned(Self) then SOMObject(Self).somFree;'); | |
3097 | + WriteLn(F, 'end;'); | |
3098 | + WriteLn(F); | |
3099 | + WriteLn(F, 'class procedure SOMObjectBase.InitInstance;'); | |
3100 | + WriteLn(F, 'begin'); | |
3101 | + WriteLn(F, ' { hide this method }'); | |
3102 | + WriteLn(F, 'end;'); | |
3103 | + WriteLn(F); | |
3104 | + WriteLn(F, 'procedure SOMObjectBase.CleanupInstance;'); | |
3105 | + WriteLn(F, 'begin'); | |
3106 | + WriteLn(F, ' { in SOM, everything is being cleaned up by destructors }'); | |
3107 | + WriteLn(F, 'end;'); | |
3108 | + WriteLn(F); | |
3109 | + WriteLn(F, 'function SOMObjectBase.ClassType: SOMClass;'); | |
3110 | + WriteLn(F, 'begin'); | |
3111 | + WriteLn(F, ' Result := SOMObject(Self).somGetClass;'); | |
3112 | + WriteLn(F, 'end;'); | |
3113 | + WriteLn(F); | |
3114 | + WriteLn(F, 'class procedure SOMObjectBase.ClassName;'); | |
3115 | + WriteLn(F, 'begin'); | |
3116 | + WriteLn(F, ' { hide this method }'); | |
3117 | + WriteLn(F, 'end;'); | |
3118 | + WriteLn(F); | |
3119 | + WriteLn(F, 'class procedure SOMObjectBase.ClassNameIs;'); | |
3120 | + WriteLn(F, 'begin'); | |
3121 | + WriteLn(F, ' { hide this method }'); | |
3122 | + WriteLn(F, 'end;'); | |
3123 | + WriteLn(F); | |
3124 | + WriteLn(F, 'class procedure SOMObjectBase.ClassParent;'); | |
3125 | + WriteLn(F, 'begin'); | |
3126 | + WriteLn(F, ' { hide this method }'); | |
3127 | + WriteLn(F, 'end;'); | |
3128 | + WriteLn(F); | |
3129 | + WriteLn(F, 'class procedure SOMObjectBase.ClassInfo;'); | |
3130 | + WriteLn(F, 'begin'); | |
3131 | + WriteLn(F, ' { hide this method }'); | |
3132 | + WriteLn(F, 'end;'); | |
3133 | + WriteLn(F); | |
3134 | + WriteLn(F, 'class procedure SOMObjectBase.InstanceSize;'); | |
3135 | + WriteLn(F, 'begin'); | |
3136 | + WriteLn(F, ' { hide this method }'); | |
3137 | + WriteLn(F, 'end;'); | |
3138 | + WriteLn(F); | |
3139 | + WriteLn(F, 'class procedure SOMObjectBase.InheritsFrom;'); | |
3140 | + WriteLn(F, 'begin'); | |
3141 | + WriteLn(F, ' { hide this method }'); | |
3142 | + WriteLn(F, 'end;'); | |
3143 | + WriteLn(F); | |
3144 | + WriteLn(F, 'class procedure SOMObjectBase.MethodAddress;'); | |
3145 | + WriteLn(F, 'begin'); | |
3146 | + WriteLn(F, ' { hide this method }'); | |
3147 | + WriteLn(F, 'end;'); | |
3148 | + WriteLn(F); | |
3149 | + WriteLn(F, 'class procedure SOMObjectBase.MethodName;'); | |
3150 | + WriteLn(F, 'begin'); | |
3151 | + WriteLn(F, ' { hide this method }'); | |
3152 | + WriteLn(F, 'end;'); | |
3153 | + WriteLn(F); | |
3154 | + WriteLn(F, 'procedure SOMObjectBase.FieldAddress;'); | |
3155 | + WriteLn(F, 'begin'); | |
3156 | + WriteLn(F, ' { hide this method }'); | |
3157 | + WriteLn(F, 'end;'); | |
3158 | + WriteLn(F); | |
3159 | + WriteLn(F, 'procedure SOMObjectBase.GetInterface;'); | |
3160 | + WriteLn(F, 'begin'); | |
3161 | + WriteLn(F, ' { hide this method }'); | |
3162 | + WriteLn(F, 'end;'); | |
3163 | + WriteLn(F); | |
3164 | + WriteLn(F, 'class procedure SOMObjectBase.GetInterfaceEntry;'); | |
3165 | + WriteLn(F, 'begin'); | |
3166 | + WriteLn(F, ' { hide this method }'); | |
3167 | + WriteLn(F, 'end;'); | |
3168 | + WriteLn(F); | |
3169 | + WriteLn(F, 'class procedure SOMObjectBase.GetInterfaceTable;'); | |
3170 | + WriteLn(F, 'begin'); | |
3171 | + WriteLn(F, ' { hide this method }'); | |
3172 | + WriteLn(F, 'end;'); | |
3173 | + WriteLn(F); | |
3174 | + WriteLn(F, 'procedure SOMObjectBase.SafeCallException;'); | |
3175 | + WriteLn(F, 'begin'); | |
3176 | + WriteLn(F, ' { hide this method }'); | |
3177 | + WriteLn(F, 'end;'); | |
3178 | + WriteLn(F); | |
3179 | + WriteLn(F, 'procedure SOMObjectBase.AfterConstruction;'); | |
3180 | + WriteLn(F, 'begin'); | |
3181 | + WriteLn(F, ' { in SOM that is being done by cooperative metaclass }'); | |
3182 | + WriteLn(F, 'end;'); | |
3183 | + WriteLn(F); | |
3184 | + WriteLn(F, 'procedure SOMObjectBase.BeforeDestruction;'); | |
3185 | + WriteLn(F, 'begin'); | |
3186 | + WriteLn(F, ' { in SOM that is being done by cooperative metaclass }'); | |
3187 | + WriteLn(F, 'end;'); | |
3188 | + WriteLn(F); | |
3189 | + WriteLn(F, 'procedure SOMObjectBase.Dispatch;'); | |
3190 | + WriteLn(F, 'begin'); | |
3191 | + WriteLn(F, ' { hide this method }'); | |
3192 | + WriteLn(F, 'end;'); | |
3193 | + WriteLn(F); | |
3194 | + WriteLn(F, 'procedure SOMObjectBase.DefaultHandler;'); | |
3195 | + WriteLn(F, 'begin'); | |
3196 | + WriteLn(F, ' { hide this method }'); | |
3197 | + WriteLn(F, 'end;'); | |
3198 | + WriteLn(F); | |
3199 | + WriteLn(F, 'class procedure SOMObjectBase.NewInstance;'); | |
3200 | + WriteLn(F, 'begin'); | |
3201 | + WriteLn(F, ' { hide this method }'); | |
3202 | + WriteLn(F, 'end;'); | |
3203 | + WriteLn(F); | |
3204 | + WriteLn(F, 'procedure SOMObjectBase.FreeInstance;'); | |
3205 | + WriteLn(F, 'begin'); | |
3206 | + WriteLn(F, ' SOMObject(Self).somGetClass.somDeallocate(PAnsiChar(Pointer(Self)));'); | |
3207 | + WriteLn(F, 'end;'); | |
3208 | + WriteLn(F); | |
3033 | 3209 | WriteLn(F, 'procedure SOMObjectBase.Destroy;'); |
3034 | 3210 | WriteLn(F, 'begin'); |
3035 | - WriteLn(F, ' { hide this method }'); | |
3211 | + WriteLn(F, ' SOMObject(Self).somFree;'); | |
3036 | 3212 | WriteLn(F, 'end;'); |
3037 | 3213 | WriteLn(F); |
3038 | 3214 | WriteLn(F, 'function SOMObjectBase.As_SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}'); |
@@ -3060,9 +3236,133 @@ | ||
3060 | 3236 | WriteLn(F, 'end;'); |
3061 | 3237 | FDLLs.Add('somtc.dll'); |
3062 | 3238 | WriteLn(F); |
3239 | + WriteLn(F, 'procedure TypeCode.Free;'); | |
3240 | + WriteLn(F, 'begin'); | |
3241 | + WriteLn(F, ' if Assigned(Self) then'); | |
3242 | + WriteLn(F, ' begin'); | |
3243 | + WriteLn(F, ' FreeInstance;'); | |
3244 | + WriteLn(F, ' end;'); | |
3245 | + WriteLn(F, 'end;'); | |
3246 | + WriteLn(F); | |
3247 | + WriteLn(F, 'class procedure TypeCode.InitInstance;'); | |
3248 | + WriteLn(F, 'begin'); | |
3249 | + WriteLn(F, ' { hide this method }'); | |
3250 | + WriteLn(F, 'end;'); | |
3251 | + WriteLn(F); | |
3252 | + WriteLn(F, 'procedure TypeCode.CleanupInstance;'); | |
3253 | + WriteLn(F, 'begin'); | |
3254 | + WriteLn(F, ' { TypeCode_free does everything at the same time, so no separate Cleanup }'); | |
3255 | + WriteLn(F, 'end;'); | |
3256 | + WriteLn(F); | |
3257 | + WriteLn(F, 'procedure TypeCode.ClassType;'); | |
3258 | + WriteLn(F, 'begin'); | |
3259 | + WriteLn(F, ' { hide this method }'); | |
3260 | + WriteLn(F, 'end;'); | |
3261 | + WriteLn(F); | |
3262 | + WriteLn(F, 'class function TypeCode.ClassName: string;'); | |
3263 | + WriteLn(F, 'begin'); | |
3264 | + WriteLn(F, ' Result := ''TypeCode'';'); | |
3265 | + WriteLn(F, 'end;'); | |
3266 | + WriteLn(F); | |
3267 | + WriteLn(F, 'class function TypeCode.ClassNameIs(const Name: string): Boolean;'); | |
3268 | + WriteLn(F, 'begin'); | |
3269 | + WriteLn(F, ' Result := Name = ''TypeCode'';'); | |
3270 | + WriteLn(F, 'end;'); | |
3271 | + WriteLn(F); | |
3272 | + WriteLn(F, 'class procedure TypeCode.ClassParent;'); | |
3273 | + WriteLn(F, 'begin'); | |
3274 | + WriteLn(F, ' { hide this method }'); | |
3275 | + WriteLn(F, 'end;'); | |
3276 | + WriteLn(F); | |
3277 | + WriteLn(F, 'class procedure TypeCode.ClassInfo;'); | |
3278 | + WriteLn(F, 'begin'); | |
3279 | + WriteLn(F, ' { hide this method }'); | |
3280 | + WriteLn(F, 'end;'); | |
3281 | + WriteLn(F); | |
3282 | + WriteLn(F, 'class procedure TypeCode.InstanceSize;'); | |
3283 | + WriteLn(F, 'begin'); | |
3284 | + WriteLn(F, ' { hide this method }'); | |
3285 | + WriteLn(F, 'end;'); | |
3286 | + WriteLn(F); | |
3287 | + WriteLn(F, 'class procedure TypeCode.InheritsFrom;'); | |
3288 | + WriteLn(F, 'begin'); | |
3289 | + WriteLn(F, ' { hide this method }'); | |
3290 | + WriteLn(F, 'end;'); | |
3291 | + WriteLn(F); | |
3292 | + WriteLn(F, 'class procedure TypeCode.MethodAddress;'); | |
3293 | + WriteLn(F, 'begin'); | |
3294 | + WriteLn(F, ' { hide this method }'); | |
3295 | + WriteLn(F, 'end;'); | |
3296 | + WriteLn(F); | |
3297 | + WriteLn(F, 'class procedure TypeCode.MethodName;'); | |
3298 | + WriteLn(F, 'begin'); | |
3299 | + WriteLn(F, ' { hide this method }'); | |
3300 | + WriteLn(F, 'end;'); | |
3301 | + WriteLn(F); | |
3302 | + WriteLn(F, 'procedure TypeCode.FieldAddress;'); | |
3303 | + WriteLn(F, 'begin'); | |
3304 | + WriteLn(F, ' { hide this method }'); | |
3305 | + WriteLn(F, 'end;'); | |
3306 | + WriteLn(F); | |
3307 | + WriteLn(F, 'procedure TypeCode.GetInterface;'); | |
3308 | + WriteLn(F, 'begin'); | |
3309 | + WriteLn(F, ' { hide this method }'); | |
3310 | + WriteLn(F, 'end;'); | |
3311 | + WriteLn(F); | |
3312 | + WriteLn(F, 'class procedure TypeCode.GetInterfaceEntry;'); | |
3313 | + WriteLn(F, 'begin'); | |
3314 | + WriteLn(F, ' { hide this method }'); | |
3315 | + WriteLn(F, 'end;'); | |
3316 | + WriteLn(F); | |
3317 | + WriteLn(F, 'class procedure TypeCode.GetInterfaceTable;'); | |
3318 | + WriteLn(F, 'begin'); | |
3319 | + WriteLn(F, ' { hide this method }'); | |
3320 | + WriteLn(F, 'end;'); | |
3321 | + WriteLn(F); | |
3322 | + WriteLn(F, 'procedure TypeCode.SafeCallException;'); | |
3323 | + WriteLn(F, 'begin'); | |
3324 | + WriteLn(F, ' { hide this method }'); | |
3325 | + WriteLn(F, 'end;'); | |
3326 | + WriteLn(F); | |
3327 | + WriteLn(F, 'procedure TypeCode.AfterConstruction;'); | |
3328 | + WriteLn(F, 'begin'); | |
3329 | + WriteLn(F, ' { nothing to do }'); | |
3330 | + WriteLn(F, 'end;'); | |
3331 | + WriteLn(F); | |
3332 | + WriteLn(F, 'procedure TypeCode.BeforeDestruction;'); | |
3333 | + WriteLn(F, 'begin'); | |
3334 | + WriteLn(F, ' { nothing to do }'); | |
3335 | + WriteLn(F, 'end;'); | |
3336 | + WriteLn(F); | |
3337 | + WriteLn(F, 'procedure TypeCode.Dispatch;'); | |
3338 | + WriteLn(F, 'begin'); | |
3339 | + WriteLn(F, ' { hide this method }'); | |
3340 | + WriteLn(F, 'end;'); | |
3341 | + WriteLn(F); | |
3342 | + WriteLn(F, 'procedure TypeCode.DefaultHandler;'); | |
3343 | + WriteLn(F, 'begin'); | |
3344 | + WriteLn(F, ' { hide this method }'); | |
3345 | + WriteLn(F, 'end;'); | |
3346 | + WriteLn(F); | |
3347 | + WriteLn(F, 'class procedure TypeCode.NewInstance;'); | |
3348 | + WriteLn(F, 'begin'); | |
3349 | + WriteLn(F, ' { hide this method }'); | |
3350 | + WriteLn(F, 'end;'); | |
3351 | + WriteLn(F); | |
3352 | + WriteLn(F, 'procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcFree'';'); | |
3353 | + WriteLn(F); | |
3354 | + WriteLn(F, 'procedure TypeCode.FreeInstance;'); | |
3355 | + WriteLn(F, 'var'); | |
3356 | + WriteLn(F, ' LocalEnv: Environment;'); | |
3357 | + WriteLn(F, 'begin'); | |
3358 | + WriteLn(F, ' SOM_InitEnvironment(@LocalEnv);'); | |
3359 | + WriteLn(F, ' TypeCode_free(Self, @LocalEnv);'); | |
3360 | + WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);'); | |
3361 | + WriteLn(F, 'end;'); | |
3362 | + WriteLn(F); | |
3063 | 3363 | WriteLn(F, 'procedure TypeCode.Destroy;'); |
3064 | 3364 | WriteLn(F, 'begin'); |
3065 | - WriteLn(F, ' { hide this method }'); // TODO free? | |
3365 | + WriteLn(F, ' FreeInstance;'); | |
3066 | 3366 | WriteLn(F, 'end;'); |
3067 | 3367 | WriteLn(F); |
3068 | 3368 | WriteLn(F, 'function TypeCode_kind(t: TypeCode; ev: PEnvironment): TCKind; stdcall; external SOMTC_DLL_Name name ''tcKind'';'); |
@@ -3545,17 +3845,6 @@ | ||
3545 | 3845 | WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);'); |
3546 | 3846 | WriteLn(F, 'end;'); |
3547 | 3847 | WriteLn(F); |
3548 | - WriteLn(F, 'procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcFree'';'); | |
3549 | - WriteLn(F); | |
3550 | - WriteLn(F, 'procedure TypeCode.Free;'); | |
3551 | - WriteLn(F, 'var'); | |
3552 | - WriteLn(F, ' LocalEnv: Environment;'); | |
3553 | - WriteLn(F, 'begin'); | |
3554 | - WriteLn(F, ' SOM_InitEnvironment(@LocalEnv);'); | |
3555 | - WriteLn(F, ' TypeCode_free(Self, @LocalEnv);'); | |
3556 | - WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);'); | |
3557 | - WriteLn(F, 'end;'); | |
3558 | - WriteLn(F); | |
3559 | 3848 | WriteLn(F, 'procedure TypeCode_print(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcPrint'';'); |
3560 | 3849 | WriteLn(F); |
3561 | 3850 | WriteLn(F, 'procedure TypeCode.Print;'); |
@@ -4045,7 +4334,6 @@ | ||
4045 | 4334 | |
4046 | 4335 | begin |
4047 | 4336 | try |
4048 | - WriteLn('Testing SOMObject v', SOM_MajorVersion, '.', SOM_MinorVersion); | |
4049 | 4337 | SOM_MainProgram; |
4050 | 4338 | TestSOM_IR; |
4051 | 4339 | except |
@@ -784,17 +784,79 @@ | ||
784 | 784 | |
785 | 785 | { Classes } |
786 | 786 | SOMObjectBase = class |
787 | - private | |
788 | - { hide TObject methods } | |
789 | - procedure Create; reintroduce; | |
787 | + { hide or reimplement TObject methods } | |
788 | + protected | |
789 | + class procedure Create; reintroduce; | |
790 | + public | |
791 | + procedure Free; reintroduce; | |
792 | + protected | |
793 | + class procedure InitInstance; reintroduce; | |
794 | + public | |
795 | + procedure CleanupInstance; reintroduce; | |
796 | + function ClassType: SOMClass; reintroduce; | |
797 | + protected | |
798 | + class procedure ClassName; reintroduce; | |
799 | + class procedure ClassNameIs; reintroduce; | |
800 | + class procedure ClassParent; reintroduce; | |
801 | + class procedure ClassInfo; reintroduce; | |
802 | + class procedure InstanceSize; reintroduce; | |
803 | + class procedure InheritsFrom; reintroduce; | |
804 | + class procedure MethodAddress; reintroduce; | |
805 | + class procedure MethodName; reintroduce; | |
806 | + procedure FieldAddress; reintroduce; | |
807 | + procedure GetInterface; reintroduce; | |
808 | + class procedure GetInterfaceEntry; reintroduce; | |
809 | + class procedure GetInterfaceTable; reintroduce; | |
810 | + procedure SafeCallException; reintroduce; | |
811 | + public | |
812 | + procedure AfterConstruction; reintroduce; | |
813 | + procedure BeforeDestruction; reintroduce; | |
814 | + protected | |
815 | + procedure Dispatch; reintroduce; | |
816 | + procedure DefaultHandler; reintroduce; | |
817 | + class procedure NewInstance; reintroduce; | |
818 | + public | |
819 | + procedure FreeInstance; reintroduce; | |
790 | 820 | procedure Destroy; reintroduce; |
791 | - public | |
821 | + | |
822 | + { Upcasting } | |
792 | 823 | function As_SOMObject: SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF} |
793 | 824 | end; |
794 | 825 | |
795 | 826 | TypeCode = class |
796 | - private | |
797 | - { hide TObject methods } | |
827 | + { hide or reimplement TObject methods } | |
828 | + public | |
829 | + procedure Free; reintroduce; | |
830 | + protected | |
831 | + class procedure InitInstance; reintroduce; | |
832 | + public | |
833 | + procedure CleanupInstance; reintroduce; | |
834 | + protected | |
835 | + procedure ClassType; reintroduce; | |
836 | + public | |
837 | + class function ClassName: string; reintroduce; | |
838 | + class function ClassNameIs(const Name: string): Boolean; reintroduce; | |
839 | + protected | |
840 | + class procedure ClassParent; reintroduce; | |
841 | + class procedure ClassInfo; reintroduce; | |
842 | + class procedure InstanceSize; reintroduce; | |
843 | + class procedure InheritsFrom; reintroduce; | |
844 | + class procedure MethodAddress; reintroduce; | |
845 | + class procedure MethodName; reintroduce; | |
846 | + procedure FieldAddress; reintroduce; | |
847 | + procedure GetInterface; reintroduce; | |
848 | + class procedure GetInterfaceEntry; reintroduce; | |
849 | + class procedure GetInterfaceTable; reintroduce; | |
850 | + procedure SafeCallException; reintroduce; | |
851 | + public | |
852 | + procedure AfterConstruction; reintroduce; | |
853 | + procedure BeforeDestruction; reintroduce; | |
854 | + protected | |
855 | + procedure Dispatch; reintroduce; | |
856 | + procedure DefaultHandler; reintroduce; | |
857 | + class procedure NewInstance; reintroduce; | |
858 | + public | |
859 | + procedure FreeInstance; reintroduce; | |
798 | 860 | procedure Destroy; reintroduce; |
799 | 861 | protected |
800 | 862 | function GetKind: TCKind; |
@@ -834,7 +896,6 @@ | ||
834 | 896 | class function TC_FullInterfaceDescription: TypeCode; |
835 | 897 | function Equal(y: TypeCode): CORBABoolean; |
836 | 898 | function Copy: TypeCode; |
837 | - procedure Free; | |
838 | 899 | procedure Print; |
839 | 900 | class function Create(tag: TCKind): TypeCode; overload; |
840 | 901 | class function Create(tag: TCKind; const Arguments: array of const): TypeCode; overload; |
@@ -5897,14 +5958,129 @@ | ||
5897 | 5958 | var |
5898 | 5959 | DLLLoad_CriticalSection : Windows.TRTLCriticalSection; |
5899 | 5960 | |
5900 | -procedure SOMObjectBase.Create; | |
5961 | +class procedure SOMObjectBase.Create; | |
5901 | 5962 | begin |
5902 | 5963 | { hide this method } |
5903 | 5964 | end; |
5904 | 5965 | |
5966 | +procedure SOMObjectBase.Free; | |
5967 | +begin | |
5968 | + if Assigned(Self) then SOMObject(Self).somFree; | |
5969 | +end; | |
5970 | + | |
5971 | +class procedure SOMObjectBase.InitInstance; | |
5972 | +begin | |
5973 | + { hide this method } | |
5974 | +end; | |
5975 | + | |
5976 | +procedure SOMObjectBase.CleanupInstance; | |
5977 | +begin | |
5978 | + { in SOM, everything is being cleaned up by destructors } | |
5979 | +end; | |
5980 | + | |
5981 | +function SOMObjectBase.ClassType: SOMClass; | |
5982 | +begin | |
5983 | + Result := SOMObject(Self).somGetClass; | |
5984 | +end; | |
5985 | + | |
5986 | +class procedure SOMObjectBase.ClassName; | |
5987 | +begin | |
5988 | + { hide this method } | |
5989 | +end; | |
5990 | + | |
5991 | +class procedure SOMObjectBase.ClassNameIs; | |
5992 | +begin | |
5993 | + { hide this method } | |
5994 | +end; | |
5995 | + | |
5996 | +class procedure SOMObjectBase.ClassParent; | |
5997 | +begin | |
5998 | + { hide this method } | |
5999 | +end; | |
6000 | + | |
6001 | +class procedure SOMObjectBase.ClassInfo; | |
6002 | +begin | |
6003 | + { hide this method } | |
6004 | +end; | |
6005 | + | |
6006 | +class procedure SOMObjectBase.InstanceSize; | |
6007 | +begin | |
6008 | + { hide this method } | |
6009 | +end; | |
6010 | + | |
6011 | +class procedure SOMObjectBase.InheritsFrom; | |
6012 | +begin | |
6013 | + { hide this method } | |
6014 | +end; | |
6015 | + | |
6016 | +class procedure SOMObjectBase.MethodAddress; | |
6017 | +begin | |
6018 | + { hide this method } | |
6019 | +end; | |
6020 | + | |
6021 | +class procedure SOMObjectBase.MethodName; | |
6022 | +begin | |
6023 | + { hide this method } | |
6024 | +end; | |
6025 | + | |
6026 | +procedure SOMObjectBase.FieldAddress; | |
6027 | +begin | |
6028 | + { hide this method } | |
6029 | +end; | |
6030 | + | |
6031 | +procedure SOMObjectBase.GetInterface; | |
6032 | +begin | |
6033 | + { hide this method } | |
6034 | +end; | |
6035 | + | |
6036 | +class procedure SOMObjectBase.GetInterfaceEntry; | |
6037 | +begin | |
6038 | + { hide this method } | |
6039 | +end; | |
6040 | + | |
6041 | +class procedure SOMObjectBase.GetInterfaceTable; | |
6042 | +begin | |
6043 | + { hide this method } | |
6044 | +end; | |
6045 | + | |
6046 | +procedure SOMObjectBase.SafeCallException; | |
6047 | +begin | |
6048 | + { hide this method } | |
6049 | +end; | |
6050 | + | |
6051 | +procedure SOMObjectBase.AfterConstruction; | |
6052 | +begin | |
6053 | + { in SOM that is being done by cooperative metaclass } | |
6054 | +end; | |
6055 | + | |
6056 | +procedure SOMObjectBase.BeforeDestruction; | |
6057 | +begin | |
6058 | + { in SOM that is being done by cooperative metaclass } | |
6059 | +end; | |
6060 | + | |
6061 | +procedure SOMObjectBase.Dispatch; | |
6062 | +begin | |
6063 | + { hide this method } | |
6064 | +end; | |
6065 | + | |
6066 | +procedure SOMObjectBase.DefaultHandler; | |
6067 | +begin | |
6068 | + { hide this method } | |
6069 | +end; | |
6070 | + | |
6071 | +class procedure SOMObjectBase.NewInstance; | |
6072 | +begin | |
6073 | + { hide this method } | |
6074 | +end; | |
6075 | + | |
6076 | +procedure SOMObjectBase.FreeInstance; | |
6077 | +begin | |
6078 | + SOMObject(Self).somGetClass.somDeallocate(PAnsiChar(Pointer(Self))); | |
6079 | +end; | |
6080 | + | |
5905 | 6081 | procedure SOMObjectBase.Destroy; |
5906 | 6082 | begin |
5907 | - { hide this method } | |
6083 | + SOMObject(Self).somFree; | |
5908 | 6084 | end; |
5909 | 6085 | |
5910 | 6086 | function SOMObjectBase.As_SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF} |
@@ -5931,11 +6107,135 @@ | ||
5931 | 6107 | Pointer(V_Pointer) := Windows.GetProcAddress(SOMTC_DLL, PAnsiChar(Var_Name)); |
5932 | 6108 | end; |
5933 | 6109 | |
5934 | -procedure TypeCode.Destroy; | |
6110 | +procedure TypeCode.Free; | |
6111 | +begin | |
6112 | + if Assigned(Self) then | |
6113 | + begin | |
6114 | + FreeInstance; | |
6115 | + end; | |
6116 | +end; | |
6117 | + | |
6118 | +class procedure TypeCode.InitInstance; | |
5935 | 6119 | begin |
5936 | 6120 | { hide this method } |
5937 | 6121 | end; |
5938 | 6122 | |
6123 | +procedure TypeCode.CleanupInstance; | |
6124 | +begin | |
6125 | + { TypeCode_free does everything at the same time, so no separate Cleanup } | |
6126 | +end; | |
6127 | + | |
6128 | +procedure TypeCode.ClassType; | |
6129 | +begin | |
6130 | + { hide this method } | |
6131 | +end; | |
6132 | + | |
6133 | +class function TypeCode.ClassName: string; | |
6134 | +begin | |
6135 | + Result := 'TypeCode'; | |
6136 | +end; | |
6137 | + | |
6138 | +class function TypeCode.ClassNameIs(const Name: string): Boolean; | |
6139 | +begin | |
6140 | + Result := Name = 'TypeCode'; | |
6141 | +end; | |
6142 | + | |
6143 | +class procedure TypeCode.ClassParent; | |
6144 | +begin | |
6145 | + { hide this method } | |
6146 | +end; | |
6147 | + | |
6148 | +class procedure TypeCode.ClassInfo; | |
6149 | +begin | |
6150 | + { hide this method } | |
6151 | +end; | |
6152 | + | |
6153 | +class procedure TypeCode.InstanceSize; | |
6154 | +begin | |
6155 | + { hide this method } | |
6156 | +end; | |
6157 | + | |
6158 | +class procedure TypeCode.InheritsFrom; | |
6159 | +begin | |
6160 | + { hide this method } | |
6161 | +end; | |
6162 | + | |
6163 | +class procedure TypeCode.MethodAddress; | |
6164 | +begin | |
6165 | + { hide this method } | |
6166 | +end; | |
6167 | + | |
6168 | +class procedure TypeCode.MethodName; | |
6169 | +begin | |
6170 | + { hide this method } | |
6171 | +end; | |
6172 | + | |
6173 | +procedure TypeCode.FieldAddress; | |
6174 | +begin | |
6175 | + { hide this method } | |
6176 | +end; | |
6177 | + | |
6178 | +procedure TypeCode.GetInterface; | |
6179 | +begin | |
6180 | + { hide this method } | |
6181 | +end; | |
6182 | + | |
6183 | +class procedure TypeCode.GetInterfaceEntry; | |
6184 | +begin | |
6185 | + { hide this method } | |
6186 | +end; | |
6187 | + | |
6188 | +class procedure TypeCode.GetInterfaceTable; | |
6189 | +begin | |
6190 | + { hide this method } | |
6191 | +end; | |
6192 | + | |
6193 | +procedure TypeCode.SafeCallException; | |
6194 | +begin | |
6195 | + { hide this method } | |
6196 | +end; | |
6197 | + | |
6198 | +procedure TypeCode.AfterConstruction; | |
6199 | +begin | |
6200 | + { nothing to do } | |
6201 | +end; | |
6202 | + | |
6203 | +procedure TypeCode.BeforeDestruction; | |
6204 | +begin | |
6205 | + { nothing to do } | |
6206 | +end; | |
6207 | + | |
6208 | +procedure TypeCode.Dispatch; | |
6209 | +begin | |
6210 | + { hide this method } | |
6211 | +end; | |
6212 | + | |
6213 | +procedure TypeCode.DefaultHandler; | |
6214 | +begin | |
6215 | + { hide this method } | |
6216 | +end; | |
6217 | + | |
6218 | +class procedure TypeCode.NewInstance; | |
6219 | +begin | |
6220 | + { hide this method } | |
6221 | +end; | |
6222 | + | |
6223 | +procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree'; | |
6224 | + | |
6225 | +procedure TypeCode.FreeInstance; | |
6226 | +var | |
6227 | + LocalEnv: Environment; | |
6228 | +begin | |
6229 | + SOM_InitEnvironment(@LocalEnv); | |
6230 | + TypeCode_free(Self, @LocalEnv); | |
6231 | + SOM_UninitEnvironmentOrRaise(@LocalEnv); | |
6232 | +end; | |
6233 | + | |
6234 | +procedure TypeCode.Destroy; | |
6235 | +begin | |
6236 | + FreeInstance; | |
6237 | +end; | |
6238 | + | |
5939 | 6239 | function TypeCode_kind(t: TypeCode; ev: PEnvironment): TCKind; stdcall; external SOMTC_DLL_Name name 'tcKind'; |
5940 | 6240 | |
5941 | 6241 | function TypeCode.GetKind: TCKind; |
@@ -6416,17 +6716,6 @@ | ||
6416 | 6716 | SOM_UninitEnvironmentOrRaise(@LocalEnv); |
6417 | 6717 | end; |
6418 | 6718 | |
6419 | -procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree'; | |
6420 | - | |
6421 | -procedure TypeCode.Free; | |
6422 | -var | |
6423 | - LocalEnv: Environment; | |
6424 | -begin | |
6425 | - SOM_InitEnvironment(@LocalEnv); | |
6426 | - TypeCode_free(Self, @LocalEnv); | |
6427 | - SOM_UninitEnvironmentOrRaise(@LocalEnv); | |
6428 | -end; | |
6429 | - | |
6430 | 6719 | procedure TypeCode_print(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcPrint'; |
6431 | 6720 | |
6432 | 6721 | procedure TypeCode.Print; |
@@ -784,17 +784,79 @@ | ||
784 | 784 | |
785 | 785 | { Classes } |
786 | 786 | SOMObjectBase = class |
787 | - private | |
788 | - { hide TObject methods } | |
789 | - procedure Create; reintroduce; | |
787 | + { hide or reimplement TObject methods } | |
788 | + protected | |
789 | + class procedure Create; reintroduce; | |
790 | + public | |
791 | + procedure Free; reintroduce; | |
792 | + protected | |
793 | + class procedure InitInstance; reintroduce; | |
794 | + public | |
795 | + procedure CleanupInstance; reintroduce; | |
796 | + function ClassType: SOMClass; reintroduce; | |
797 | + protected | |
798 | + class procedure ClassName; reintroduce; | |
799 | + class procedure ClassNameIs; reintroduce; | |
800 | + class procedure ClassParent; reintroduce; | |
801 | + class procedure ClassInfo; reintroduce; | |
802 | + class procedure InstanceSize; reintroduce; | |
803 | + class procedure InheritsFrom; reintroduce; | |
804 | + class procedure MethodAddress; reintroduce; | |
805 | + class procedure MethodName; reintroduce; | |
806 | + procedure FieldAddress; reintroduce; | |
807 | + procedure GetInterface; reintroduce; | |
808 | + class procedure GetInterfaceEntry; reintroduce; | |
809 | + class procedure GetInterfaceTable; reintroduce; | |
810 | + procedure SafeCallException; reintroduce; | |
811 | + public | |
812 | + procedure AfterConstruction; reintroduce; | |
813 | + procedure BeforeDestruction; reintroduce; | |
814 | + protected | |
815 | + procedure Dispatch; reintroduce; | |
816 | + procedure DefaultHandler; reintroduce; | |
817 | + class procedure NewInstance; reintroduce; | |
818 | + public | |
819 | + procedure FreeInstance; reintroduce; | |
790 | 820 | procedure Destroy; reintroduce; |
791 | - public | |
821 | + | |
822 | + { Upcasting } | |
792 | 823 | function As_SOMObject: SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF} |
793 | 824 | end; |
794 | 825 | |
795 | 826 | TypeCode = class |
796 | - private | |
797 | - { hide TObject methods } | |
827 | + { hide or reimplement TObject methods } | |
828 | + public | |
829 | + procedure Free; reintroduce; | |
830 | + protected | |
831 | + class procedure InitInstance; reintroduce; | |
832 | + public | |
833 | + procedure CleanupInstance; reintroduce; | |
834 | + protected | |
835 | + procedure ClassType; reintroduce; | |
836 | + public | |
837 | + class function ClassName: string; reintroduce; | |
838 | + class function ClassNameIs(const Name: string): Boolean; reintroduce; | |
839 | + protected | |
840 | + class procedure ClassParent; reintroduce; | |
841 | + class procedure ClassInfo; reintroduce; | |
842 | + class procedure InstanceSize; reintroduce; | |
843 | + class procedure InheritsFrom; reintroduce; | |
844 | + class procedure MethodAddress; reintroduce; | |
845 | + class procedure MethodName; reintroduce; | |
846 | + procedure FieldAddress; reintroduce; | |
847 | + procedure GetInterface; reintroduce; | |
848 | + class procedure GetInterfaceEntry; reintroduce; | |
849 | + class procedure GetInterfaceTable; reintroduce; | |
850 | + procedure SafeCallException; reintroduce; | |
851 | + public | |
852 | + procedure AfterConstruction; reintroduce; | |
853 | + procedure BeforeDestruction; reintroduce; | |
854 | + protected | |
855 | + procedure Dispatch; reintroduce; | |
856 | + procedure DefaultHandler; reintroduce; | |
857 | + class procedure NewInstance; reintroduce; | |
858 | + public | |
859 | + procedure FreeInstance; reintroduce; | |
798 | 860 | procedure Destroy; reintroduce; |
799 | 861 | protected |
800 | 862 | function GetKind: TCKind; |
@@ -834,7 +896,6 @@ | ||
834 | 896 | class function TC_FullInterfaceDescription: TypeCode; |
835 | 897 | function Equal(y: TypeCode): CORBABoolean; |
836 | 898 | function Copy: TypeCode; |
837 | - procedure Free; | |
838 | 899 | procedure Print; |
839 | 900 | class function Create(tag: TCKind): TypeCode; overload; |
840 | 901 | class function Create(tag: TCKind; const Arguments: array of const): TypeCode; overload; |
@@ -5897,14 +5958,129 @@ | ||
5897 | 5958 | var |
5898 | 5959 | DLLLoad_CriticalSection : Windows.TRTLCriticalSection; |
5899 | 5960 | |
5900 | -procedure SOMObjectBase.Create; | |
5961 | +class procedure SOMObjectBase.Create; | |
5901 | 5962 | begin |
5902 | 5963 | { hide this method } |
5903 | 5964 | end; |
5904 | 5965 | |
5966 | +procedure SOMObjectBase.Free; | |
5967 | +begin | |
5968 | + if Assigned(Self) then SOMObject(Self).somFree; | |
5969 | +end; | |
5970 | + | |
5971 | +class procedure SOMObjectBase.InitInstance; | |
5972 | +begin | |
5973 | + { hide this method } | |
5974 | +end; | |
5975 | + | |
5976 | +procedure SOMObjectBase.CleanupInstance; | |
5977 | +begin | |
5978 | + { in SOM, everything is being cleaned up by destructors } | |
5979 | +end; | |
5980 | + | |
5981 | +function SOMObjectBase.ClassType: SOMClass; | |
5982 | +begin | |
5983 | + Result := SOMObject(Self).somGetClass; | |
5984 | +end; | |
5985 | + | |
5986 | +class procedure SOMObjectBase.ClassName; | |
5987 | +begin | |
5988 | + { hide this method } | |
5989 | +end; | |
5990 | + | |
5991 | +class procedure SOMObjectBase.ClassNameIs; | |
5992 | +begin | |
5993 | + { hide this method } | |
5994 | +end; | |
5995 | + | |
5996 | +class procedure SOMObjectBase.ClassParent; | |
5997 | +begin | |
5998 | + { hide this method } | |
5999 | +end; | |
6000 | + | |
6001 | +class procedure SOMObjectBase.ClassInfo; | |
6002 | +begin | |
6003 | + { hide this method } | |
6004 | +end; | |
6005 | + | |
6006 | +class procedure SOMObjectBase.InstanceSize; | |
6007 | +begin | |
6008 | + { hide this method } | |
6009 | +end; | |
6010 | + | |
6011 | +class procedure SOMObjectBase.InheritsFrom; | |
6012 | +begin | |
6013 | + { hide this method } | |
6014 | +end; | |
6015 | + | |
6016 | +class procedure SOMObjectBase.MethodAddress; | |
6017 | +begin | |
6018 | + { hide this method } | |
6019 | +end; | |
6020 | + | |
6021 | +class procedure SOMObjectBase.MethodName; | |
6022 | +begin | |
6023 | + { hide this method } | |
6024 | +end; | |
6025 | + | |
6026 | +procedure SOMObjectBase.FieldAddress; | |
6027 | +begin | |
6028 | + { hide this method } | |
6029 | +end; | |
6030 | + | |
6031 | +procedure SOMObjectBase.GetInterface; | |
6032 | +begin | |
6033 | + { hide this method } | |
6034 | +end; | |
6035 | + | |
6036 | +class procedure SOMObjectBase.GetInterfaceEntry; | |
6037 | +begin | |
6038 | + { hide this method } | |
6039 | +end; | |
6040 | + | |
6041 | +class procedure SOMObjectBase.GetInterfaceTable; | |
6042 | +begin | |
6043 | + { hide this method } | |
6044 | +end; | |
6045 | + | |
6046 | +procedure SOMObjectBase.SafeCallException; | |
6047 | +begin | |
6048 | + { hide this method } | |
6049 | +end; | |
6050 | + | |
6051 | +procedure SOMObjectBase.AfterConstruction; | |
6052 | +begin | |
6053 | + { in SOM that is being done by cooperative metaclass } | |
6054 | +end; | |
6055 | + | |
6056 | +procedure SOMObjectBase.BeforeDestruction; | |
6057 | +begin | |
6058 | + { in SOM that is being done by cooperative metaclass } | |
6059 | +end; | |
6060 | + | |
6061 | +procedure SOMObjectBase.Dispatch; | |
6062 | +begin | |
6063 | + { hide this method } | |
6064 | +end; | |
6065 | + | |
6066 | +procedure SOMObjectBase.DefaultHandler; | |
6067 | +begin | |
6068 | + { hide this method } | |
6069 | +end; | |
6070 | + | |
6071 | +class procedure SOMObjectBase.NewInstance; | |
6072 | +begin | |
6073 | + { hide this method } | |
6074 | +end; | |
6075 | + | |
6076 | +procedure SOMObjectBase.FreeInstance; | |
6077 | +begin | |
6078 | + SOMObject(Self).somGetClass.somDeallocate(PAnsiChar(Pointer(Self))); | |
6079 | +end; | |
6080 | + | |
5905 | 6081 | procedure SOMObjectBase.Destroy; |
5906 | 6082 | begin |
5907 | - { hide this method } | |
6083 | + SOMObject(Self).somFree; | |
5908 | 6084 | end; |
5909 | 6085 | |
5910 | 6086 | function SOMObjectBase.As_SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF} |
@@ -5931,11 +6107,135 @@ | ||
5931 | 6107 | Pointer(V_Pointer) := Windows.GetProcAddress(SOMTC_DLL, PAnsiChar(Var_Name)); |
5932 | 6108 | end; |
5933 | 6109 | |
5934 | -procedure TypeCode.Destroy; | |
6110 | +procedure TypeCode.Free; | |
6111 | +begin | |
6112 | + if Assigned(Self) then | |
6113 | + begin | |
6114 | + FreeInstance; | |
6115 | + end; | |
6116 | +end; | |
6117 | + | |
6118 | +class procedure TypeCode.InitInstance; | |
5935 | 6119 | begin |
5936 | 6120 | { hide this method } |
5937 | 6121 | end; |
5938 | 6122 | |
6123 | +procedure TypeCode.CleanupInstance; | |
6124 | +begin | |
6125 | + { TypeCode_free does everything at the same time, so no separate Cleanup } | |
6126 | +end; | |
6127 | + | |
6128 | +procedure TypeCode.ClassType; | |
6129 | +begin | |
6130 | + { hide this method } | |
6131 | +end; | |
6132 | + | |
6133 | +class function TypeCode.ClassName: string; | |
6134 | +begin | |
6135 | + Result := 'TypeCode'; | |
6136 | +end; | |
6137 | + | |
6138 | +class function TypeCode.ClassNameIs(const Name: string): Boolean; | |
6139 | +begin | |
6140 | + Result := Name = 'TypeCode'; | |
6141 | +end; | |
6142 | + | |
6143 | +class procedure TypeCode.ClassParent; | |
6144 | +begin | |
6145 | + { hide this method } | |
6146 | +end; | |
6147 | + | |
6148 | +class procedure TypeCode.ClassInfo; | |
6149 | +begin | |
6150 | + { hide this method } | |
6151 | +end; | |
6152 | + | |
6153 | +class procedure TypeCode.InstanceSize; | |
6154 | +begin | |
6155 | + { hide this method } | |
6156 | +end; | |
6157 | + | |
6158 | +class procedure TypeCode.InheritsFrom; | |
6159 | +begin | |
6160 | + { hide this method } | |
6161 | +end; | |
6162 | + | |
6163 | +class procedure TypeCode.MethodAddress; | |
6164 | +begin | |
6165 | + { hide this method } | |
6166 | +end; | |
6167 | + | |
6168 | +class procedure TypeCode.MethodName; | |
6169 | +begin | |
6170 | + { hide this method } | |
6171 | +end; | |
6172 | + | |
6173 | +procedure TypeCode.FieldAddress; | |
6174 | +begin | |
6175 | + { hide this method } | |
6176 | +end; | |
6177 | + | |
6178 | +procedure TypeCode.GetInterface; | |
6179 | +begin | |
6180 | + { hide this method } | |
6181 | +end; | |
6182 | + | |
6183 | +class procedure TypeCode.GetInterfaceEntry; | |
6184 | +begin | |
6185 | + { hide this method } | |
6186 | +end; | |
6187 | + | |
6188 | +class procedure TypeCode.GetInterfaceTable; | |
6189 | +begin | |
6190 | + { hide this method } | |
6191 | +end; | |
6192 | + | |
6193 | +procedure TypeCode.SafeCallException; | |
6194 | +begin | |
6195 | + { hide this method } | |
6196 | +end; | |
6197 | + | |
6198 | +procedure TypeCode.AfterConstruction; | |
6199 | +begin | |
6200 | + { nothing to do } | |
6201 | +end; | |
6202 | + | |
6203 | +procedure TypeCode.BeforeDestruction; | |
6204 | +begin | |
6205 | + { nothing to do } | |
6206 | +end; | |
6207 | + | |
6208 | +procedure TypeCode.Dispatch; | |
6209 | +begin | |
6210 | + { hide this method } | |
6211 | +end; | |
6212 | + | |
6213 | +procedure TypeCode.DefaultHandler; | |
6214 | +begin | |
6215 | + { hide this method } | |
6216 | +end; | |
6217 | + | |
6218 | +class procedure TypeCode.NewInstance; | |
6219 | +begin | |
6220 | + { hide this method } | |
6221 | +end; | |
6222 | + | |
6223 | +procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree'; | |
6224 | + | |
6225 | +procedure TypeCode.FreeInstance; | |
6226 | +var | |
6227 | + LocalEnv: Environment; | |
6228 | +begin | |
6229 | + SOM_InitEnvironment(@LocalEnv); | |
6230 | + TypeCode_free(Self, @LocalEnv); | |
6231 | + SOM_UninitEnvironmentOrRaise(@LocalEnv); | |
6232 | +end; | |
6233 | + | |
6234 | +procedure TypeCode.Destroy; | |
6235 | +begin | |
6236 | + FreeInstance; | |
6237 | +end; | |
6238 | + | |
5939 | 6239 | function TypeCode_kind(t: TypeCode; ev: PEnvironment): TCKind; stdcall; external SOMTC_DLL_Name name 'tcKind'; |
5940 | 6240 | |
5941 | 6241 | function TypeCode.GetKind: TCKind; |
@@ -6416,17 +6716,6 @@ | ||
6416 | 6716 | SOM_UninitEnvironmentOrRaise(@LocalEnv); |
6417 | 6717 | end; |
6418 | 6718 | |
6419 | -procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree'; | |
6420 | - | |
6421 | -procedure TypeCode.Free; | |
6422 | -var | |
6423 | - LocalEnv: Environment; | |
6424 | -begin | |
6425 | - SOM_InitEnvironment(@LocalEnv); | |
6426 | - TypeCode_free(Self, @LocalEnv); | |
6427 | - SOM_UninitEnvironmentOrRaise(@LocalEnv); | |
6428 | -end; | |
6429 | - | |
6430 | 6719 | procedure TypeCode_print(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcPrint'; |
6431 | 6720 | |
6432 | 6721 | procedure TypeCode.Print; |
@@ -2686,18 +2686,80 @@ | ||
2686 | 2686 | WriteLn(F); |
2687 | 2687 | WriteLn(F, ' { Classes }'); |
2688 | 2688 | WriteLn(F, ' SOMObjectBase = class'); |
2689 | - WriteLn(F, ' private'); | |
2690 | - WriteLn(F, ' { hide TObject methods }'); | |
2691 | - WriteLn(F, ' procedure Create; reintroduce;'); | |
2692 | - WriteLn(F, ' procedure Destroy; reintroduce;'); // TODO hide others | |
2689 | + WriteLn(F, ' { hide or reimplement TObject methods }'); | |
2690 | + WriteLn(F, ' protected'); | |
2691 | + WriteLn(F, ' class procedure Create; reintroduce;'); | |
2693 | 2692 | WriteLn(F, ' public'); |
2693 | + WriteLn(F, ' procedure Free; reintroduce;'); | |
2694 | + WriteLn(F, ' protected'); | |
2695 | + WriteLn(F, ' class procedure InitInstance; reintroduce;'); | |
2696 | + WriteLn(F, ' public'); | |
2697 | + WriteLn(F, ' procedure CleanupInstance; reintroduce;'); | |
2698 | + WriteLn(F, ' function ClassType: SOMClass; reintroduce;'); | |
2699 | + WriteLn(F, ' protected'); | |
2700 | + WriteLn(F, ' class procedure ClassName; reintroduce;'); | |
2701 | + WriteLn(F, ' class procedure ClassNameIs; reintroduce;'); | |
2702 | + WriteLn(F, ' class procedure ClassParent; reintroduce;'); | |
2703 | + WriteLn(F, ' class procedure ClassInfo; reintroduce;'); | |
2704 | + WriteLn(F, ' class procedure InstanceSize; reintroduce;'); | |
2705 | + WriteLn(F, ' class procedure InheritsFrom; reintroduce;'); | |
2706 | + WriteLn(F, ' class procedure MethodAddress; reintroduce;'); | |
2707 | + WriteLn(F, ' class procedure MethodName; reintroduce;'); | |
2708 | + WriteLn(F, ' procedure FieldAddress; reintroduce;'); | |
2709 | + WriteLn(F, ' procedure GetInterface; reintroduce;'); | |
2710 | + WriteLn(F, ' class procedure GetInterfaceEntry; reintroduce;'); | |
2711 | + WriteLn(F, ' class procedure GetInterfaceTable; reintroduce;'); | |
2712 | + WriteLn(F, ' procedure SafeCallException; reintroduce;'); | |
2713 | + WriteLn(F, ' public'); | |
2714 | + WriteLn(F, ' procedure AfterConstruction; reintroduce;'); | |
2715 | + WriteLn(F, ' procedure BeforeDestruction; reintroduce;'); | |
2716 | + WriteLn(F, ' protected'); | |
2717 | + WriteLn(F, ' procedure Dispatch; reintroduce;'); | |
2718 | + WriteLn(F, ' procedure DefaultHandler; reintroduce;'); | |
2719 | + WriteLn(F, ' class procedure NewInstance; reintroduce;'); | |
2720 | + WriteLn(F, ' public'); | |
2721 | + WriteLn(F, ' procedure FreeInstance; reintroduce;'); | |
2722 | + WriteLn(F, ' procedure Destroy; reintroduce;'); | |
2723 | + WriteLn(F); | |
2724 | + WriteLn(F, ' { Upcasting }'); | |
2694 | 2725 | WriteLn(F, ' function As_SOMObject: SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}'); |
2695 | 2726 | WriteLn(F, ' end;'); |
2696 | 2727 | WriteLn(F); |
2697 | 2728 | WriteLn(F, ' TypeCode = class'); |
2698 | - WriteLn(F, ' private'); | |
2699 | - WriteLn(F, ' { hide TObject methods }'); | |
2700 | - WriteLn(F, ' procedure Destroy; reintroduce;'); // TODO hide others | |
2729 | + WriteLn(F, ' { hide or reimplement TObject methods }'); | |
2730 | + WriteLn(F, ' public'); | |
2731 | + WriteLn(F, ' procedure Free; reintroduce;'); | |
2732 | + WriteLn(F, ' protected'); | |
2733 | + WriteLn(F, ' class procedure InitInstance; reintroduce;'); | |
2734 | + WriteLn(F, ' public'); | |
2735 | + WriteLn(F, ' procedure CleanupInstance; reintroduce;'); | |
2736 | + WriteLn(F, ' protected'); | |
2737 | + WriteLn(F, ' procedure ClassType; reintroduce;'); | |
2738 | + WriteLn(F, ' public'); | |
2739 | + WriteLn(F, ' class function ClassName: string; reintroduce;'); | |
2740 | + WriteLn(F, ' class function ClassNameIs(const Name: string): Boolean; reintroduce;'); | |
2741 | + WriteLn(F, ' protected'); | |
2742 | + WriteLn(F, ' class procedure ClassParent; reintroduce;'); | |
2743 | + WriteLn(F, ' class procedure ClassInfo; reintroduce;'); | |
2744 | + WriteLn(F, ' class procedure InstanceSize; reintroduce;'); | |
2745 | + WriteLn(F, ' class procedure InheritsFrom; reintroduce;'); | |
2746 | + WriteLn(F, ' class procedure MethodAddress; reintroduce;'); | |
2747 | + WriteLn(F, ' class procedure MethodName; reintroduce;'); | |
2748 | + WriteLn(F, ' procedure FieldAddress; reintroduce;'); | |
2749 | + WriteLn(F, ' procedure GetInterface; reintroduce;'); | |
2750 | + WriteLn(F, ' class procedure GetInterfaceEntry; reintroduce;'); | |
2751 | + WriteLn(F, ' class procedure GetInterfaceTable; reintroduce;'); | |
2752 | + WriteLn(F, ' procedure SafeCallException; reintroduce;'); | |
2753 | + WriteLn(F, ' public'); | |
2754 | + WriteLn(F, ' procedure AfterConstruction; reintroduce;'); | |
2755 | + WriteLn(F, ' procedure BeforeDestruction; reintroduce;'); | |
2756 | + WriteLn(F, ' protected'); | |
2757 | + WriteLn(F, ' procedure Dispatch; reintroduce;'); | |
2758 | + WriteLn(F, ' procedure DefaultHandler; reintroduce;'); | |
2759 | + WriteLn(F, ' class procedure NewInstance; reintroduce;'); | |
2760 | + WriteLn(F, ' public'); | |
2761 | + WriteLn(F, ' procedure FreeInstance; reintroduce;'); | |
2762 | + WriteLn(F, ' procedure Destroy; reintroduce;'); | |
2701 | 2763 | WriteLn(F, ' protected'); |
2702 | 2764 | WriteLn(F, ' function GetKind: TCKind;'); |
2703 | 2765 | WriteLn(F, ' function GetParamCount: LongInt;'); |
@@ -2736,7 +2798,6 @@ | ||
2736 | 2798 | WriteLn(F, ' class function TC_FullInterfaceDescription: TypeCode;'); |
2737 | 2799 | WriteLn(F, ' function Equal(y: TypeCode): CORBABoolean;'); |
2738 | 2800 | WriteLn(F, ' function Copy: TypeCode;'); |
2739 | - WriteLn(F, ' procedure Free;'); | |
2740 | 2801 | WriteLn(F, ' procedure Print;'); |
2741 | 2802 | WriteLn(F, ' class function Create(tag: TCKind): TypeCode; overload;'); |
2742 | 2803 | WriteLn(F, ' class function Create(tag: TCKind; const Arguments: array of const): TypeCode; overload;'); |
@@ -3025,14 +3086,129 @@ | ||
3025 | 3086 | WriteLn(F, 'var'); |
3026 | 3087 | WriteLn(F, ' DLLLoad_CriticalSection : Windows.TRTLCriticalSection;'); |
3027 | 3088 | WriteLn(F); |
3028 | - WriteLn(F, 'procedure SOMObjectBase.Create;'); | |
3089 | + WriteLn(F, 'class procedure SOMObjectBase.Create;'); | |
3029 | 3090 | WriteLn(F, 'begin'); |
3030 | 3091 | WriteLn(F, ' { hide this method }'); |
3031 | 3092 | WriteLn(F, 'end;'); |
3032 | 3093 | WriteLn(F); |
3094 | + WriteLn(F, 'procedure SOMObjectBase.Free;'); | |
3095 | + WriteLn(F, 'begin'); | |
3096 | + WriteLn(F, ' if Assigned(Self) then SOMObject(Self).somFree;'); | |
3097 | + WriteLn(F, 'end;'); | |
3098 | + WriteLn(F); | |
3099 | + WriteLn(F, 'class procedure SOMObjectBase.InitInstance;'); | |
3100 | + WriteLn(F, 'begin'); | |
3101 | + WriteLn(F, ' { hide this method }'); | |
3102 | + WriteLn(F, 'end;'); | |
3103 | + WriteLn(F); | |
3104 | + WriteLn(F, 'procedure SOMObjectBase.CleanupInstance;'); | |
3105 | + WriteLn(F, 'begin'); | |
3106 | + WriteLn(F, ' { in SOM, everything is being cleaned up by destructors }'); | |
3107 | + WriteLn(F, 'end;'); | |
3108 | + WriteLn(F); | |
3109 | + WriteLn(F, 'function SOMObjectBase.ClassType: SOMClass;'); | |
3110 | + WriteLn(F, 'begin'); | |
3111 | + WriteLn(F, ' Result := SOMObject(Self).somGetClass;'); | |
3112 | + WriteLn(F, 'end;'); | |
3113 | + WriteLn(F); | |
3114 | + WriteLn(F, 'class procedure SOMObjectBase.ClassName;'); | |
3115 | + WriteLn(F, 'begin'); | |
3116 | + WriteLn(F, ' { hide this method }'); | |
3117 | + WriteLn(F, 'end;'); | |
3118 | + WriteLn(F); | |
3119 | + WriteLn(F, 'class procedure SOMObjectBase.ClassNameIs;'); | |
3120 | + WriteLn(F, 'begin'); | |
3121 | + WriteLn(F, ' { hide this method }'); | |
3122 | + WriteLn(F, 'end;'); | |
3123 | + WriteLn(F); | |
3124 | + WriteLn(F, 'class procedure SOMObjectBase.ClassParent;'); | |
3125 | + WriteLn(F, 'begin'); | |
3126 | + WriteLn(F, ' { hide this method }'); | |
3127 | + WriteLn(F, 'end;'); | |
3128 | + WriteLn(F); | |
3129 | + WriteLn(F, 'class procedure SOMObjectBase.ClassInfo;'); | |
3130 | + WriteLn(F, 'begin'); | |
3131 | + WriteLn(F, ' { hide this method }'); | |
3132 | + WriteLn(F, 'end;'); | |
3133 | + WriteLn(F); | |
3134 | + WriteLn(F, 'class procedure SOMObjectBase.InstanceSize;'); | |
3135 | + WriteLn(F, 'begin'); | |
3136 | + WriteLn(F, ' { hide this method }'); | |
3137 | + WriteLn(F, 'end;'); | |
3138 | + WriteLn(F); | |
3139 | + WriteLn(F, 'class procedure SOMObjectBase.InheritsFrom;'); | |
3140 | + WriteLn(F, 'begin'); | |
3141 | + WriteLn(F, ' { hide this method }'); | |
3142 | + WriteLn(F, 'end;'); | |
3143 | + WriteLn(F); | |
3144 | + WriteLn(F, 'class procedure SOMObjectBase.MethodAddress;'); | |
3145 | + WriteLn(F, 'begin'); | |
3146 | + WriteLn(F, ' { hide this method }'); | |
3147 | + WriteLn(F, 'end;'); | |
3148 | + WriteLn(F); | |
3149 | + WriteLn(F, 'class procedure SOMObjectBase.MethodName;'); | |
3150 | + WriteLn(F, 'begin'); | |
3151 | + WriteLn(F, ' { hide this method }'); | |
3152 | + WriteLn(F, 'end;'); | |
3153 | + WriteLn(F); | |
3154 | + WriteLn(F, 'procedure SOMObjectBase.FieldAddress;'); | |
3155 | + WriteLn(F, 'begin'); | |
3156 | + WriteLn(F, ' { hide this method }'); | |
3157 | + WriteLn(F, 'end;'); | |
3158 | + WriteLn(F); | |
3159 | + WriteLn(F, 'procedure SOMObjectBase.GetInterface;'); | |
3160 | + WriteLn(F, 'begin'); | |
3161 | + WriteLn(F, ' { hide this method }'); | |
3162 | + WriteLn(F, 'end;'); | |
3163 | + WriteLn(F); | |
3164 | + WriteLn(F, 'class procedure SOMObjectBase.GetInterfaceEntry;'); | |
3165 | + WriteLn(F, 'begin'); | |
3166 | + WriteLn(F, ' { hide this method }'); | |
3167 | + WriteLn(F, 'end;'); | |
3168 | + WriteLn(F); | |
3169 | + WriteLn(F, 'class procedure SOMObjectBase.GetInterfaceTable;'); | |
3170 | + WriteLn(F, 'begin'); | |
3171 | + WriteLn(F, ' { hide this method }'); | |
3172 | + WriteLn(F, 'end;'); | |
3173 | + WriteLn(F); | |
3174 | + WriteLn(F, 'procedure SOMObjectBase.SafeCallException;'); | |
3175 | + WriteLn(F, 'begin'); | |
3176 | + WriteLn(F, ' { hide this method }'); | |
3177 | + WriteLn(F, 'end;'); | |
3178 | + WriteLn(F); | |
3179 | + WriteLn(F, 'procedure SOMObjectBase.AfterConstruction;'); | |
3180 | + WriteLn(F, 'begin'); | |
3181 | + WriteLn(F, ' { in SOM that is being done by cooperative metaclass }'); | |
3182 | + WriteLn(F, 'end;'); | |
3183 | + WriteLn(F); | |
3184 | + WriteLn(F, 'procedure SOMObjectBase.BeforeDestruction;'); | |
3185 | + WriteLn(F, 'begin'); | |
3186 | + WriteLn(F, ' { in SOM that is being done by cooperative metaclass }'); | |
3187 | + WriteLn(F, 'end;'); | |
3188 | + WriteLn(F); | |
3189 | + WriteLn(F, 'procedure SOMObjectBase.Dispatch;'); | |
3190 | + WriteLn(F, 'begin'); | |
3191 | + WriteLn(F, ' { hide this method }'); | |
3192 | + WriteLn(F, 'end;'); | |
3193 | + WriteLn(F); | |
3194 | + WriteLn(F, 'procedure SOMObjectBase.DefaultHandler;'); | |
3195 | + WriteLn(F, 'begin'); | |
3196 | + WriteLn(F, ' { hide this method }'); | |
3197 | + WriteLn(F, 'end;'); | |
3198 | + WriteLn(F); | |
3199 | + WriteLn(F, 'class procedure SOMObjectBase.NewInstance;'); | |
3200 | + WriteLn(F, 'begin'); | |
3201 | + WriteLn(F, ' { hide this method }'); | |
3202 | + WriteLn(F, 'end;'); | |
3203 | + WriteLn(F); | |
3204 | + WriteLn(F, 'procedure SOMObjectBase.FreeInstance;'); | |
3205 | + WriteLn(F, 'begin'); | |
3206 | + WriteLn(F, ' SOMObject(Self).somGetClass.somDeallocate(PAnsiChar(Pointer(Self)));'); | |
3207 | + WriteLn(F, 'end;'); | |
3208 | + WriteLn(F); | |
3033 | 3209 | WriteLn(F, 'procedure SOMObjectBase.Destroy;'); |
3034 | 3210 | WriteLn(F, 'begin'); |
3035 | - WriteLn(F, ' { hide this method }'); | |
3211 | + WriteLn(F, ' SOMObject(Self).somFree;'); | |
3036 | 3212 | WriteLn(F, 'end;'); |
3037 | 3213 | WriteLn(F); |
3038 | 3214 | WriteLn(F, 'function SOMObjectBase.As_SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}'); |
@@ -3060,9 +3236,133 @@ | ||
3060 | 3236 | WriteLn(F, 'end;'); |
3061 | 3237 | FDLLs.Add('somtc.dll'); |
3062 | 3238 | WriteLn(F); |
3239 | + WriteLn(F, 'procedure TypeCode.Free;'); | |
3240 | + WriteLn(F, 'begin'); | |
3241 | + WriteLn(F, ' if Assigned(Self) then'); | |
3242 | + WriteLn(F, ' begin'); | |
3243 | + WriteLn(F, ' FreeInstance;'); | |
3244 | + WriteLn(F, ' end;'); | |
3245 | + WriteLn(F, 'end;'); | |
3246 | + WriteLn(F); | |
3247 | + WriteLn(F, 'class procedure TypeCode.InitInstance;'); | |
3248 | + WriteLn(F, 'begin'); | |
3249 | + WriteLn(F, ' { hide this method }'); | |
3250 | + WriteLn(F, 'end;'); | |
3251 | + WriteLn(F); | |
3252 | + WriteLn(F, 'procedure TypeCode.CleanupInstance;'); | |
3253 | + WriteLn(F, 'begin'); | |
3254 | + WriteLn(F, ' { TypeCode_free does everything at the same time, so no separate Cleanup }'); | |
3255 | + WriteLn(F, 'end;'); | |
3256 | + WriteLn(F); | |
3257 | + WriteLn(F, 'procedure TypeCode.ClassType;'); | |
3258 | + WriteLn(F, 'begin'); | |
3259 | + WriteLn(F, ' { hide this method }'); | |
3260 | + WriteLn(F, 'end;'); | |
3261 | + WriteLn(F); | |
3262 | + WriteLn(F, 'class function TypeCode.ClassName: string;'); | |
3263 | + WriteLn(F, 'begin'); | |
3264 | + WriteLn(F, ' Result := ''TypeCode'';'); | |
3265 | + WriteLn(F, 'end;'); | |
3266 | + WriteLn(F); | |
3267 | + WriteLn(F, 'class function TypeCode.ClassNameIs(const Name: string): Boolean;'); | |
3268 | + WriteLn(F, 'begin'); | |
3269 | + WriteLn(F, ' Result := Name = ''TypeCode'';'); | |
3270 | + WriteLn(F, 'end;'); | |
3271 | + WriteLn(F); | |
3272 | + WriteLn(F, 'class procedure TypeCode.ClassParent;'); | |
3273 | + WriteLn(F, 'begin'); | |
3274 | + WriteLn(F, ' { hide this method }'); | |
3275 | + WriteLn(F, 'end;'); | |
3276 | + WriteLn(F); | |
3277 | + WriteLn(F, 'class procedure TypeCode.ClassInfo;'); | |
3278 | + WriteLn(F, 'begin'); | |
3279 | + WriteLn(F, ' { hide this method }'); | |
3280 | + WriteLn(F, 'end;'); | |
3281 | + WriteLn(F); | |
3282 | + WriteLn(F, 'class procedure TypeCode.InstanceSize;'); | |
3283 | + WriteLn(F, 'begin'); | |
3284 | + WriteLn(F, ' { hide this method }'); | |
3285 | + WriteLn(F, 'end;'); | |
3286 | + WriteLn(F); | |
3287 | + WriteLn(F, 'class procedure TypeCode.InheritsFrom;'); | |
3288 | + WriteLn(F, 'begin'); | |
3289 | + WriteLn(F, ' { hide this method }'); | |
3290 | + WriteLn(F, 'end;'); | |
3291 | + WriteLn(F); | |
3292 | + WriteLn(F, 'class procedure TypeCode.MethodAddress;'); | |
3293 | + WriteLn(F, 'begin'); | |
3294 | + WriteLn(F, ' { hide this method }'); | |
3295 | + WriteLn(F, 'end;'); | |
3296 | + WriteLn(F); | |
3297 | + WriteLn(F, 'class procedure TypeCode.MethodName;'); | |
3298 | + WriteLn(F, 'begin'); | |
3299 | + WriteLn(F, ' { hide this method }'); | |
3300 | + WriteLn(F, 'end;'); | |
3301 | + WriteLn(F); | |
3302 | + WriteLn(F, 'procedure TypeCode.FieldAddress;'); | |
3303 | + WriteLn(F, 'begin'); | |
3304 | + WriteLn(F, ' { hide this method }'); | |
3305 | + WriteLn(F, 'end;'); | |
3306 | + WriteLn(F); | |
3307 | + WriteLn(F, 'procedure TypeCode.GetInterface;'); | |
3308 | + WriteLn(F, 'begin'); | |
3309 | + WriteLn(F, ' { hide this method }'); | |
3310 | + WriteLn(F, 'end;'); | |
3311 | + WriteLn(F); | |
3312 | + WriteLn(F, 'class procedure TypeCode.GetInterfaceEntry;'); | |
3313 | + WriteLn(F, 'begin'); | |
3314 | + WriteLn(F, ' { hide this method }'); | |
3315 | + WriteLn(F, 'end;'); | |
3316 | + WriteLn(F); | |
3317 | + WriteLn(F, 'class procedure TypeCode.GetInterfaceTable;'); | |
3318 | + WriteLn(F, 'begin'); | |
3319 | + WriteLn(F, ' { hide this method }'); | |
3320 | + WriteLn(F, 'end;'); | |
3321 | + WriteLn(F); | |
3322 | + WriteLn(F, 'procedure TypeCode.SafeCallException;'); | |
3323 | + WriteLn(F, 'begin'); | |
3324 | + WriteLn(F, ' { hide this method }'); | |
3325 | + WriteLn(F, 'end;'); | |
3326 | + WriteLn(F); | |
3327 | + WriteLn(F, 'procedure TypeCode.AfterConstruction;'); | |
3328 | + WriteLn(F, 'begin'); | |
3329 | + WriteLn(F, ' { nothing to do }'); | |
3330 | + WriteLn(F, 'end;'); | |
3331 | + WriteLn(F); | |
3332 | + WriteLn(F, 'procedure TypeCode.BeforeDestruction;'); | |
3333 | + WriteLn(F, 'begin'); | |
3334 | + WriteLn(F, ' { nothing to do }'); | |
3335 | + WriteLn(F, 'end;'); | |
3336 | + WriteLn(F); | |
3337 | + WriteLn(F, 'procedure TypeCode.Dispatch;'); | |
3338 | + WriteLn(F, 'begin'); | |
3339 | + WriteLn(F, ' { hide this method }'); | |
3340 | + WriteLn(F, 'end;'); | |
3341 | + WriteLn(F); | |
3342 | + WriteLn(F, 'procedure TypeCode.DefaultHandler;'); | |
3343 | + WriteLn(F, 'begin'); | |
3344 | + WriteLn(F, ' { hide this method }'); | |
3345 | + WriteLn(F, 'end;'); | |
3346 | + WriteLn(F); | |
3347 | + WriteLn(F, 'class procedure TypeCode.NewInstance;'); | |
3348 | + WriteLn(F, 'begin'); | |
3349 | + WriteLn(F, ' { hide this method }'); | |
3350 | + WriteLn(F, 'end;'); | |
3351 | + WriteLn(F); | |
3352 | + WriteLn(F, 'procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcFree'';'); | |
3353 | + WriteLn(F); | |
3354 | + WriteLn(F, 'procedure TypeCode.FreeInstance;'); | |
3355 | + WriteLn(F, 'var'); | |
3356 | + WriteLn(F, ' LocalEnv: Environment;'); | |
3357 | + WriteLn(F, 'begin'); | |
3358 | + WriteLn(F, ' SOM_InitEnvironment(@LocalEnv);'); | |
3359 | + WriteLn(F, ' TypeCode_free(Self, @LocalEnv);'); | |
3360 | + WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);'); | |
3361 | + WriteLn(F, 'end;'); | |
3362 | + WriteLn(F); | |
3063 | 3363 | WriteLn(F, 'procedure TypeCode.Destroy;'); |
3064 | 3364 | WriteLn(F, 'begin'); |
3065 | - WriteLn(F, ' { hide this method }'); // TODO free? | |
3365 | + WriteLn(F, ' FreeInstance;'); | |
3066 | 3366 | WriteLn(F, 'end;'); |
3067 | 3367 | WriteLn(F); |
3068 | 3368 | WriteLn(F, 'function TypeCode_kind(t: TypeCode; ev: PEnvironment): TCKind; stdcall; external SOMTC_DLL_Name name ''tcKind'';'); |
@@ -3545,17 +3845,6 @@ | ||
3545 | 3845 | WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);'); |
3546 | 3846 | WriteLn(F, 'end;'); |
3547 | 3847 | WriteLn(F); |
3548 | - WriteLn(F, 'procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcFree'';'); | |
3549 | - WriteLn(F); | |
3550 | - WriteLn(F, 'procedure TypeCode.Free;'); | |
3551 | - WriteLn(F, 'var'); | |
3552 | - WriteLn(F, ' LocalEnv: Environment;'); | |
3553 | - WriteLn(F, 'begin'); | |
3554 | - WriteLn(F, ' SOM_InitEnvironment(@LocalEnv);'); | |
3555 | - WriteLn(F, ' TypeCode_free(Self, @LocalEnv);'); | |
3556 | - WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);'); | |
3557 | - WriteLn(F, 'end;'); | |
3558 | - WriteLn(F); | |
3559 | 3848 | WriteLn(F, 'procedure TypeCode_print(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcPrint'';'); |
3560 | 3849 | WriteLn(F); |
3561 | 3850 | WriteLn(F, 'procedure TypeCode.Print;'); |
@@ -4045,7 +4334,6 @@ | ||
4045 | 4334 | |
4046 | 4335 | begin |
4047 | 4336 | try |
4048 | - WriteLn('Testing SOMObject v', SOM_MajorVersion, '.', SOM_MinorVersion); | |
4049 | 4337 | SOM_MainProgram; |
4050 | 4338 | TestSOM_IR; |
4051 | 4339 | except |
@@ -1,4 +1,4 @@ | ||
1 | -InstanceSize, InitInstance and convert Create from class function to constructor | |
1 | +InstanceSize, InitInstance and others (conversion of Create to constructor is impossible due to AfterConstruction) | |
2 | 2 | implement Clone |
3 | 3 | map exceptions to proper types |
4 | 4 | array of const to vabuf and va_list in somDispatch |