* Add dpktolpk unit plus example

packages/fcl-passrc/examples/dpk2lpk.lpi

@@ -0,0 +1,62 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="Convert Delphi To Lazarus Package"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="dpk2lpk.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="dpk2lpk"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-passrc/examples/dpk2lpk.pp

@@ -0,0 +1,105 @@
+program dpk2lpk;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, Types, CustApp, dpktolpk;
+
+type
+
+
+  { TDPK2LPKApplication }
+
+  TDPK2LPKApplication = class(TCustomApplication)
+  protected
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Usage(const Msg: String); virtual;
+  end;
+
+
+{ TDPK2LPKApplication }
+
+procedure TDPK2LPKApplication.DoRun;
+
+const
+  Short = 'ho:k:u';
+  Long : Array of string = ('help','output:','known:','update');
+
+var
+  ErrorMsg: String;
+  Cnv : TDPK2LPKConverter;
+  OFN,PFN,KFN : String;
+  FNS : TStringDynArray;
+
+begin
+  Terminate;
+  ErrorMsg:=CheckOptions(Short,Long);
+  if (ErrorMsg<>'') or HasOption('h','help') then
+    begin
+    Usage(ErrorMsg);
+    Exit;
+    end;
+  FNS:=GetNonOptions(Short,Long);
+  if Length(FNS)=0 then
+    begin
+    Usage('Need one or more input files');
+    exit;
+    end;
+  OFN:=GetOptionValue('o','output');
+  if (OFN<>'') and (Length(FNS)>1) then
+    begin
+    Usage('Cannot specify output file with more than one input file');
+    exit;
+    end;
+  Cnv:=TDPK2LPKConverter.Create(Self);
+  try
+    KFN:=GetOptionValue('k','known');
+    if (KFN<>'') and FileExists(KFN) then
+      CNV.KnownPackages.LoadFromFile(KFN);
+    for PFN in FNS do
+      begin
+      if (OFN='') then
+        OFN:=ChangeFileExt(PFN,'.lpk');
+      CNV.UpdateKnown:=HasOption('u','update');
+      CNV.Convert(PFN,OFN);
+      OFN:='';
+      end;
+    if HasOption('u','update') and (KFN<>'') then
+      CNV.KnownPackages.SaveToFile(KFN);
+  finally
+    Cnv.Free;
+  end;
+
+end;
+
+constructor TDPK2LPKApplication.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+destructor TDPK2LPKApplication.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TDPK2LPKApplication.Usage(Const Msg : String);
+begin
+  if Msg<>'' then
+    Writeln('Error: ',Msg);
+  Writeln('Usage: ',ExeName, ' [options] File1 [File2]');
+  ExitCode:=Ord(Msg<>'');
+end;
+
+var
+  Application: TDPK2LPKApplication;
+begin
+  Application:=TDPK2LPKApplication.Create(nil);
+  Application.Title:='Convert Delphi To Lazarus Package';
+  Application.Run;
+  Application.Free;
+end.
+

packages/fcl-passrc/fpmake.pp

@@ -84,6 +84,13 @@ begin
           AddUnit('pastree');
           AddUnit('pasresolver');
         end;
+    T:=P.Targets.AddUnit('dpktolpk.pp');
+      with T.Dependencies do
+        begin
+          AddUnit('pastree');
+          AddUnit('pscanner');
+          AddUnit('pparser');
+        end;
 
 
     P.NamespaceMap:='namespaces.lst';

packages/fcl-passrc/src/dpktolpk.pp

