* Added test for iterating over all types in an application

git-svn-id: branches/joost/classattributes@25362 -

.gitattributes

@@ -11191,6 +11191,7 @@ tests/test/ttypedrecord1.pp svneol=native#text/plain
 tests/test/ttypedrecord2.pp svneol=native#text/plain
 tests/test/ttypedrecord3.pp svneol=native#text/plain
 tests/test/ttypedrecord4.pp svneol=native#text/plain
+tests/test/ttypinfo1.pp svneol=native#text/plain
 tests/test/tunaligned1.pp svneol=native#text/plain
 tests/test/tunistr1.pp svneol=native#text/plain
 tests/test/tunistr2.pp svneol=native#text/plain
@@ -11472,6 +11473,7 @@ tests/test/uprocext2.pp svneol=native#text/plain
 tests/test/urhlp14.pp svneol=native#text/pascal
 tests/test/urhlp17.pp svneol=native#text/pascal
 tests/test/utasout.pp svneol=native#text/plain
+tests/test/utypinfo1.pp svneol=native#text/plain
 tests/test/uunit1.pp svneol=native#text/plain
 tests/test/uunit2a.pp svneol=native#text/plain
 tests/test/uunit2b.pp svneol=native#text/plain

tests/test/ttypinfo1.pp

@@ -0,0 +1,61 @@
+program ttypinfo1;
+
+uses
+  utypinfo1,
+  typinfo;
+
+var
+  i,j: integer;
+  UnitInfo: PUnitInfo;
+  UnitList: PUnitInfoList;
+  ATypeInfo: PTypeInfo;
+  hasunit: boolean;
+  hastype1: boolean;
+  hastype2: boolean;
+  hastype3: boolean;
+
+begin
+  hasunit:=false;
+  hastype1:=false;
+  hastype2:=false;
+  hastype3:=false;
+  UnitList:=GetUnitList;
+  if UnitList^.UnitCount < 2 then
+    Halt(1);
+
+  for i := 0 to UnitList^.UnitCount-1 do
+    begin
+      UnitInfo:=UnitList^.Units[i];
+      if UnitInfo^.UnitName = 'utypinfo1' then
+        begin
+          hasunit:=true;
+          ATypeInfo:=GetFirstTypeinfoFromUnit(UnitInfo);
+          if ATypeInfo^.Name <> 'TRec' then
+            halt(2);
+          if Assigned(GetNextTypeInfo(ATypeInfo)) then
+            halt(3);
+        end;
+
+      if UnitInfo^.UnitName = 'System' then
+        begin
+          ATypeInfo:=GetFirstTypeinfoFromUnit(UnitInfo);
+          while assigned(ATypeInfo) do
+            begin
+              if ATypeInfo^.Name='ShortInt' then
+                hastype1:=True;
+              if ATypeInfo^.Name='TVarRec' then
+                hastype2:=True;
+              if ATypeInfo^.Name='TResourceManager' then
+                hastype3:=True;
+              ATypeInfo:=GetNextTypeInfo(ATypeInfo);
+            end;
+        end;
+    end;
+
+  if not hasunit then
+    halt(4);
+  if not hastype1 or not hastype2 or not hastype3 then
+    halt(5);
+  writeln('ok');
+end.
+

tests/test/utypinfo1.pp

@@ -0,0 +1,16 @@
+unit utypinfo1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  TRec = record
+    a: integer;
+    b: integer;
+  end;
+
+implementation
+
+end.
+