From 45895f26e04cfc6ede77b54c01443eb52f3e2aed Mon Sep 17 00:00:00 2001 From: yury Date: Wed, 15 May 2013 14:17:34 +0000 Subject: [PATCH] * pas2jni: use stable JSON output from ppudump. git-svn-id: trunk@24510 - --- utils/pas2jni/ppuparser.pas | 956 ++++++++++++++---------------------- 1 file changed, 365 insertions(+), 591 deletions(-) diff --git a/utils/pas2jni/ppuparser.pas b/utils/pas2jni/ppuparser.pas index a4dcb8ca2a..ebfcd6ef7b 100644 --- a/utils/pas2jni/ppuparser.pas +++ b/utils/pas2jni/ppuparser.pas @@ -37,7 +37,7 @@ type private FOnCheckItem: TOnCheckItem; function FindUnit(const AName: string): string; - procedure ReadUnit(const AName: string; Lines: TStrings); + function ReadUnit(const AName: string): string; function InternalParse(const AUnitName: string): TUnitDef; public SearchPath: TStringList; @@ -54,7 +54,7 @@ var implementation -uses process, pipes; +uses process, pipes, fpjson, jsonparser; type TCharSet = set of char; @@ -166,11 +166,25 @@ begin raise Exception.CreateFmt('Unable to find PPU file for unit "%s".', [AName]); end; -procedure TPPUParser.ReadUnit(const AName: string; Lines: TStrings); +function TPPUParser.ReadUnit(const AName: string): string; + + procedure _ReadOutput(o: TInputPipeStream; var s: string); + var + i, j: integer; + begin + with o do + while NumBytesAvailable > 0 do begin + i:=NumBytesAvailable; + j:=Length(s); + SetLength(s, j + i); + ReadBuffer(s[j + 1], i); + end; + end; + var p: TProcess; - s, un: ansistring; - i, j: integer; + s, un, err: ansistring; + ec: integer; begin un:=FindUnit(AName); p:=TProcess.Create(nil); @@ -186,8 +200,9 @@ begin end; end; p.Executable:=ppudumpprog; + p.Parameters.Add('-Fj'); p.Parameters.Add(un); - p.Options:=[poUsePipes, poNoConsole, poStderrToOutPut]; + p.Options:=[poUsePipes, poNoConsole]; p.ShowWindow:=swoHIDE; p.StartupOptions:=[suoUseShowWindow]; try @@ -196,329 +211,353 @@ begin raise Exception.CreateFmt('Unable to run "%s".'+LineEnding+'%s', [p.Executable, Exception(ExceptObject).Message]); end; s:=''; + err:=''; repeat - with p.Output do - while NumBytesAvailable > 0 do begin - i:=NumBytesAvailable; - j:=Length(s); - SetLength(s, j + i); - ReadBuffer(s[j + 1], i); - end; + _ReadOutput(p.Output, s); + _ReadOutput(p.Stderr, err); until not p.Running; - if p.ExitStatus <> 0 then begin - if Length(s) > 300 then - s:=''; - raise Exception.CreateFmt('Error reading contents of unit "%s" using "%s".'+LineEnding+'Error code: %d'+LineEnding+'%s', [un, ppudumpprog, p.ExitStatus, s]); + ec:=p.ExitStatus; + if Copy(s, 1, 1) <> '[' then begin + ec:=-1; + err:='Output of ppudump is not in JSON format.' + LineEnding + 'Probably old version of ppudump has been used.'; + end; + if ec <> 0 then begin + if err = '' then + if Length(s) < 300 then + err:=s; + raise Exception.CreateFmt('Error reading contents of unit "%s" using "%s".'+LineEnding+'Error code: %d'+LineEnding+'%s', [un, ppudumpprog, ec, err]); end; finally p.Free; end; - Lines.Text:=s; + Result:=s; {$ifopt D+} // Lines.SaveToFile(AName + '-dump.txt'); {$endif} end; -const - LInc = 4; - SDefId = '** Definition Id '; - SSymId = '** Symbol Id '; - function TPPUParser.InternalParse(const AUnitName: string): TUnitDef; var - FLines: TStringList; + junit: TJSONObject; + jp: TJSONParser; deref: array of TUnitDef; CurUnit: TUnitDef; - CurDef: TDef; - level, skiplevel: integer; IsSystemUnit: boolean; AMainUnit: boolean; + CurObjName: string; - function _ThisLevel(const s: string): boolean; + function _GetRef(Ref: TJSONObject; ExpectedClass: TDefClass = nil): TDef; var - i: integer; - begin - Result:=True; - if (level = 1) or (Length(s) < level - LInc) then - exit; - if s[1] = '-' then begin - Result:=False; - exit; - end; - i:=level; - repeat - Dec(i, LInc); - if Copy(s, i, 3) = '** ' then begin - Result:=False; - exit; - end; - until i = 1; - end; - - function _GetDef(const Path: string; ExpectedClass: TDefClass = nil): TDef; - var - s, ss: string; - i, j: integer; + j: integer; u: TUnitDef; begin Result:=nil; + if Ref = nil then + exit; u:=CurUnit; - s:=Trim(Path); - if Copy(s, 1, 1) = '(' then begin - i:=Pos(') ', s); - if i > 0 then - Delete(s, 1, i + 1); - end; - i:=1; - while True do begin - ss:=Trim(ExtractWord(i, s, [','])); - if ss = '' then - break; - if Pos('Unit', ss) = 1 then begin - j:=StrToInt(Copy(ss, 6, MaxInt)); - u:=deref[j]; - if u.DefType = dtNone then begin - // Reading unit - u:=InternalParse(LowerCase(u.Name)); - if u = nil then - exit; - if u.CPU <> CurUnit.CPU then - raise Exception.CreateFmt('Invalid target CPU of unit "%s": %s', [u.Name, u.CPU]); - if u.OS <> CurUnit.OS then - raise Exception.CreateFmt('Invalid target OS of unit "%s": %s', [u.Name, u.OS]); - if u.PPUVer <> CurUnit.PPUVer then - raise Exception.CreateFmt('Invalid PPU version of unit "%s": %s', [u.Name, u.PPUVer]); - deref[j].Free; - deref[j]:=u; - end; - end - else - if Pos('DefId', ss) = 1 then begin - j:=StrToInt(Copy(ss, 7, MaxInt)); - Result:=u.FindDef(j); - if Result = nil then begin - if ExpectedClass <> nil then - Result:=ExpectedClass.Create(u, dtNone) - else - Result:=TDef.Create(u, dtNone); - Result.DefId:=j; - end; - break; + j:=Ref.Get('Unit', -1); + if j >= 0 then begin + u:=deref[j]; + if u.DefType = dtNone then begin + // Reading unit + u:=InternalParse(LowerCase(u.Name)); + if u = nil then + exit; + if u.CPU <> CurUnit.CPU then + raise Exception.CreateFmt('Invalid target CPU of unit "%s": %s', [u.Name, u.CPU]); + if u.OS <> CurUnit.OS then + raise Exception.CreateFmt('Invalid target OS of unit "%s": %s', [u.Name, u.OS]); + if u.PPUVer <> CurUnit.PPUVer then + raise Exception.CreateFmt('Invalid PPU version of unit "%s": %s', [u.Name, u.PPUVer]); + deref[j].Free; + deref[j]:=u; end; - Inc(i); end; + + j:=Ref.Integers['Id']; + Result:=u.FindDef(j); + if Result = nil then begin + if ExpectedClass <> nil then + Result:=ExpectedClass.Create(u, dtNone) + else + Result:=TDef.Create(u, dtNone); + Result.DefId:=j; + end; + if (ExpectedClass <> nil) and (Result <> nil) then if (Result.DefType <> dtNone) and not (Result is ExpectedClass) then raise Exception.CreateFmt('Unexpected class. Expected: %s, got: %s', [ExpectedClass.ClassName, Result.ClassName]); end; - function _ReadSym(var idx: integer; ParentDef: TDef): TDef; + procedure _ReadDefs(CurDef: TDef; jobj: TJSONObject; const ItemsName: string); var - s, ss, name: string; - id: integer; i, j: integer; + jt, s: string; d: TDef; + it: TJSONObject; + jarr, arr: TJSONArray; begin - Result:=nil; - // symvol id - s:=Trim(FLines[idx]); - id:=StrToInt(ExtractWord(4, s, [' '])); - Inc(idx); - s:=Trim(FLines[idx]); - if Pos('Property', s) = 1 then begin - name:=Trim(Copy(s, 10, MaxInt)); - Result:=TVarDef.Create(nil, dtProp); - TVarDef(Result).VarOpt:=[]; - end - else begin - i:=Pos('symbol', s); - if i = 0 then - exit; - name:=Trim(Copy(s, i + 7, MaxInt)); - if Copy(name, 1, 1) = '$' then - exit; - - s:=LowerCase(Trim(Copy(s, 1, i - 1))); - if s = 'field variable' then - Result:=TVarDef.Create(nil, dtField) - else - if s = 'global variable' then - Result:=TVarDef.Create(nil, dtVar) - else - if s = 'parameter variable' then begin - Result:=TVarDef.Create(nil, dtParam); - TVarDef(Result).VarOpt:=[voRead]; - end - else - if s = 'enumeration' then begin - if ParentDef = CurUnit then - exit; - Result:=TConstDef.Create(nil, dtConst); - TConstDef(Result).VarType:=ParentDef; - end - else - if s = 'constant' then begin - Result:=TConstDef.Create(nil, dtConst); - end - - else - if (s = 'procedure') or (s = 'type') then - Result:=nil - else - exit; - end; - - if Result <> nil then begin - Result.Name:=name; - Result.SymId:=id; - end; - - Inc(level, LInc); - skiplevel:=level; - Inc(idx); - while idx < FLines.Count do begin - s:=FLines[idx]; - if not _ThisLevel(s) or (Copy(Trim(s), 1, 3) = '---') then begin - Dec(idx); - break; - end; - - if Pos('Visibility :', s) > 0 then begin - s:=LowerCase(Trim(ExtractWord(2, s, [':']))); - if (s <> 'public') and (s <> 'published') then begin - FreeAndNil(Result); - exit; - end; - end - else - if (Pos('Definition :', s) > 0) or (Pos('Result Type :', s) > 0) then begin - if (Result = nil) or (Result.DefType <> dtConst) then begin - s:=Trim(ExtractWord(2, s, [':'])); - d:=_GetDef(s); - if (d <> nil) and (d.Name = '') then begin - if (d.DefType = dtProc) and (TProcDef(d).ProcType = ptConstructor) and (CompareText(name, 'create') = 0) then - name:='Create'; // fix char case for standard constructors - d.Name:=name; - d.SymId:=id; + jarr:=jobj.Get(ItemsName, TJSONArray(nil)); + if jarr = nil then + exit; + with jarr do + for i:=0 to Count - 1 do begin + it:=Objects[i]; + CurObjName:=it.Get('Name', ''); + jt:=it.Strings['Type']; + if jt = 'obj' then begin + if it.Strings['ObjType'] <> 'class' then + continue; + d:=TClassDef.Create(CurDef, dtClass); + end + else + if jt = 'rec' then begin + if IsSystemUnit and (CompareText(it.Strings['Name'], 'tguid') = 0) then begin + d:=TTypeDef.Create(CurDef, dtType); + TTypeDef(d).BasicType:=btGuid; + end + else + d:=TRecordDef.Create(CurDef, dtRecord); + end + else + if jt = 'proc' then + d:=TProcDef.Create(CurDef, dtProc) + else + if jt = 'proctype' then begin + d:=TProcDef.Create(CurDef, dtProcType); + TProcDef(d).ProcType:=ptProcedure; + end + else + if jt = 'param' then begin + d:=TVarDef.Create(CurDef, dtParam); + TVarDef(d).VarOpt:=[voRead]; + end + else + if jt = 'prop' then begin + d:=TVarDef.Create(CurDef, dtProp); + TVarDef(d).VarOpt:=[]; + end + else + if jt = 'field' then + d:=TVarDef.Create(CurDef, dtField) + else + if jt = 'var' then + d:=TVarDef.Create(CurDef, dtVar) + else + if jt = 'ord' then begin + d:=TTypeDef.Create(CurDef, dtType); + with TTypeDef(d) do begin + s:=it.Strings['OrdType']; + j:=it.Get('Size', 0); + if s = 'void' then + BasicType:=btVoid + else + if s = 'uint' then begin + case j of + 1: BasicType:=btByte; + 2: BasicType:=btWord; + 4: BasicType:=btLongWord; + else BasicType:=btInt64; + end; + end + else + if s = 'sint' then begin + case j of + 1: BasicType:=btShortInt; + 2: BasicType:=btSmallInt; + 4: BasicType:=btLongInt; + else BasicType:=btInt64; + end; + end + else + if (s = 'pasbool') or (s = 'bool') then + BasicType:=btBoolean + else + if s = 'char' then begin + if j = 1 then + BasicType:=btChar + else + BasicType:=btWideChar; + end + else + if s = 'currency' then + BasicType:=btDouble; end; end - end - else - if Pos('Options :', s) > 0 then begin - s:=LowerCase(Trim(ExtractWord(2, s, [':']))); - if Pos('hidden', s) > 0 then begin - FreeAndNil(Result); - exit; - end; - end - else - if Result <> nil then - case Result.DefType of - dtVar, dtField, dtProp, dtParam: - if (Pos('Var Type :', s) > 0) or (Pos('Prop Type :', s) > 0) then begin - s:=Trim(ExtractWord(2, s, [':'])); - TVarDef(Result).VarType:=_GetDef(s); - end + else + if jt = 'float' then begin + d:=TTypeDef.Create(CurDef, dtType); + with TTypeDef(d) do + if it.Strings['FloatType'] = 'single' then + BasicType:=btSingle else - if Pos('access :', s) > 0 then begin - if Pos('Sym:', Trim(FLines[idx+1])) = 1 then begin - d:=nil; - ss:=Trim(ExtractWord(2, s, [':'])); - if Pos('Nil', ss) = 0 then - d:=_GetDef(ss, TProcDef); - with TVarDef(Result) do - if Pos('Readaccess :', s) > 0 then begin - VarOpt:=VarOpt + [voRead]; - if (d <> nil) and (d.Count = 1) then - IndexType:=TVarDef(d[0]).VarType; + BasicType:=btDouble; + end + else + if jt = 'string' then begin + d:=TTypeDef.Create(CurDef, dtType); + s:=it.Strings['StrType']; + with TTypeDef(d) do + if (s = 'wide') or (s = 'unicode') or (s = 'long') then + BasicType:=btWideString + else + BasicType:=btString; + CurObjName:=s + 'string'; + end + else + if jt = 'enum' then begin + d:=TTypeDef.Create(CurDef, dtEnum); + TTypeDef(d).BasicType:=btEnum; + end + else + if jt = 'set' then + d:=TSetDef.Create(CurDef, dtSet) + else + if jt = 'ptr' then begin + d:=TTypeDef.Create(CurDef, dtType); + TTypeDef(d).BasicType:=btPointer; + end + else + if jt = 'const' then + d:=TConstDef.Create(CurDef, dtConst) + else + continue; + + if CurObjName = '' then begin + d.Free; + continue; + end; + + // Common def attributes + d.Name:=CurObjName; + d.DefId:=it.Get('Id', -1); + d.SymId:=it.Get('SymId', -1); + s:=it.Get('Visibility', ''); + d.IsPrivate:=(s <> '') and (s <> 'public') and (s <> 'published'); + + // Specific def attributes + case d.DefType of + dtClass: + with TClassDef(d) do begin + AncestorClass:=TClassDef(_GetRef(it.Get('Ancestor', TJSONObject(nil)), TClassDef)); + _ReadDefs(d, it, 'Fields'); + end; + dtRecord: + with TRecordDef(d) do begin + Size:=it.Integers['Size']; + _ReadDefs(d, it, 'Fields'); + end; + dtProc, dtProcType: + with TProcDef(d) do begin + arr:=it.Get('Options', TJSONArray(nil)); + if arr <> nil then + for j:=0 to arr.Count - 1 do begin + s:=arr.Strings[j]; + if s = 'procedure' then + ProcType:=ptProcedure + else + if s = 'function' then + ProcType:=ptFunction + else + if s = 'constructor' then begin + ProcType:=ptConstructor; + if CompareText(Name, 'create') = 0 then + Name:='Create'; // fix char case for standard constructors end else - if Pos('Writeaccess :', s) > 0 then begin - VarOpt:=VarOpt + [voWrite]; - if (d <> nil) and (d.Count = 2) then - IndexType:=TVarDef(d[0]).VarType; - end; - end; - end - else - if Pos('Spez :', s) > 0 then begin - with TVarDef(Result) do begin - s:=LowerCase(Trim(ExtractWord(2, s, [':']))); - if s = 'out' then - VarOpt:=[voWrite, voOut] - else - if s = 'var' then - VarOpt:=[voRead, voWrite, voVar] - else - if s = 'const' then - VarOpt:=[voRead, voConst]; - end; - end; - - dtConst: - begin - j:=Pos('Value :', s); - if j > 0 then begin - Inc(j, 6); - ss:=Trim(Copy(s, j + 1, MaxInt)); - if Copy(ss, 1, 1) = '"' then begin - Delete(ss, 1, 1); - i:=level - LInc; - while True do begin - Inc(idx); - if idx >= FLines.Count then - break; - s:=FLines[idx]; - if (Copy(s, i, 3) = '** ') or (Copy(s, j, 1) = ':') then - break; - ss:=ss + #10 + s; - end; - Dec(idx); - Delete(ss, Length(ss), 1); - ss:=StringReplace(ss, '\', '\\', [rfReplaceAll]); - ss:=StringReplace(ss, '"', '\"', [rfReplaceAll]); - ss:=StringReplace(ss, #10, '\n', [rfReplaceAll]); - ss:='"' + ss + '"'; + if s = 'destructor' then + ProcType:=ptDestructor + else + if s = 'overriding' then begin + ProcType:=ptDestructor; + ProcOpt:=ProcOpt + [poOverride]; + if ProcType <> ptConstructor then + IsPrivate:=True; + end + else + if s = 'overload' then + ProcOpt:=ProcOpt + [poOverload] + else + if s = 'overload' then + ProcOpt:=ProcOpt + [poMethodPtr] + else + if s = 'abstract' then + TClassDef(Parent).HasAbstractMethods:=True; end; - TConstDef(Result).Value:=ss; + + ReturnType:=_GetRef(it.Get('RetType', TJSONObject(nil))); + if (DefType = dtProcType) and not ( (ReturnType is TTypeDef) and (TTypeDef(ReturnType).BasicType = btVoid) ) then + ProcType:=ptFunction; + if it.Get('MethodPtr', False) then + ProcOpt:=ProcOpt + [poMethodPtr]; + + _ReadDefs(d, it, 'Params'); + end; + dtVar, dtField, dtParam: + with TVarDef(d) do begin + VarType:=_GetRef(it.Objects['VarType']); + s:=it.Get('Spez', ''); + if s = 'out' then + VarOpt:=[voWrite, voOut] + else + if s = 'var' then + VarOpt:=[voRead, voWrite, voVar] + else + if s = 'const' then + VarOpt:=[voRead, voConst]; + end; + dtProp: + with TVarDef(d) do begin + VarType:=_GetRef(it.Objects['PropType']); + if it.Get('Getter', TJSONObject(nil)) <> nil then + VarOpt:=VarOpt + [voRead]; + if it.Get('Setter', TJSONObject(nil)) <> nil then + VarOpt:=VarOpt + [voWrite]; + + arr:=it.Get('Params', TJSONArray(nil)); + if (arr <> nil) and (arr.Count = 1) then + IndexType:=_GetRef(arr.Objects[0].Objects['VarType']); + end; + dtEnum: + _ReadDefs(d, it, 'Elements'); + dtSet: + with TSetDef(d) do begin + Size:=it.Integers['Size']; + Base:=it.Integers['Base']; + ElMax:=it.Integers['Max']; + ElType:=TTypeDef(_GetRef(it.Objects['ElType'], TTypeDef)); + end; + dtConst: + with TConstDef(d) do begin + VarType:=_GetRef(it.Get('TypeRef', TJSONObject(nil))); + s:=it.Strings['ValType']; + if s = 'int' then + Value:=IntToStr(it.Int64s['Value']) + else + if s = 'float' then begin + Str(it.Floats['Value'], s); + Value:=s; end else - if Pos('OrdinalType :', s) > 0 then begin - s:=Trim(ExtractWord(2, s, [':'])); - TConstDef(Result).VarType:=_GetDef(s); + if s = 'string' then begin + s:=it.Strings['Value']; + s:=StringReplace(s, '\', '\\', [rfReplaceAll]); + s:=StringReplace(s, '"', '\"', [rfReplaceAll]); + s:=StringReplace(s, #9, '\t', [rfReplaceAll]); + s:=StringReplace(s, #10, '\n', [rfReplaceAll]); + s:=StringReplace(s, #13, '\r', [rfReplaceAll]); + Value:='"' + s + '"'; end else - if Pos('Set Type :', s) > 0 then begin -// s:=Trim(ExtractWord(2, s, [':'])); -// TConstDef(Result).VarType:=_GetDef(s); - FreeAndNil(Result); - exit; - end; + FreeAndNil(d); end; end; - - Inc(idx); - end; - - if Result <> nil then - ParentDef.Add(Result); - end; - - procedure _RemoveCurDef; - var - d: TDef; - begin - d:=CurDef; - CurDef:=CurDef.Parent; - d.Free; - skiplevel:=level; + end; end; var - s: ansistring; i, j: integer; - dd: TDef; - HdrRead: boolean; + s: string; begin Result:=nil; for i:=0 to Units.Count - 1 do @@ -534,326 +573,61 @@ begin exit; end; - FLines:=TStringList.Create; + s:=ReadUnit(AUnitName); try - ReadUnit(AUnitName, FLines); - - IsSystemUnit:=CompareText(AUnitName, 'system') = 0; - - Result:=TUnitDef.Create(nil, dtUnit); - Units.Add(Result); - CurUnit:=Result; - SetLength(deref, 0); - CurDef:=Result; - level:=1; - skiplevel:=0; - i:=-1; - HdrRead:=False; - while True do begin - Inc(i); - if i >= FLines.Count then - break; - s:=FLines[i]; - - if s = 'Implementation symtable' then - break; - - if not HdrRead then begin - if Trim(s) = 'Interface symtable' then begin - HdrRead:=True; - continue; - end; - - if Pos('Analyzing', s) = 1 then begin - j:=Pos('(v', s); - if j > 0 then - Result.PPUVer:=StrToInt(Copy(s, j + 2, Length(s) - j - 2)); - end - else - if Pos('Target processor', s) = 1 then - Result.CPU:=Trim(ExtractWord(2, s, [':'])) - else - if Pos('Target operating system', s) = 1 then - Result.OS:=Trim(ExtractWord(2, s, [':'])) - else - if Pos('Interface Checksum', s) = 1 then - Result.IntfCRC:=Trim(ExtractWord(2, s, [':'])) - else - if (Pos('Module Name:', s) = 1) and (Result.Name = '') then begin - Result.Name:=Trim(ExtractWord(2, s, [':'])); - continue; - end - else - if Pos('DerefMap[', s) = 1 then begin - s:=Trim(ExtractWord(2, s, ['='])); - j:=Length(deref); - SetLength(deref, j + 1); - deref[j]:=TUnitDef.Create(nil, dtNone); - deref[j].Name:=s; - continue; - end; + junit:=nil; + try + jp:=TJSONParser.Create(s); + try + junit:=TJSONObject(jp.Parse.Items[0]); + finally + jp.Free; end; - while not _ThisLevel(s) do begin - if skiplevel = 0 then - CurDef:=CurDef.Parent; - Dec(level, LInc); - skiplevel:=0; - end; + IsSystemUnit:=CompareText(AUnitName, 'system') = 0; - if level = skiplevel then - continue; // Skipping not supported entries + Result:=TUnitDef.Create(nil, dtUnit); + Units.Add(Result); + Result.Name:=junit.Strings['Name']; + Result.PPUVer:=junit.Integers['Version']; + Result.CPU:=junit.Strings['TargetCPU']; + Result.OS:=junit.Strings['TargetOS']; + Result.IntfCRC:=junit.Strings['InterfaceCRC']; - // Definition - j:=Pos(SDefId, s); - if j > 0 then begin - Inc(level, LInc); - // def id - j:=StrToInt(Copy(s, j + Length(SDefId), Length(s) - (j + Length(SDefId)) - 2)); - Inc(i); - s:=FLines[i]; - if Pos('definition', s) = 0 then begin - skiplevel:=level; - continue; + if junit.Find('Units') <> nil then + with junit.Arrays['Units'] do begin + SetLength(deref, Count); + for i:=0 to Count - 1 do begin + deref[i]:=TUnitDef.Create(nil, dtNone); + deref[i].Name:=Strings[i]; + end; end; - s:=LowerCase(Trim(ExtractWord(1, s, [' ']))); - dd:=nil; - if s = 'object/class' then - dd:=TClassDef.Create(CurDef, dtClass) - else - if s = 'record' then - dd:=TRecordDef.Create(CurDef, dtRecord) - else - if s = 'procedure' then - dd:=TProcDef.Create(CurDef, dtProc) - else - if s = 'ordinal' then begin - dd:=TTypeDef.Create(CurDef, dtType); - TTypeDef(dd).BasicType:=btLongInt; - end - else - if Pos('string', s) > 0 then begin - dd:=TTypeDef.Create(CurDef, dtType); - dd.Name:=s; - if (s = 'widestring') or (s = 'unicodestring') then - TTypeDef(dd).BasicType:=btWideString - else - TTypeDef(dd).BasicType:=btString; - end - else - if s = 'float' then begin - dd:=TTypeDef.Create(CurDef, dtType); - TTypeDef(dd).BasicType:=btDouble; - end - else - if s = 'enumeration' then begin - dd:=TTypeDef.Create(CurDef, dtEnum); - TTypeDef(dd).BasicType:=btEnum; - end - else - if s = 'pointer' then begin - dd:=TTypeDef.Create(CurDef, dtType); - TTypeDef(dd).BasicType:=btPointer; - end - else - if s = 'procedural' then begin - dd:=TProcDef.Create(CurDef, dtProcType); - TProcDef(dd).ProcType:=ptProcedure; - end - else - if s = 'set' then begin - dd:=TSetDef.Create(CurDef, dtSet); - end - else - skiplevel:=level; - if dd <> nil then begin - CurDef:=dd; - CurDef.DefId:=j; - end; - continue; - end; - - // Symbol - if Pos(SSymId, s) > 0 then begin - dd:=_ReadSym(i, CurDef); - continue; - end; - - if CurDef <> nil then - case CurDef.DefType of - dtClass: - begin - if Pos('Type :', Trim(s)) = 1 then begin - s:=LowerCase(Trim(ExtractWord(2, s, [':']))); - if CurDef.DefId = 0 then - s:=s; - if s <> 'class' then - _RemoveCurDef; - end - else - if Pos('Ancestor Class :', s) > 0 then begin - s:=Trim(ExtractWord(2, s, [':'])); - TClassDef(CurDef).AncestorClass:=TClassDef(_GetDef(s, TClassDef)); - end - end; - dtRecord: - begin - if IsSystemUnit and (Pos('Name of Record :', s) > 0) then begin - s:=Trim(ExtractWord(2, s, [':'])); - if CompareText(s, 'tguid') = 0 then begin - dd:=TTypeDef.Create(CurUnit, dtType); - TTypeDef(dd).BasicType:=btGuid; - dd.DefId:=CurDef.DefId; - CurDef.Free; - CurDef:=dd; - end; - end - else - if Pos('DataSize :', s) > 0 then begin - s:=Trim(ExtractWord(2, s, [':'])); - TRecordDef(CurDef).Size:=StrToInt(s); - end; - end; - dtProc, dtProcType: - begin - s:=Trim(s); - if Pos('TypeOption :', s) = 1 then begin - s:=LowerCase(Trim(ExtractWord(2, s, [':']))); - with TProcDef(CurDef) do - if s = 'procedure' then - ProcType:=ptProcedure - else - if s = 'function' then - ProcType:=ptFunction - else - if s = 'constructor' then - ProcType:=ptConstructor - else - if s = 'destructor' then - ProcType:=ptDestructor; - end - else - if Pos('Return type :', s) = 1 then begin - s:=Trim(ExtractWord(2, s, [':'])); - with TProcDef(CurDef) do begin - ReturnType:=_GetDef(s); - if (CurDef.DefType = dtProcType) and not ( (ReturnType is TTypeDef) and (TTypeDef(ReturnType).BasicType = btVoid) ) then - ProcType:=ptFunction; - end; - end - else - if Pos('Visibility :', s) = 1 then begin - s:=LowerCase(Trim(ExtractWord(2, s, [':']))); - if (s <> 'public') and (s <> 'published') then - CurDef.IsPrivate:=True; - end - else - if Pos('Options :', s) = 1 then begin - s:=LowerCase(Trim(ExtractWord(2, s, [':']))); - with TProcDef(CurDef) do begin - if Pos('overridingmethod', s) > 0 then begin - ProcOpt:=ProcOpt + [poOverride]; - if ProcType <> ptConstructor then - CurDef.IsPrivate:=True; - end; - if Pos('overload', s) > 0 then - ProcOpt:=ProcOpt + [poOverload]; - if Pos('methodpointer', s) > 0 then - ProcOpt:=ProcOpt + [poMethodPtr]; - - if (CurDef.Parent.DefType = dtClass) and (Pos('abstractmethod', s) > 0) then - TClassDef(CurDef.Parent).HasAbstractMethods:=True; - end; - end; - end; - dtType: - with TTypeDef(CurDef) do - if Pos('Base type :', s) > 0 then begin - s:=LowerCase(Trim(ExtractWord(2, s, [':']))); - if Pos('bool', s) = 1 then - BasicType:=btBoolean - else - if s = 'u8bit' then - BasicType:=btByte - else - if s = 's8bit' then - BasicType:=btShortInt - else - if s = 'u16bit' then - BasicType:=btWord - else - if s = 's16bit' then - BasicType:=btSmallInt - else - if s = 'u32bit' then - BasicType:=btLongWord - else - if s = 's32bit' then - BasicType:=btLongInt - else - if (s = 'u64bit') or (s = 's64bit') then - BasicType:=btInt64 - else - if s = 'uvoid' then - BasicType:=btVoid - else - if s = 'uchar' then - BasicType:=btChar - else - if s = 'uwidechar' then - BasicType:=btWideChar; - end - else - if Pos('Float type :', s) > 0 then begin - s:=Trim(ExtractWord(2, s, [':'])); - if s = '0' then - BasicType:=btSingle; - end - else - if Pos('Range :', s) > 0 then begin - s:=LowerCase(Trim(ExtractWord(2, s, [':']))); - if s = '0 to 1' then - BasicType:=btBoolean; - end; - dtSet: - with TSetDef(CurDef) do - if Pos('Size :', s) > 0 then - Size:=StrToInt(Trim(ExtractWord(2, s, [':']))) - else - if Pos('Set Base :', s) > 0 then - Base:=StrToInt(Trim(ExtractWord(2, s, [':']))) - else - if Pos('Set Max :', s) > 0 then - ElMax:=StrToInt(Trim(ExtractWord(2, s, [':']))) - else - if Pos('Element type :', s) > 0 then - ElType:=TTypeDef(_GetDef(Trim(ExtractWord(2, s, [':'])), TTypeDef)) - else - if Pos('Type symbol :', s) > 0 then begin - s:=LowerCase(Trim(ExtractWord(2, s, [':']))); - if Trim(ExtractWord(2, s, [' '])) = 'nil' then - _RemoveCurDef; - end; + + CurUnit:=Result; + _ReadDefs(CurUnit, junit, 'Interface'); + + Result.ResolveDefs; + + if AMainUnit then + Result.IsUsed:=True; + + SetLength(Result.UsedUnits, Length(deref)); + j:=0; + for i:=0 to High(deref) do + if deref[i].DefType = dtNone then + deref[i].Free + else begin + Result.UsedUnits[j]:=deref[i]; + Inc(j); end; + SetLength(Result.UsedUnits, j); + finally + junit.Free; end; - - Result.ResolveDefs; - - if AMainUnit then - Result.IsUsed:=True; - - SetLength(Result.UsedUnits, Length(deref)); - j:=0; - for i:=0 to High(deref) do - if deref[i].DefType = dtNone then - deref[i].Free - else begin - Result.UsedUnits[j]:=deref[i]; - Inc(j); - end; - SetLength(Result.UsedUnits, j); - finally - FLines.Free; + except + if CurObjName <> '' then + CurObjName:=Format('; Object: "%s"', [CurObjName]); + raise Exception.CreateFmt('%s' + LineEnding + 'Unit: "%s"%s', [Exception(ExceptObject).Message, AUnitName, CurObjName]); end; end;