[Instantobjects-cvscommit] SF.net SVN: instantobjects:[930] trunk/Source/Core/InstantCode.pas

[<na...@us...>]

Revision: 930
          http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=930&view=rev
Author:   nandod
Date:     2010-10-04 13:23:21 +0000 (Mon, 04 Oct 2010)

Log Message:
-----------
+ Support for class-level RTTI attributes in model files (meaning they are now ignored by the parser instead of raising Invalid class typecast exceptions).

Modified Paths:
--------------
    trunk/Source/Core/InstantCode.pas

Modified: trunk/Source/Core/InstantCode.pas
===================================================================
--- trunk/Source/Core/InstantCode.pas	2010-10-01 17:57:28 UTC (rev 929)
+++ trunk/Source/Core/InstantCode.pas	2010-10-04 13:23:21 UTC (rev 930)
@@ -495,12 +495,18 @@
   TInstantCodeContainerMethodFlag = (mfIndex, mfValue, mfResult);
   TInstantCodeContainerMethodFlags = set of TInstantCodeContainerMethodFlag;
 
-  TInstantCodeRttiAttribute = class(TInstantCodeMember)
+  TInstantCodeMemberRttiAttribute = class(TInstantCodeMember)
   protected
     class function InternalAtInstance(Reader: TInstantCodeReader; out Name: string): Boolean; override;
     procedure InternalRead(Reader: TInstantCodeReader); override;
   end;
 
+  TInstantCodeClassRttiAttribute = class(TInstantCodeType)
+  protected
+    class function InternalAtInstance(Reader: TInstantCodeReader; out Name: string): Boolean; override;
+    procedure InternalRead(Reader: TInstantCodeReader); override;
+  end;
+
   TInstantCodeAttributeTailor = class(TObject)
   private
     FAddMethod: TInstantCodeMethod;
@@ -2865,14 +2871,14 @@
     TInstantCodeField.AtInstance(Reader) or
     TInstantCodeMethod.AtInstance(Reader) or
     TInstantCodeProperty.AtInstance(Reader) or
-    TInstantCodeRttiAttribute.AtInstance(Reader);
+    TInstantCodeMemberRttiAttribute.AtInstance(Reader);
 end;
 
 procedure TInstantCodeMembers.InternalRead(Reader: TInstantCodeReader);
 begin
   ReadObjects(Reader,
     [TInstantCodeField, TInstantCodeMethod, TInstantCodeProperty,
-     TInstantCodeRttiAttribute]);
+     TInstantCodeMemberRttiAttribute]);
 end;
 
 procedure TInstantCodeMembers.InternalWrite(Writer: TInstantCodeWriter);
@@ -3294,10 +3300,8 @@
   FTypeLink.Name := Value;
 end;
 
-{ TInstantCodeRttiAttribute }
-
-class function TInstantCodeRttiAttribute.InternalAtInstance(
-  Reader: TInstantCodeReader; out Name: string): Boolean;
+function _RttiAttributeAtInstance(Reader: TInstantCodeReader;
+  out Name: string): Boolean;
 begin
   Result := Reader.ReadChar = '[';
   if Result then
@@ -3306,13 +3310,11 @@
     Name := '';
 end;
 
-procedure TInstantCodeRttiAttribute.InternalRead(Reader: TInstantCodeReader);
+procedure _RttiAttributeRead(Reader: TInstantCodeReader);
 var
   BracketCount: Integer;
   C: Char;
 begin
-  inherited;
-
   BracketCount := 0;
   repeat
     C := Reader.ReadChar;
@@ -3323,6 +3325,33 @@
   until BracketCount = 0;
 end;
 
+{ TInstantCodeMemberRttiAttribute }
+
+class function TInstantCodeMemberRttiAttribute.InternalAtInstance(
+  Reader: TInstantCodeReader; out Name: string): Boolean;
+begin
+  Result := _RttiAttributeAtInstance(Reader, Name);
+end;
+
+procedure TInstantCodeMemberRttiAttribute.InternalRead(Reader: TInstantCodeReader);
+begin
+  _RttiAttributeRead(Reader);
+end;
+
+{ TInstantCodeClassRttiAttribute }
+
+class function TInstantCodeClassRttiAttribute.InternalAtInstance(
+  Reader: TInstantCodeReader; out Name: string): Boolean;
+begin
+  Result := _RttiAttributeAtInstance(Reader, Name);
+end;
+
+procedure TInstantCodeClassRttiAttribute.InternalRead(
+  Reader: TInstantCodeReader);
+begin
+  _RttiAttributeRead(Reader);
+end;
+
 { TInstantCodeAttributeTailor }
 
 procedure TInstantCodeAttributeTailor.AddCountProp;
@@ -5795,7 +5824,7 @@
   ReadObjects(Reader, [TInstantCodeRecord, TInstantCodeClassRef,
     TInstantCodeClassForward, TInstantCodeClass, TInstantCodeInterface,
     TInstantCodeDispInterface, TInstantCodeEnum, TInstantCodeSet,
-    TInstantCodeTypeDef, TInstantCodeProcType, TInstantCodeRttiAttribute,
+    TInstantCodeTypeDef, TInstantCodeProcType, TInstantCodeClassRttiAttribute,
     TInstantCodeUnknownType]);
 end;