{ This file is part of the Free Component Library (FCL) Copyright (c) 2025 Michael Van Canneyt (michael@freepascal.org) Test WIT parser See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} unit utcwitparser; interface // uncomment this to show parsed WIT content } { $DEFINE LOGPARSEDCONTENT} uses fpcunit, testregistry, Classes, SysUtils, WIT.Scanner, WIT.Model, WIT.Parser; type TResultIgnore = (riResult,riError); TResultIgnores = set of TResultIgnore; { TTestWITParser } TTestWITParser = class(TTestCase) private FScanner: TWITScanner; FParser: TWITParser; FDocument: TWITDocument; FInputStream: TStringStream; protected procedure SetUp; override; procedure TearDown; override; procedure InitParser(const aContent: string); class function AssertListType(const aMsg: string; aTypeDef: TWitTypeDef;const aName: String; aElementKind: TWITTypeKind; aCount : Integer = 0): TWitType; class function AssertEnumType(const aMsg: String; aType: TWITTypeDef;const aName: String; aValues: array of string) : TWITEnumType; class function AssertResultType(const aMsg: string; aType: TWITTypeDef;const aName: String; aOKKind: TWITTypeKind; aErrorKind: TWitTypeKind; aIgnore: TResultIgnores) : TWITResultType; class function AssertOptionType(const aMsg: string; aType: TWITTypeDef;const aName: String; aOptionKind: TWITTypeKind) : TWITOptionType; class function AssertStreamType(const aMsg: string; aType: TWITTypeDef;const aName: String; aStreamKind: TWITTypeKind): TWITStreamType; class function AssertFutureType(const aMsg: string; aType: TWITTypeDef;const aName: String; aFutureKind: TWITTypeKind): TWITFutureType; class function AssertTupleType(const aMsg: string; aType: TWITTypeDef;const aName: String; aOptionKind: Array of TWITTypeKind) : TWITTupleType; class function AssertFlagsType(const aMsg: string; aType: TWITTypeDef;const aName: String; aFlagNames: Array of String) : TWITFlagsType; class function AssertVariantType(const aMsg: string; aType: TWITTypeDef;const aName: String; aVariantNames: array of String): TWITVariantType; class function AssertRecordType(const aMsg: string; aType: TWITTypeDef;const aName: String; aFieldNames: array of String; aFieldTypes : Array of TWITTypeKind): TWITRecordType; class function AssertResourceType(const aMsg: string; aType: TWITTypeDef;const aName: String; aConstructor: boolean; aFunctionNames: array of String): TWITResourceType; class function AssertAliasType(const aMsg: string; aType: TWITTypeDef;const aName: String; aAliasName:String): TWITIdentifierType; class function AssertHandleType(const aMsg: string; aType: TWITTypeDef;const aName: String; aAliasName:String): TWITHandleType; class function AssertTypeDef(const Msg: String; aType: TWITType; aExpectedName: string; aExpectedUnderlyingKind: TWITTypeKind) : TWITType; class procedure AssertAnnotationArgument(const Msg: String; aArgument: TWITAnnotationArgument; aName, aValue: string); class procedure AssertAnnotation(const Msg: String; aAnnotation: TWITAnnotation;const aName: String; Args: array of String); class procedure AssertInclude(const aMsg: string; aInclude: TWITInclude;const aName: String; aItemNames, aItemAliases: array of String); class procedure AssertFunction(const Msg: String; aFunc: TWITFunction;const aName: String; aArgCount: Integer; aHaveResult: Boolean; aAnnotationCount: Integer = 0); class procedure AssertFunctionParam(const Msg: String; aParam: TWITFuncParam;const aName: String; aTypeKind: TWITTypeKind; aTypeName: string); class procedure AssertInterface(const Msg: String; aIntf: TWITInterface;const aName: String; aFuncCount: Integer; aTypeCount : Integer; aAnnotationCount: Integer = 0); class procedure AssertWorld(const Msg : String; aWorld :TWITWorld; const aWorldName : String; aExportCount,aImportCount,aUseCount,aTypeDefCount,aIncludeCount : Integer); class procedure AssertEquals(Msg: string; aExpected, aActual: TWitTypeKind); overload; class procedure AssertUse(Msg: string; aUse : TWITTopLevelUse; const aPackageName, aVersion, aIdentifier, aRename: string; aNameSpaces : Array of string); class procedure AssertUsePath(Msg: string; aUse: TWITUsePath; const aPackageName, aVersion, aIdentifier: string; aNameSpaces: array of string); class procedure AssertPackage(const Msg: String; aPackage: TWITPackage; aExpectedNamespace: string; aExpectedPackageName: string; aExpectedVersion: string; aExpectedWorldCount: Integer=0; aExpectedImportCount: Integer=0; aExpectedExportCount: Integer=0; aExpectedUseCount: Integer=0; aExpectedInterfaceCount: Integer=0); Protected function ParseWorld(const aWorldName : String; aExportCount,aImportCount,aUseCount,aTypeDefCount,aIncludeCount : Integer) : TWITWorld; function ParseFunc(const aFuncName: String; aArgNames : Array of string; aArgTypes : Array of TWitTypeKind; aResultType : TWitTypeKind = wtVoid): TWITFunction; function ParseType(const aInterFaceName, aTypeName: String): TWITTypeDef; function ParseInterface(const aName: String; aFunctionCount, aTypeCount, aAnnotationCount: integer): TWITInterface; function WrapTypeDef(const aDef: String; isType : Boolean = false): string; function WrapFunc(const aParams: String; aResult : string = ''): string; published procedure TestParsePackageEmpty; procedure TestParseExitInterfaceDocument; procedure TestParsePackageVersions; procedure TestSimpleTypes; procedure TestListType; procedure TestListListType; procedure TestListSized; procedure TestListSizedListSized; procedure TestEnum; procedure TestEnumEndWithComma; procedure TestResultEmpty; procedure TestResultOneType; procedure TestResultTwoTypes; procedure TestResultOneIgnoredTyoe; procedure TestOption; procedure TestStream; procedure TestStreamEmpty; procedure TestFuture; procedure TestNestedFuture; procedure TestFutureEmpty; procedure TestTupleEmpty; procedure TestTuple1; procedure TestTuple2; procedure TestTuple3; procedure TestTupleComma; procedure TestFlagsEmpty; procedure TestFlags1; procedure TestFlags2; procedure TestFlags3; procedure TestFlagsComma; procedure TestVariant1; procedure TestVariant2; procedure TestVariant2Comma; procedure TestVariantTypedSimple; procedure TestVariantTypedSimpleComma; procedure TestVariantTypedComplex; procedure TestRecordEmpty; procedure TestRecord1; procedure TestRecord2; procedure TestRecord2Comma; procedure TestRecordRecordName; procedure TestAlias; procedure TestBorrowedHandle; procedure TestResourceEmpty; procedure TestResourceEmpty2; procedure TestResourceConstructor; procedure TestResourceOneMethod; procedure TestResourceStaticMethod; procedure TestResourceAsyncMethod; procedure TestResourceTwoMethods; procedure TestResourceOneMethodAndConstructor; procedure TestUseIdentifier; procedure TestUseIdentifierAs; procedure TestUseFullIdentifier; procedure TestUseFullIdentifierVersion; procedure TestUseFullIdentifierAs; procedure TestUseFullIdentifierVersionAs; procedure TestParseFunctionEmpty; procedure TestParseFunctionEmptyResult; procedure TestParseFunctionOneParam; procedure TestParseFunctionOneParamResult; procedure TestParseFunctionTwoParams; procedure TestParseFunctionTwoParamsResult; procedure TestParseWorldEmpty; procedure TestParseWorldUse; procedure TestParseWorldUseAnnotation; procedure TestParseWorldExport; procedure TestParseWorldExportUse; procedure TestParseWorldExportFunction; procedure TestParseWorldExportInterface; procedure TestParseWorldImport; procedure TestParseWorldImportUse; procedure TestParseWorldImportFunction; procedure TestParseWorldImportInterface; procedure TestParseWorldInclude; procedure TestParseWorldIncludeUse; procedure TestParseWorldIncludeUseList; procedure TestParseWorldIncludeUseList2; procedure TestParseWorldTypeDef; procedure TestParseWorldEnumType; procedure TestParseWorldVariantType; procedure TestParseWorldRecordType; procedure TestParseWorldFlagsType; procedure TestParseInterfaceUse; procedure TestParseInterfaceUseGate; end; implementation uses TypInfo; { TTestWITParser } procedure TTestWITParser.InitParser(const aContent : string); begin FreeAndNil(FDocument); FreeAndNil(FInputStream); {$IFDEF LOGPARSEDCONTENT} Writeln(TestName,' - Parsing:'); Writeln(aContent); {$ENDIF} FInputStream := TStringStream.Create(aContent); // Assuming TWITScanner.Create(AStream: TStream); // If TWITScanner has a different constructor (e.g., taking ownership of stream), adjust accordingly. FreeAndNil(FScanner); FScanner := TWITScanner.Create(FInputStream); FreeAndNil(FParser); FParser := TWITParser.Create(FScanner); end; procedure TTestWITParser.SetUp; begin inherited SetUp; FreeAndNil(FDocument); // Freeing nil is safe FreeAndNil(FParser); FreeAndNil(FScanner); // Assuming scanner does not own the stream, or handles it. FreeAndNil(FInputStream); end; procedure TTestWITParser.TearDown; begin FreeAndNil(FDocument); // Freeing nil is safe FreeAndNil(FParser); FreeAndNil(FScanner); // Assuming scanner does not own the stream, or handles it. FreeAndNil(FInputStream); inherited TearDown; end; function TTestWITParser.WrapTypeDef(const aDef: String; isType: Boolean): string; const WIT_CONTENT = 'interface types {' + sLineBreak + ' %s' + sLineBreak + '}'; begin Result:=aDef; if isType then Result:='type a = '+Result+';'; Result:=Format(WIT_CONTENT,[Result]); end; function TTestWITParser.WrapFunc(const aParams: String; aResult: string): string; const WIT_CONTENT = 'interface funcs {' + sLineBreak + ' %s' + sLineBreak + '}'; var lWIT : String; begin lWIT:='a : func ('+aParams+')'; if (aResult<>'') then lWIT:=lWIT+' -> '+aResult; lWIT:=lWIT+';'; Result:=Format(WIT_CONTENT,[lWIT]); end; class procedure TTestWITParser.AssertEquals(Msg: string; aExpected, aActual: TWitTypeKind); begin AssertEquals(Msg,GetEnumName(TypeInfo(TWitTypeKind),ord(aExpected)), GetEnumName(TypeInfo(TWitTypeKind),ord(aActual))); end; class procedure TTestWITParser.AssertUsePath(Msg: string; aUse: TWITUsePath; const aPackageName, aVersion, aIdentifier: string; aNameSpaces: array of string); var I : Integer; begin AssertEquals(Msg+': PackageName',aPackageName,aUse.PackageName); AssertEquals(Msg+': Version',aVersion,aUse.Version); AssertEquals(Msg+': Identifier',aIdentifier,aUse.Identifier); AssertEquals(Msg+': Namespace count',Length(aNameSpaces),aUse.Namespaces.Count); For I:=0 to Length(aNamespaces)-1 do AssertEquals(Msg+Format(': namespace[%d]',[i]),aNameSpaces[i],aUse.Namespaces[i]); end; class procedure TTestWITParser.AssertUse(Msg: string; aUse: TWITTopLevelUse; const aPackageName, aVersion, aIdentifier, aRename: string; aNameSpaces: array of string); begin AssertNotNull(Msg+': Have use',aUse); AssertUsePath(Msg+': Path',aUse.Path,aPackageName,aVersion,aIdentifier,aNameSpaces); AssertEquals(Msg+': Rename',aRename,aUse.Rename); end; class procedure TTestWITParser.AssertAnnotationArgument(const Msg : String; aArgument : TWITAnnotationArgument; aName,aValue : string); begin AssertNotNull(Msg+': Have argument',aArgument); AssertEquals(Msg+': name',aName,aArgument.Member); AssertEquals(Msg+': value',aValue,aArgument.Value); end; class procedure TTestWITParser.AssertAnnotation(const Msg: String; aAnnotation: TWITAnnotation;const aName: String; Args: array of String); var I : Integer; begin AssertNotNull(Msg+': Have annotation',aAnnotation); AssertEquals(Msg+': name',aName,aAnnotation.Name); AssertEquals(Msg+': Arg count',aAnnotation.Arguments.Count,Length(Args) div 2); I:=0; While (I), } *) procedure TTestWITParser.TestVariantTypedSimple; const WIT_CONTENT = 'variant a { a, b(u32) }'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertVariantType('Variant type',LTypeDef,'a',['a','b']); end; procedure TTestWITParser.TestVariantTypedSimpleComma; const WIT_CONTENT = 'variant a { a, b(u32), }'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertVariantType('Variant type',LTypeDef,'a',['a','b']); end; procedure TTestWITParser.TestVariantTypedComplex; const WIT_CONTENT = 'variant a { a, b(option) }'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertVariantType('Variant type',LTypeDef,'a',['a','b']); end; procedure TTestWITParser.TestRecordEmpty; const WIT_CONTENT = 'record a {}'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertRecordType('Record type',LTypeDef,'a',[],[]); end; procedure TTestWITParser.TestRecord1; const WIT_CONTENT = 'record a { a: u32 }'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertRecordType('Record type',LTypeDef,'a',['a'],[wtU32]); end; procedure TTestWITParser.TestRecord2; const WIT_CONTENT = 'record a { a: u32, b: u64 }'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertRecordType('Record type',LTypeDef,'a',['a','b'],[wtU32,wtU64]); end; procedure TTestWITParser.TestRecord2Comma; const WIT_CONTENT = 'record a { a: u32, b: u64, }'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertRecordType('Record type',LTypeDef,'a',['a','b'],[wtU32,wtU64]); end; procedure TTestWITParser.TestRecordRecordName; const WIT_CONTENT = 'record %record { a: u32, b: u64, }'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','record'); AssertRecordType('Record type',LTypeDef,'record',['a','b'],[wtU32,wtU64]); end; procedure TTestWITParser.TestAlias; const WIT_CONTENT = 'b'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT,True)); LTypeDef:=ParseType('types','a'); AssertAliasType('Alias type',LTypeDef,'a','b'); end; procedure TTestWITParser.TestBorrowedHandle; const WIT_CONTENT = 'borrow'; var LTypeDef : TWITTypeDef; lIdent : TWITHandleType; begin InitParser(WrapTypeDef(WIT_CONTENT,True)); LTypeDef:=ParseType('types','a'); lIdent:=AssertHandleType(' type',LTypeDef,'a','b'); AssertTrue('Borrowed',lIdent.Borrowed); end; procedure TTestWITParser.TestResourceEmpty; const WIT_CONTENT = 'resource a;'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertResourceType('Resource type',LTypeDef,'a',false, []); end; procedure TTestWITParser.TestResourceEmpty2; const WIT_CONTENT = 'resource a {}'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertResourceType('Resource type',LTypeDef,'a',false, []); end; procedure TTestWITParser.TestResourceConstructor; const WIT_CONTENT = 'resource a { constructor (c:u8); }'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertResourceType('Resource type',LTypeDef,'a',true, ['a']); end; procedure TTestWITParser.TestResourceOneMethod; const WIT_CONTENT = 'resource a { write : func (c:u8); }'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertResourceType('Resource type',LTypeDef,'a',true, ['write']); end; procedure TTestWITParser.TestResourceStaticMethod; const WIT_CONTENT = 'resource a { write : static func (c:u8); }'; var LTypeDef : TWITTypeDef; lRes : TWITResourceType; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); lRes:=AssertResourceType('Resource type',LTypeDef,'a',true, ['write']); AssertTrue('Function marked static',(ffStatic in lRes.Functions[0].TypeDef.Flags)); end; procedure TTestWITParser.TestResourceAsyncMethod; const WIT_CONTENT = 'resource a { write : async func (c:u8); }'; var LTypeDef : TWITTypeDef; lRes : TWITResourceType; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); lRes:=AssertResourceType('Resource type',LTypeDef,'a',true, ['write']); AssertTrue('Function marked static',(ffAsync in lRes.Functions[0].TypeDef.Flags)); end; procedure TTestWITParser.TestResourceTwoMethods; const WIT_CONTENT = 'resource a { '+sLineBreak+ ' read : func (c:u8) -> list; '+sLineBreak+ ' write : func (c : list); '+sLineBreak+ '}'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertResourceType('Resource type',LTypeDef,'a',false, ['read','write']); end; procedure TTestWITParser.TestResourceOneMethodAndConstructor; const WIT_CONTENT = 'resource a { '+sLineBreak+ ' read : func (c:u8) -> list; '+sLineBreak+ ' constructor (c : list); '+sLineBreak+ '}'; var LTypeDef : TWITTypeDef; begin InitParser(WrapTypeDef(WIT_CONTENT)); LTypeDef:=ParseType('types','a'); AssertResourceType('Resource type',LTypeDef,'a',true, ['read','a']); end; procedure TTestWITParser.TestUseIdentifier; const WIT_CONTENT = 'use a;'; var lUse : TWITTopLevelUse; begin InitParser(WIT_CONTENT); FDocument := FParser.ParseDocument; AssertEquals('Uses count', 1, FDocument.UseStatements.Count); lUse:=FDocument.UseStatements[0]; AssertUse('Simple use',lUse,'','','a','',[]); end; procedure TTestWITParser.TestUseIdentifierAs; const WIT_CONTENT = 'use a as b;'; var lUse : TWITTopLevelUse; begin InitParser(WIT_CONTENT); FDocument := FParser.ParseDocument; AssertEquals('Uses count', 1, FDocument.UseStatements.Count); lUse:=FDocument.UseStatements[0]; AssertUse('Simple use',lUse,'','','a','b',[]); end; procedure TTestWITParser.TestUseFullIdentifier; const WIT_CONTENT = 'use d:c/a;'; var lUse : TWITTopLevelUse; begin InitParser(WIT_CONTENT); FDocument := FParser.ParseDocument; AssertEquals('Uses count', 1, FDocument.UseStatements.Count); lUse:=FDocument.UseStatements[0]; AssertUse('Full use',lUse,'c','','a','',['d']); end; procedure TTestWITParser.TestUseFullIdentifierVersion; const WIT_CONTENT = 'use d:c/a@1.1.1;'; var lUse : TWITTopLevelUse; begin InitParser(WIT_CONTENT); FDocument := FParser.ParseDocument; AssertEquals('Uses count', 1, FDocument.UseStatements.Count); lUse:=FDocument.UseStatements[0]; AssertUse('Full use',lUse,'c','1.1.1','a','',['d']); end; procedure TTestWITParser.TestUseFullIdentifierAs; const WIT_CONTENT = 'use d:c/a as b;'; var lUse : TWITTopLevelUse; begin InitParser(WIT_CONTENT); FDocument := FParser.ParseDocument; AssertEquals('Uses count', 1, FDocument.UseStatements.Count); lUse:=FDocument.UseStatements[0]; AssertUse('Full use',lUse,'c','','a','b',['d']); end; procedure TTestWITParser.TestUseFullIdentifierVersionAs; const WIT_CONTENT = 'use d:c/a@1.1.1 as b;'; var lUse : TWITTopLevelUse; begin InitParser(WIT_CONTENT); FDocument := FParser.ParseDocument; AssertEquals('Uses count', 1, FDocument.UseStatements.Count); lUse:=FDocument.UseStatements[0]; AssertUse('Full use',lUse,'c','1.1.1','a','b',['d']); end; procedure TTestWITParser.TestParseFunctionEmpty; const WIT_CONTENT = ''; begin InitParser(WrapFunc(WIT_CONTENT)); ParseFunc('a',[],[],wtVoid); end; procedure TTestWITParser.TestParseFunctionEmptyResult; const WIT_CONTENT = ''; begin InitParser(WrapFunc(WIT_CONTENT,'u8')); ParseFunc('a',[],[],wtU8); end; procedure TTestWITParser.TestParseFunctionOneParam; const WIT_CONTENT = 'b:u8'; begin InitParser(WrapFunc(WIT_CONTENT)); ParseFunc('a',['b'],[wtU8],wtVoid); end; procedure TTestWITParser.TestParseFunctionOneParamResult; const WIT_CONTENT = 'b:u8'; begin InitParser(WrapFunc(WIT_CONTENT,'u32')); ParseFunc('a',['b'],[wtU8],wtU32); end; procedure TTestWITParser.TestParseFunctionTwoParams; const WIT_CONTENT = 'b : u8, c : list'; begin InitParser(WrapFunc(WIT_CONTENT)); ParseFunc('a',['b','c'],[wtU8, wtList],wtVoid); end; procedure TTestWITParser.TestParseFunctionTwoParamsResult; const WIT_CONTENT = 'b : u8, c : list'; begin InitParser(WrapFunc(WIT_CONTENT,'result<_,u32>')); ParseFunc('a',['b','c'],[wtU8, wtList],wtResult); end; procedure TTestWITParser.TestParseWorldEmpty; const WIT_CONTENT = 'world a {}'; begin InitParser(WIT_CONTENT); ParseWorld('a',0,0,0,0,0); end; procedure TTestWITParser.TestParseWorldUse; const WIT_CONTENT = 'world a { use b.{c}; }'; var lWorld : TWITWorld; lUse : TWITUse; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,0,1,0,0); lUse:=lWorld.UsesList[0]; AssertEquals('Export name','b',lUse.Path.Identifier); end; procedure TTestWITParser.TestParseWorldUseAnnotation; const WIT_CONTENT = 'world a { @since(version = 1.1.1) use b.{c}; }'; var lWorld : TWITWorld; lUse : TWITUse; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,0,1,0,0); lUse:=lWorld.UsesList[0]; AssertEquals('Export name','b',lUse.Path.Identifier); AssertEquals('Have annotation',1,lUse.Annotations.Count); AssertEquals('since annotation','since',lUse.Annotations[0].Name); end; procedure TTestWITParser.TestParseWorldExport; const WIT_CONTENT = 'world a { export b; }'; var lWorld : TWITWorld; lExport : TWITExchange; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',1,0,0,0,0); lExport:=lWorld.Exported[0]; AssertEquals('Export name','b',lExport.Name); end; procedure TTestWITParser.TestParseWorldExportUse; const WIT_CONTENT = 'world a { export b:c/d@3.3.1; }'; var lWorld : TWITWorld; lExport : TWITExchange; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',1,0,0,0,0); lExport:=lWorld.Exported[0]; AssertEquals('Export name','b:c/d@3.3.1',lExport.Name); end; procedure TTestWITParser.TestParseWorldExportFunction; const WIT_CONTENT = 'world a { export b:func (c:u32) ; }'; var lWorld : TWITWorld; lExport : TWITExchange; lExportFunc : TWITExchangeFunc absolute lExport; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',1,0,0,0,0); lExport:=lWorld.Exported[0]; AssertEquals('Export name','b',lExport.Name); AssertEquals('export class',TWITExchangeFunc,lExport.ClassType); AssertNotNull('export typedef',lExportFunc.TypeDef); end; procedure TTestWITParser.TestParseWorldExportInterface; const WIT_CONTENT = 'world a { export b:interface { c: func (d:u32) ; } }'; var lWorld : TWITWorld; lExport : TWITExchange; lExportIntf : TWITExchangeInterface absolute lExport; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',1,0,0,0,0); lExport:=lWorld.Exported[0]; AssertEquals('Export name','b',lExport.Name); AssertEquals('export class',TWITExchangeInterface,lExport.ClassType); AssertInterface('counts',lExportIntf.TypeDef,'b',1,0,0) end; procedure TTestWITParser.TestParseWorldImport; const WIT_CONTENT = 'world a { import b; }'; var lWorld : TWITWorld; lExport : TWITExchange; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,1,0,0,0); lExport:=lWorld.Imported[0]; AssertEquals('Import name','b',lExport.Name); end; procedure TTestWITParser.TestParseWorldImportUse; const WIT_CONTENT = 'world a { import b:c/d@3.3.1; }'; var lWorld : TWITWorld; lExport : TWITExchange; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,1,0,0,0); lExport:=lWorld.Imported[0]; AssertEquals('Export name','b:c/d@3.3.1',lExport.Name); end; procedure TTestWITParser.TestParseWorldImportFunction; const WIT_CONTENT = 'world a { import b:func (c:u32) ; }'; var lWorld : TWITWorld; lExport : TWITExchange; lExportFunc : TWITExchangeFunc absolute lExport; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,1,0,0,0); lExport:=lWorld.Imported[0]; AssertEquals('Export name','b',lExport.Name); AssertEquals('export class',TWITExchangeFunc,lExport.ClassType); AssertNotNull('export typedef',lExportFunc.TypeDef); end; procedure TTestWITParser.TestParseWorldImportInterface; const WIT_CONTENT = 'world a { import b:interface { c: func (d:u32) ; } }'; var lWorld : TWITWorld; lExport : TWITExchange; lExportIntf : TWITExchangeInterface absolute lExport; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,1,0,0,0); lExport:=lWorld.Imported[0]; AssertEquals('Export name','b',lExport.Name); AssertEquals('export class',TWITExchangeInterface,lExport.ClassType); AssertInterface('counts',lExportIntf.TypeDef,'b',1,0,0) end; procedure TTestWITParser.TestParseWorldInclude; const WIT_CONTENT = 'world a { include b; }'; var lWorld : TWITWorld; lInclude : TWITInclude; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,0,0,0,1); lInclude:=lWorld.Includes[0]; AssertInclude('First',lInclude,'b',[],[]); end; procedure TTestWITParser.TestParseWorldIncludeUse; const WIT_CONTENT = 'world a { include b:c/d; }'; var lWorld : TWITWorld; lInclude : TWITInclude; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,0,0,0,1); lInclude:=lWorld.Includes[0]; AssertInclude('First',lInclude,'b:c/d',[],[]); end; procedure TTestWITParser.TestParseWorldIncludeUseList; const WIT_CONTENT = 'world a { include b:c/d with { e as f } }'; var lWorld : TWITWorld; lInclude : TWITInclude; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,0,0,0,1); lInclude:=lWorld.Includes[0]; AssertInclude('First',lInclude,'b:c/d',['e'],['f']); end; procedure TTestWITParser.TestParseWorldIncludeUseList2; const WIT_CONTENT = 'world a { include b:c/d with { e as f, g as h } }'; var lWorld : TWITWorld; lInclude : TWITInclude; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,0,0,0,1); lInclude:=lWorld.Includes[0]; AssertInclude('First',lInclude,'b:c/d',['e','g'],['f','h']); end; procedure TTestWITParser.TestParseWorldTypeDef; const WIT_CONTENT = 'world a { type x = u32; }'; var lWorld : TWITWorld; lType : TWITTypeDef; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,0,0,1,0); lType:=lWorld.TypeDefs[0]; AssertTypeDef('type',lType,'x',wtU32); end; procedure TTestWITParser.TestParseWorldEnumType; const WIT_CONTENT = 'world a { enum x {y,z} }'; var lWorld : TWITWorld; lType : TWITTypeDef; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,0,0,1,0); lType:=lWorld.TypeDefs[0]; AssertEnumType('type',lType,'x',['y','z']); end; procedure TTestWITParser.TestParseWorldVariantType; const WIT_CONTENT = 'world a { variant x { y, z} }'; var lWorld : TWITWorld; lType : TWITTypeDef; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,0,0,1,0); lType:=lWorld.TypeDefs[0]; AssertVariantType('type',lType,'x',['y','z']); end; procedure TTestWITParser.TestParseWorldRecordType; const WIT_CONTENT = 'world a { record x { y: u32, z: u8} }'; var lWorld : TWITWorld; lType : TWITTypeDef; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,0,0,1,0); lType:=lWorld.TypeDefs[0]; AssertRecordType('type',lType,'x',['y','z'],[wtu32,wtu8]); end; procedure TTestWITParser.TestParseWorldFlagsType; const WIT_CONTENT = 'world a { flags x { y, z} }'; var lWorld : TWITWorld; lType : TWITTypeDef; begin InitParser(WIT_CONTENT); lWorld:=ParseWorld('a',0,0,0,1,0); lType:=lWorld.TypeDefs[0]; AssertFlagsType('type',lType,'x',['y','z']); end; procedure TTestWITParser.TestParseInterfaceUse; const WIT_CONTENT = 'interface a { use b.{c}; }'; begin InitParser(WIT_CONTENT); FDocument := FParser.ParseDocument; AssertNotNull('Have package', FDocument.DefaultPackage); AssertEquals('Interface count.', 1, FDocument.Interfaces.Count); AssertEquals('Use count.', 1, FDocument.Interfaces[0].UseList.Count); end; procedure TTestWITParser.TestParseInterfaceUseGate; const WIT_CONTENT = 'interface a { @since (version = 1.1.1) use b.{c}; }'; begin InitParser(WIT_CONTENT); FDocument := FParser.ParseDocument; AssertNotNull('Have package', FDocument.DefaultPackage); AssertEquals('Interface count.', 1, FDocument.Interfaces.Count); AssertEquals('Use count.', 1, FDocument.Interfaces[0].UseList.Count); AssertEquals('Use annotation count.', 1, FDocument.Interfaces[0].UseList[0].Annotations.Count); end; procedure TTestWITParser.TestParsePackageEmpty; const WIT_CONTENT = 'package foo:empty;'; var LPackage: TWITPackage; begin InitParser(WIT_CONTENT); FDocument := FParser.ParseDocument; AssertNotNull('Have package', FDocument.DefaultPackage); AssertEquals('Interface count.', 0, FDocument.Interfaces.Count); AssertEquals('World count.', 0, FDocument.Worlds.Count); LPackage := FDocument.DefaultPackage; AssertPackage('Parsed package "foo:empty"', LPackage, 'foo', 'empty', '', 0, 0, 0, 0, 0); end; procedure TTestWITParser.TestParsePackageVersions; const ScenarioCount = 9; Scenarios : array [1..ScenarioCount] of string = ( 'package a:b@1.0.0 {}', 'package a:b@1.0.1 {}', 'package a:b@1.0.1-- {}', 'package a:b@1.0.1-a+a {}', 'package a:b@1.0.1-1+1 {}', 'package a:b@1.0.1-1a+1a {}', 'package a:b@1.0.0-11-a {}', 'package a:b@1.0.0-a1.1-a {}', 'package a:b@1.0.0-11ab {}' ); var I,p : Integer; lScenario, lVersion : string; lMessage : String; begin For I:=1 to ScenarioCount do begin lScenario:=Scenarios[i]; P:=Pos('@',lScenario); lVersion:=Copy(lScenario,P+1,pos('{',lScenario)-2-P); lMessage:=Format('Scenario[%d] "%s": ',[i,lScenario]); InitParser(lScenario); try FDocument:=FParser.ParseDocument; except on E : Exception do Fail('Exception %s during scenario %s: "%s"',[E.ClassName,lMessage,E.Message]); end; AssertEquals('Have package ',1,FDocument.Packages.Count); AssertPackage(lMessage,FDocument.Packages[0],'a','b',lVersion) end; end; initialization RegisterTest(TTestWITParser); end.