@@ -0,0 +1,391 @@
+unit dpktolpk;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, pastree, pparser, dom, XMLWrite;
+
+Type
+  { TPackageContainer }
+
+  TPackageContainer = class(TPasTreeContainer)
+  Public
+    function FindElement(const AName: String): TPasElement; override;
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;overload; override;
+  end;
+
+  { TDPK2LPKConverter }
+
+  TDPK2LPKConverter = class(TComponent)
+  private
+    FKnownPackages: TStrings;
+    FUpdateKnown: Boolean;
+    procedure AddRequires(aXML: TXMLDocument; aRequired: TDOMElement; aSection: TPasPackageSection);
+    procedure AddUses(aXML: TXMLDocument; aFiles: TDOMElement; aSection: TPasPackageSection);
+    procedure CreatePackageXML(aXML: TXMLDocument; aName: string; out aFiles, aRequired: TDOMElement);
+    procedure WriteLPK(Pack: TPasDynamicPackage; aOUtputFile: String);
+  Public
+    Constructor Create(aOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure Convert(const aInputFile,aOutputFile : String);
+    Property KnownPackages : TStrings Read FKnownPackages;
+    Property UpdateKnown : Boolean Read FUpdateKnown Write FUpdateKnown;
+  end;
+
+  { TSimpleParser }
+
+  TSimpleParser = Class
+    function ParseSource(AEngine: TPasTreeContainer;
+                        const FPCCommandLine : Array of String;
+                        OSTarget, CPUTarget: String;
+                        Options : TParseSourceOptions): TPasModule;
+  private
+    procedure DoIt(Sender: TObject; const aFileName: String; aOptions: TStrings);
+  end;
+
+implementation
+
+uses pscanner;
+
+function TSimpleParser.ParseSource(AEngine: TPasTreeContainer;
+                     const FPCCommandLine : Array of String;
+                     OSTarget, CPUTarget: String;
+                     Options : TParseSourceOptions): TPasModule;
+
+var
+  FileResolver: TBaseFileResolver;
+  Parser: TPasParser;
+  Filename: String;
+  Scanner: TPascalScanner;
+
+  procedure ProcessCmdLinePart(S : String);
+  var
+    l,Len: Integer;
+
+  begin
+    if (S='') then
+      exit;
+    Len:=Length(S);
+    if (s[1] = '-') and (len>1) then
+    begin
+      case s[2] of
+        'd': // -d define
+          Scanner.AddDefine(UpperCase(Copy(s, 3, Len)));
+        'u': // -u undefine
+          Scanner.RemoveDefine(UpperCase(Copy(s, 3, Len)));
+        'F': // -F
+          if (len>2) and (s[3] = 'i') then // -Fi include path
+            FileResolver.AddIncludePath(Copy(s, 4, Len));
+        'I': // -I include path
+          FileResolver.AddIncludePath(Copy(s, 3, Len));
+        'S': // -S mode
+          if  (len>2) then
+            begin
+            l:=3;
+            While L<=Len do
+              begin
+              case S[l] of
+                'c' : Scanner.Options:=Scanner.Options+[po_cassignments];
+                'd' : Scanner.SetCompilerMode('DELPHI');
+                '2' : Scanner.SetCompilerMode('OBJFPC');
+                'h' : ; // do nothing
+              end;
+              inc(l);
+              end;
+            end;
+        'M' :
+           begin
+           delete(S,1,2);
+           Scanner.SetCompilerMode(S);
+           end;
+      end;
+    end else
+      if Filename <> '' then
+        raise ENotSupportedException.Create(SErrMultipleSourceFiles)
+      else
+        Filename := s;
+  end;
+
+var
+  S: String;
+
+begin
+  if DefaultFileResolverClass=Nil then
+    raise ENotImplemented.Create(SErrFileSystemNotSupported);
+  Result := nil;
+  FileResolver := nil;
+  Scanner := nil;
+  Parser := nil;
+  try
+    FileResolver := DefaultFileResolverClass.Create;
+    {$ifdef HasStreams}
+    if FileResolver is TFileResolver then
+      TFileResolver(FileResolver).UseStreams:=poUseStreams in Options;
+    {$endif}
+    Scanner := TPascalScanner.Create(FileResolver);
+    Scanner.LogEvents:=AEngine.ScannerLogEvents;
+    Scanner.OnLog:=AEngine.OnLog;
+    Scanner.RegisterResourceHandler(['res'],@DoIt);
+    if not (poSkipDefaultDefs in Options) then
+      begin
+      Scanner.AddDefine('FPK');
+      Scanner.AddDefine('FPC');
+      // TargetOS
+      s := UpperCase(OSTarget);
+      Scanner.AddDefine(s);
+      Case s of
+        'LINUX' : Scanner.AddDefine('UNIX');
+        'FREEBSD' :
+          begin
+          Scanner.AddDefine('BSD');
+          Scanner.AddDefine('UNIX');
+          end;
+        'NETBSD' :
+          begin
+          Scanner.AddDefine('BSD');
+          Scanner.AddDefine('UNIX');
+          end;
+        'SUNOS' :
+          begin
+          Scanner.AddDefine('SOLARIS');
+          Scanner.AddDefine('UNIX');
+          end;
+        'GO32V2' : Scanner.AddDefine('DPMI');
+        'BEOS' : Scanner.AddDefine('UNIX');
+        'QNX' : Scanner.AddDefine('UNIX');
+        'AROS' : Scanner.AddDefine('HASAMIGA');
+        'MORPHOS' : Scanner.AddDefine('HASAMIGA');
+        'AMIGA' : Scanner.AddDefine('HASAMIGA');
+      end;
+      // TargetCPU
+      s := UpperCase(CPUTarget);
+      Scanner.AddDefine('CPU'+s);
+      if (s='X86_64') then
+        Scanner.AddDefine('CPU64')
+      else
+        Scanner.AddDefine('CPU32');
+      end;
+    Parser := TPasParser.Create(Scanner, FileResolver, AEngine);
+    if (poSkipDefaultDefs in Options) then
+      Parser.ImplicitUses.Clear;
+    Filename := '';
+    Parser.LogEvents:=AEngine.ParserLogEvents;
+    Parser.OnLog:=AEngine.OnLog;
+
+    For S in FPCCommandLine do
+      ProcessCmdLinePart(S);
+    if Filename = '' then
+      raise Exception.Create(SErrNoSourceGiven);
+{$IFDEF HASFS}
+    FileResolver.AddIncludePath(ExtractFilePath(FileName));
+{$ENDIF}
+    Scanner.OpenFile(Filename);
+    Parser.ParseMain(Result);
+  finally
+    Parser.Free;
+    Scanner.Free;
+    FileResolver.Free;
+  end;
+end;
+
+procedure TSimpleParser.DoIt(Sender: TObject; const aFileName: String; aOptions: TStrings);
+begin
+  // Do nothing
+end;
+
+{ TDPK2LPKConverter }
+
+procedure TDPK2LPKConverter.CreatePackageXML(aXML: TXMLDocument; aName: string; out aFiles, aRequired: TDOMElement);
+
+  Function AppendEl(aParent : TDOMElement; aTag : String; aValue : String = '') : TDOMelement;
+  begin
+    Result:=aXML.CreateElement(UTF8Decode(aTag));
+    if Assigned(aParent) then
+      AParent.AppendChild(Result);
+    if aValue<>'' then
+      Result.AttribStrings['Value']:=UTF8Decode(aValue);
+  end;
+
+var
+  Cfg, Pck : TDOMElement;
+  El,Sub : TDomElement;
+
+
+begin
+  Cfg:=AppendEl(Nil,'CONFIG');
+  aXML.AppendChild(Cfg);
+    Pck:=AppendEl(Cfg,'Package');
+    Pck.AttribStrings['Version']:='5';
+      AppendEl(Pck,'Name',aName);
+      AppendEl(Pck,'Type','RunTime');
+      AppendEl(Pck,'Author','');
+      El:=AppendEl(Pck,'CompilerOptions','');
+        AppendEl(El,'Version','11');
+        Sub:=AppendEl(El,'SearchPaths','');
+          AppendEl(Sub,'UnitOutputDirectory','lib/$(TargetCPU)-$(TargetOS)');
+      AppendEl(Pck,'Description','');
+      AppendEl(Pck,'Licence','');
+      El:=AppendEl(Pck,'Version');
+      El.AttribStrings['Major']:='1';
+      aFiles:=AppendEl(Pck,'Files','');
+      aRequired:=AppendEl(Pck,'RequiredPkgs');
+      El:=AppendEl(Pck,'UsageOptions');
+        El:=AppendEl(El,'UnitPath');
+        EL.AttribStrings['Value']:='$(PkgOutDir)';
+      El:=AppendEl(Pck,'PublishOptions');
+        Sub:=AppendEl(El,'Version');
+        Sub.AttribStrings['Value']:='2';
+        Sub:=AppendEl(El,'UseFileFilters');
+        Sub.AttribStrings['Value']:='True';
+end;
+
+
+procedure TDPK2LPKConverter.AddUses(aXML : TXMLDocument; aFiles: TDOMElement; aSection : TPasPackageSection);
+
+var
+  aUsed : TPasUsesUnit;
+  aName,aFileName : String;
+  Itm,El : TDomElement;
+
+begin
+  For aUsed in aSection.UsesClause do
+    begin
+    aName:=aUsed.Name;
+    if (aName<>'') then
+      begin
+      if assigned(aUsed.InFileName) then
+        begin
+        aFileName:=StringReplace(aUsed.InFilename.Value,'''','',[rfReplaceAll]);
+        aFileName:=StringReplace(aFilename,'\','/',[rfReplaceAll]);
+        end
+      else
+        aFileName:=aName+'.pas'; // Should not happen
+      Itm:=aXML.CreateElement('Item');
+      aFiles.AppendChild(Itm);
+      El:=aXML.CreateElement('Filename');
+      Itm.AppendChild(El);
+      El.AttribStrings['Value']:=UTF8Decode(aFileName);
+      El:=aXML.CreateElement('UnitName');
+      Itm.AppendChild(El);
+      El.AttribStrings['Value']:=UTF8Decode(aName);
+      end;
+    end;
+end;
+
+procedure TDPK2LPKConverter.AddRequires(aXML : TXMLDocument; aRequired: TDOMElement; aSection : TPasPackageSection);
+
+var
+  I : Integer;
+  Itm,El : TDomElement;
+  aPack : TPasRequiredPackage;
+  aName : String;
+  Added : TStringList;
+
+begin
+  Added:=TStringList.Create();
+  try
+    Added.Sorted:=True;
+    For I:=0 to aSection.Requires.Count-1 do
+      begin
+      aPack:=TPasRequiredPackage(aSection.Requires[i]);
+      aName:=FKnownPackages.Values[aPack.Name];
+      if (aName<>'') and (Added.IndexOf(aName)=-1) then
+        begin
+        Itm:=aXML.CreateElement('Item');
+        aRequired.AppendChild(Itm);
+        El:=aXML.CreateElement('PackageName');
+        Itm.AppendChild(El);
+        El.AttribStrings['Value']:=UTF8Decode(aName);
+        Added.Add(aName);
+        end;
+      end;
+  finally
+    Added.Free;
+  end;
+end;
+
+procedure TDPK2LPKConverter.WriteLPK(Pack : TPasDynamicPackage; aOUtputFile : String);
+
+var
+  aSection : TPasPackageSection;
+  XML : TXMLDocument;
+  aFiles,aRequired : TDOMElement;
+
+begin
+  XML:=TXMLDocument.Create;
+  try
+    // Create skeleton package
+    CreatePackageXML(XML,Pack.Name,aFiles,aRequired);
+    aSection:=Pack.PackageSection;
+    // Add Uses
+    AddUses(XML,aFiles,aSection);
+    // Add Requires
+    AddRequires(XML,aRequired,aSection);
+    // Write file
+    WriteXML(XML,aOUtputFile);
+  finally
+    XML.Free;
+  end;
+
+end;
+
+constructor TDPK2LPKConverter.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FKnownPackages:=TStringList.Create;
+end;
+
+destructor TDPK2LPKConverter.Destroy;
+begin
+  FreeAndNil(FKnownPackages);
+  inherited Destroy;
+end;
+
+procedure TDPK2LPKConverter.Convert(const aInputFile, aOutputFile: String);
+
+Var
+  El : TPasElement;
+  Pack : TPasDynamicPackage absolute El;
+  C : TPackageContainer;
+  Parser : TSimpleParser;
+
+begin
+  Parser:=nil;
+  C:=TPackageContainer.Create;
+  try
+    Parser:=TSimpleParser.Create;
+    El:=Parser.ParseSource(C,['-Sd',aInputFile],'linux','x86_64',[]);
+    if not (El is TPasDynamicPackage) then
+      Raise EPasTree.CreateFmt('%s is not a package source file. Got a %s instead.',[aInputFile,Pack.ClassName]);
+    WriteLPK(Pack,aOutputFile);
+    if UpdateKnown then
+      FKnownPackages.Values[Pack.Name]:=Pack.Name;
+  finally
+    Parser.Free;
+    El.Free;
+    C.Free;
+  end;
+end;
+
+{ TPackageContainer }
+
+function TPackageContainer.FindElement(const AName: String): TPasElement;
+begin
+  Result:=Nil;
+end;
+
+function TPackageContainer.CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement;
+  AVisibility: TPasMemberVisibility; const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+begin
+  Result:=aClass.Create(aName,aParent);
+  Result.Visibility:=AVisibility;
+  // ASourceFilename, ASourceLinenumber ?
+end;
+
+
+end.
+

packages/fcl-passrc/src/pastree.pp

@@ -34,8 +34,10 @@ resourcestring
   SPasTreeSection = 'unit section';
   SPasTreeProgramSection = 'program section';
   SPasTreeLibrarySection = 'library section';
+  SPasTreePackageSection = 'package section';
   SPasTreeInterfaceSection = 'interface section';
   SPasTreeImplementationSection = 'implementation section';
+  SPasTreeRequiredPackage = 'Required package';
   SPasTreeUsesUnit = 'uses unit';
   SPasTreeModule = 'module';
   SPasTreeUnit = 'unit';
@@ -420,6 +422,20 @@ type
     function ElementTypeName: TPasTreeString; override;
   end;
 
+  { TPackageSection }
+
+  TPasPackageSection = class(TInterfaceSection)
+  public
+    Requires : TFPList; // Array of TRequiredPackage;
+  Public
+    Constructor Create(const AName: TPasTreeString; AParent: TPasElement); override;
+    Destructor Destroy; override;
+    Procedure FreeChildren(Prepare: boolean); override;
+    function ElementTypeName: TPasTreeString; override;
+
+  end;
+
+
   TPasImplCommandBase = class;
   TInitializationSection = class;
   TFinalizationSection = class;
@@ -491,6 +507,23 @@ type
     Modules: TFPList;     // List of TPasModule objects
   end;
 
+  { TRequiredPackage }
+
+  TPasRequiredPackage = Class(TPasElement)
+    function ElementTypeName: TPasTreeString; override;
+  end;
+
+  { TPasDynamicPackage }
+
+  TPasDynamicPackage = class(TPasModule)
+  Public
+    PackageSection : TPasPackageSection;
+    procedure FreeChildren(Prepare: boolean); override;
+    constructor Create(const AName: TPasTreeString; AParent: TPasElement); override;
+    destructor Destroy; override;
+  end;
+
+
   { TPasResString }
 
   TPasResString = class(TPasElement)
@@ -2334,6 +2367,31 @@ begin
   Result:=SPasTreeLibrarySection;
 end;
 
+{ TPasPackageSection }
+
+constructor TPasPackageSection.Create(const AName: TPasTreeString; AParent: TPasElement);
+begin
+  inherited Create(AName, AParent);
+  Requires:=TFPList.Create;
+end;
+
+destructor TPasPackageSection.Destroy;
+begin
+  FreeandNil(Requires);
+  inherited Destroy;
+end;
+
+procedure TPasPackageSection.FreeChildren(Prepare: boolean);
+begin
+  FreeChildList(Requires,Prepare);
+  inherited FreeChildren(Prepare);
+end;
+
+function TPasPackageSection.ElementTypeName: TPasTreeString;
+begin
+  Result:=SPasTreePackageSection;
+end;
+
 { TProgramSection }
 
 function TProgramSection.ElementTypeName: TPasTreeString;
@@ -3201,6 +3259,33 @@ begin
   inherited FreeChildren(Prepare);
 end;
 
+{ TPasRequiredPackage }
+
+function TPasRequiredPackage.ElementTypeName: TPasTreeString;
+begin
+  Result:=SPasTreeRequiredPackage;
+end;
+
+{ TPasDynamicPackage }
+
+procedure TPasDynamicPackage.FreeChildren(Prepare: boolean);
+begin
+  PackageSection:=TPasPackageSection(FreeChild(PackageSection,Prepare));
+  inherited FreeChildren(Prepare);
+end;
+
+constructor TPasDynamicPackage.Create(const AName: TPasTreeString; AParent: TPasElement);
+begin
+  inherited Create(AName, AParent);
+  PackageSection:=TPasPackageSection.Create(aName,Self);
+end;
+
+destructor TPasDynamicPackage.Destroy;
+begin
+  FreeAndNil(PackageSection);
+  inherited Destroy;
+end;
+
 procedure TPasPointerType.FreeChildren(Prepare: boolean);
 begin
   DestType:=TPasType(FreeChild(DestType,Prepare));

packages/fcl-passrc/src/pparser.pp

@@ -545,7 +545,10 @@ type
     procedure ParseContinue; virtual;
     procedure ParseProgram(var Module: TPasModule; SkipHeader : Boolean = False);
     procedure ParseLibrary(var Module: TPasModule);
+    procedure ParsePackage(var Module: TPasModule);
     procedure ParseOptionalUsesList(ASection: TPasSection);
+    procedure ParseContains(ASection: TPasSection);
+    procedure ParseRequires(ASection: TPasPackageSection);
     procedure ParseUsesList(ASection: TPasSection);
     procedure ParseInterface;
     procedure ParseImplementation;
@@ -3284,6 +3287,8 @@ begin
       ParseProgram(Module);
     tkLibrary:
       ParseLibrary(Module);
+    tkPackage:
+      ParsePackage(Module);
     tkEOF:
       CheckToken(tkprogram);
   else
@@ -3307,6 +3312,7 @@ var
   StartPos: TPasSourcePos;
   HasFinished: Boolean;
 begin
+  Scanner.DisablePackageTokens;
   StartPos:=CurTokenPos;
   Module := nil;
   AUnitName := ExpectIdentifier;
@@ -3472,6 +3478,7 @@ Var
   aSection: TPasSection;
   {$ENDIF}
 begin
+  Scanner.DisablePackageTokens;
   StartPos:=CurTokenPos;
   if SkipHeader then
     N:=ChangeFileExt(Scanner.CurFilename,RTLString(''))
@@ -3552,6 +3559,7 @@ Var
   HasFinished: Boolean;
 
 begin
+  Scanner.DisablePackageTokens;
   StartPos:=CurTokenPos;
   N:=ExpectIdentifier;
   NextToken;
@@ -3591,6 +3599,51 @@ begin
   end;
 end;
 
+procedure TPasParser.ParsePackage(var Module: TPasModule);
+
+var
+  PP : TPasDynamicPackage;
+  StartPos: TPasSourcePos;
+  N : String;
+
+begin
+  StartPos:=CurTokenPos;
+  N:=ExpectIdentifier;
+  NextToken;
+  while CurToken = tkDot do
+    begin
+    ExpectIdentifier;
+    N := N + '.' + CurTokenString;
+    NextToken;
+    end;
+  UngetToken;
+  ExpectToken(tkSemiColon);
+  NextToken;
+  Module := nil;
+  PP:=TPasDynamicPackage(CreateElement(TPasDynamicPackage, N, Engine.Package, StartPos));
+  Module :=PP;
+  FCurModule:=Module;
+  try
+    While Not (CurToken=tkDot) do
+      begin
+      Case CurToken of
+        tkcontains : ParseContains(PP.PackageSection);
+        tkrequires : ParseRequires(PP.PackageSection);
+        tkEnd : begin
+                ExpectToken(tkDot);
+                UngetToken; // Next token will get it again
+                end;
+      else
+        ParseExcSyntaxError;
+      end;
+      NextToken;
+      end;
+    FinishedModule;
+  finally
+    FCurModule:=nil;
+  end;
+end;
+
 procedure TPasParser.ParseOptionalUsesList(ASection: TPasSection);
 // checks if next token is Uses keyword and reads the uses list
 begin
@@ -4158,6 +4211,33 @@ begin
   Engine.FinishScope(stModule,CurModule);
 end;
 
+// On Entry, current token is requires
+// On exit, current token is semicolon
+procedure TPasParser.ParseRequires(ASection: TPasPackageSection);
+
+var
+  Pck : TPasRequiredPackage;
+  PckPos : TPasSourcePos;
+
+begin
+  repeat
+    ExpectIdentifier();
+    PckPos:=CurSourcePos;
+    Pck:=TPasRequiredPackage(Engine.CreateElement(TPasRequiredPackage,CurtokenString,aSection,visPublic,PckPos));
+    aSection.Requires.Add(Pck);
+    NextToken;
+  until CurToken=tkSemicolon;
+end;
+
+// On Entry, current token is contains.
+// On exit, current token is semicolon
+procedure TPasParser.ParseContains(ASection: TPasSection);
+
+begin
+  // We can simply call parseuseslist
+  ParseUsesList(aSection);
+end;
+
 // Starts after the "uses" token
 procedure TPasParser.ParseUsesList(ASection: TPasSection);
 var

packages/fcl-passrc/src/pscanner.pp

@@ -217,6 +217,7 @@ type
     tkconst,
     tkconstref,
     tkconstructor,
+    tkcontains,
     tkdestructor,
     tkdispinterface,
     tkdiv,
@@ -256,12 +257,14 @@ type
     tkor,
     tkotherwise,
     tkpacked,
+    tkPackage,
     tkprocedure,
     tkprogram,
     tkproperty,
     tkraise,
     tkrecord,
     tkrepeat,
+    tkrequires,
     tkResourceString,
     tkself,
     tkset,
@@ -933,6 +936,7 @@ type
     procedure OpenFile(AFilename: TPasScannerString);
     procedure FinishedModule; virtual; // called by parser after end.
     function FormatPath(const aFilename: String): String; virtual;
+    Procedure DisablePackageTokens;
     procedure SetNonToken(aToken : TToken);
     procedure UnsetNonToken(aToken : TToken);
     procedure SetTokenOption(aOption : TTokenoption);
@@ -1063,6 +1067,7 @@ const
     'const',
     'constref',
     'constructor',
+    'contains',
     'destructor',
     'dispinterface',
     'div',
@@ -1102,12 +1107,14 @@ const
     'or',
     'otherwise',
     'packed',
+    'package',
     'procedure',
     'program',
     'property',
     'raise',
     'record',
     'repeat',
+    'requires',
     'resourcestring',
     'self',
     'set',
@@ -3487,6 +3494,11 @@ begin
     Result:=aFilename;
 end;
 
+procedure TPascalScanner.DisablePackageTokens;
+begin
+  FNonTokens:=FNonTokens+[tkContains,tkPackage,tkrequires];
+end;
+
 procedure TPascalScanner.SetNonToken(aToken: TToken);
 begin
   Include(FNonTokens,aToken);