Pārlūkot izejas kodu

--- Merging r30653 into '.':
U rtl/inc/fexpand.inc
--- Recording mergeinfo for merge of r30653 into '.':
U .
--- Merging r30654 into '.':
U tests/test/units/dos/tfexpand.pp
--- Recording mergeinfo for merge of r30654 into '.':
G .
--- Merging r30774 into '.':
G tests/test/units/dos/tfexpand.pp
--- Recording mergeinfo for merge of r30774 into '.':
G .
--- Merging r30788 into '.':
U rtl/amiga/system.pp
--- Recording mergeinfo for merge of r30788 into '.':
G .
--- Merging r30789 into '.':
U rtl/morphos/system.pp
--- Recording mergeinfo for merge of r30789 into '.':
G .
--- Merging r30790 into '.':
U packages/fcl-process/fpmake.pp
A packages/fcl-process/src/amicommon
A packages/fcl-process/src/amicommon/process.inc
A packages/fcl-process/src/amicommon/pipes.inc
A packages/fcl-process/src/amicommon/simpleipc.inc
--- Recording mergeinfo for merge of r30790 into '.':
G .
--- Merging r30803 into '.':
U packages/fcl-process/src/amicommon/simpleipc.inc
--- Recording mergeinfo for merge of r30803 into '.':
G .
--- Merging r30805 into '.':
U packages/fcl-process/src/amicommon/process.inc
U packages/fcl-process/src/amicommon/pipes.inc
--- Recording mergeinfo for merge of r30805 into '.':
G .
--- Merging r30806 into '.':
G packages/fcl-process/src/amicommon/process.inc
G packages/fcl-process/src/amicommon/pipes.inc
--- Recording mergeinfo for merge of r30806 into '.':
G .
--- Merging r30812 into '.':
U packages/morphunits/src/amigados.pas
U packages/amunits/src/coreunits/amigados.pas
G packages/fcl-process/src/amicommon/process.inc
G packages/fcl-process/src/amicommon/pipes.inc
U packages/arosunits/src/amigados.pas
--- Recording mergeinfo for merge of r30812 into '.':
G .
--- Merging r30813 into '.':
U rtl/aros/system.pp
--- Recording mergeinfo for merge of r30813 into '.':
G .

# revisions: 30653,30654,30774,30788,30789,30790,30803,30805,30806,30812,30813

git-svn-id: branches/fixes_3_0@31082 -

marco 10 gadi atpakaļ
vecāks
revīzija
3605c0655a

+ 3 - 0
.gitattributes

@@ -2529,6 +2529,9 @@ packages/fcl-process/Makefile svneol=native#text/plain
 packages/fcl-process/Makefile.fpc svneol=native#text/plain
 packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/fcl-process/fpmake.pp svneol=native#text/plain
+packages/fcl-process/src/amicommon/pipes.inc svneol=native#text/plain
+packages/fcl-process/src/amicommon/process.inc svneol=native#text/plain
+packages/fcl-process/src/amicommon/simpleipc.inc svneol=native#text/plain
 packages/fcl-process/src/dbugintf.pp svneol=native#text/plain
 packages/fcl-process/src/dbugmsg.pp svneol=native#text/plain
 packages/fcl-process/src/dummy/pipes.inc svneol=native#text/plain

+ 4 - 4
packages/amunits/src/coreunits/amigados.pas

@@ -1598,7 +1598,7 @@ FUNCTION CreateProc(const name : pCHAR location 'd1'; pri : LONGINT location 'd2
 FUNCTION CurrentDir(lock : LONGINT location 'd1') : LONGINT; syscall _DOSBase 126;
 PROCEDURE DateStamp(date : pDateStamp location 'd1'); syscall _DOSBase 192;
 FUNCTION DateToStr(datetime : pDateTime location 'd1') : LongBool; syscall _DOSBase 744;
-FUNCTION DeleteFile(const name : pCHAR location 'd1') : LongBool; syscall _DOSBase 072;
+FUNCTION DOSDeleteFile(const name : pCHAR location 'd1') : LongBool; syscall _DOSBase 072;
 FUNCTION DeleteVar(const name : pCHAR location 'd1'; flags : ULONG location 'd2') : LongBool; syscall _DOSBase 912;
 FUNCTION DeviceProc(const name : pCHAR location 'd1') : pMsgPort; syscall _DOSBase 174;
 FUNCTION DoPkt(port : pMsgPort location 'd1'; action : LONGINT location 'd2'; arg1 : LONGINT location 'd3'; arg2 : LONGINT location 'd4'; arg3 : LONGINT location 'd5'; arg4 : LONGINT location 'd6'; arg5 : LONGINT location 'd7') : LONGINT; syscall _DOSBase 240;
@@ -1756,7 +1756,7 @@ FUNCTION AssignPath(const name : pCHAR;const path : string) : BOOLEAN;
 FUNCTION AssignPath(const name : string;const path : string) : BOOLEAN;
 FUNCTION CreateDir(const name : string) : LONGINT;
 FUNCTION CreateProc(const name : string; pri : LONGINT; segList : LONGINT; stackSize : LONGINT) : pMsgPort;
-FUNCTION DeleteFile(const name : string) : BOOLEAN;
+FUNCTION DOSDeleteFile(const name : string) : BOOLEAN;
 FUNCTION DeleteVar(const name : string; flags : ULONG) : BOOLEAN;
 FUNCTION DeviceProc(const name : string) : pMsgPort;
 FUNCTION DOSOpen(const name : string; accessMode : LONGINT) : LONGINT;
@@ -1904,9 +1904,9 @@ begin
      CreateProc := CreateProc(pas2c(name),pri,segList,stackSize);
 end;
 
-FUNCTION DeleteFile(const name : string) : BOOLEAN;
+FUNCTION DOSDeleteFile(const name : string) : BOOLEAN;
 begin
-     DeleteFile := DeleteFile(pas2c(name));
+     DOSDeleteFile := DOSDeleteFile(pas2c(name));
 end;
 
 FUNCTION DeleteVar(const name : string; flags : ULONG) : BOOLEAN;

+ 2 - 2
packages/arosunits/src/amigados.pas

@@ -2265,14 +2265,14 @@ function Cli: PCommandLineInterface; syscall AOS_DOSBase 82;
 function CliInitNewcli(Dp: PDosPacket): IPTR; syscall AOS_DOSBase 155;
 function CliInitRun(Dp: PDosPacket): IPTR; syscall AOS_DOSBase 156;
 function CompareDates(const Date1: PDateStamp; const Date2: PDateStamp): LongInt; syscall AOS_DOSBase 123;
-function CreateDir(const Name: STRPTR): BPTR; syscall AOS_DOSBase 20;
+function DOSCreateDir(const Name: STRPTR): BPTR; syscall AOS_DOSBase 20;
 function CreateNewProc(const Tags: PTagItem): PProcess; syscall AOS_DOSBase 83;
   //function CreateNewProcTagList(const Tags : PTagItem) : pProcess;
 function CreateProc(const Name: STRPTR; Pri: LongInt; SegList: BPTR; StackSize: LongInt): PMsgPort; syscall AOS_DOSBase 23;
 function CurrentDir(Lock: BPTR): BPTR; syscall AOS_DOSBase 21;
 function DateStamp(Date: PDateStamp): PDateStamp; syscall AOS_DOSBase 32;
 function DateToStr(Datetime: PDateTime): LongBool; syscall AOS_DOSBase 124;
-function DeleteFile(const Name: STRPTR): LongBool; syscall AOS_DOSBase 12;
+function DOSDeleteFile(const Name: STRPTR): LongBool; syscall AOS_DOSBase 12;
 function DeleteVar(const Name: STRPTR; Flags: LongWord): LongInt; syscall AOS_DOSBase 152;
 function DeviceProc(const Name: STRPTR): PMsgPort; syscall AOS_DOSBase 29;
 function DisplayError(FormstStr: STRPTR; Flags: LongWord; Args: APTR): LongInt; syscall AOS_DOSBase 81;

+ 7 - 2
packages/fcl-process/fpmake.pp

@@ -30,8 +30,13 @@ begin
     P.SourcePath.Add('src');
     P.IncludePath.Add('src/unix',AllUnixOSes);
     P.IncludePath.Add('src/win',[win32,win64]);
-    P.IncludePath.Add('src/$(OS)',AllOSes-[win32,win64]-AllUnixOSes);
-    P.IncludePath.Add('src/dummy',AllOSes-[win32,win64]-AllUnixOSes);
+    P.IncludePath.Add('src/amicommon',AllAmigaLikeOSes);
+    P.IncludePath.Add('src/$(OS)',AllOSes-[win32,win64]-AllUnixOSes-AllAmigaLikeOSes);
+    P.IncludePath.Add('src/dummy',AllOSes-[win32,win64]-AllUnixOSes-AllAmigaLikeOSes);
+    
+    P.Dependencies.add('morphunits',[morphos]);
+    P.Dependencies.add('arosunits',[aros]);
+    P.Dependencies.add('amunits',[amiga]);
 
     T:=P.Targets.AddUnit('pipes.pp');
       T.Dependencies.AddInclude('pipes.inc');

+ 57 - 0
packages/fcl-process/src/amicommon/pipes.inc

@@ -0,0 +1,57 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt
+
+    DOS/go32v2 specific part of pipe stream.
+
+    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.
+
+ **********************************************************************}
+
+uses
+  exec, AmigaDos;
+
+// No pipes under dos, sorry...
+
+Function CreatePipeHandles (Var Inhandle,OutHandle : THandle; APipeBufferSize : Cardinal = 1024) : Boolean;
+begin
+  InHandle := THandle (UnusedHandle);
+  OutHandle := THandle (UnusedHandle);
+  Result := False;
+end;
+
+
+Function TInputPipeStream.GetNumBytesAvailable: DWord;
+
+begin
+  Result := 0;
+end;
+
+function TInputPipeStream.GetPosition: Int64;
+begin
+  Result:=FPos;
+end;
+
+procedure TInputPipeStream.InvalidSeek;
+begin
+  Raise EPipeSeek.Create (ENoSeekMsg);
+end;
+
+procedure PipeClose (const FHandle: THandle);
+var
+  Filename: array[0..255] of Char;
+  DeleteIt: Boolean;
+begin
+  if (FHandle <> UnusedHandle) and (FHandle <> 0) then
+  begin
+   DeleteIt := NameFromFH(BPTR(FHandle), @(Filename[0]), 255);
+   FileClose(FHandle);
+   if DeleteIt then
+     AmigaDos.dosDeleteFile(@(Filename[0]));
+ end;  
+end;

+ 165 - 0
packages/fcl-process/src/amicommon/process.inc

@@ -0,0 +1,165 @@
+{
+  Dummy process.inc - the simplest version based on SysUtils.ExecuteProcess
+}
+
+uses
+  Exec, AmigaDos, Utility;
+
+Resourcestring
+  SNoCommandLine        = 'Cannot execute empty command-line';
+  SErrCannotExecute     = 'Failed to execute %s : %d';
+  SErrNoSuchProgram     = 'Executable not found: "%s"';
+
+
+procedure TProcess.CloseProcessHandles;
+begin
+end;
+
+Function TProcess.PeekExitStatus : Boolean;
+begin
+  Result := true; (* Dummy version assumes always synchronous execution *)
+end;
+
+function GetNextWordPos (const S: string): integer;
+const
+  WhiteSpace = [' ', #9, #10, #13];
+  Literals = ['"', ''''];
+var
+  WStart: integer;
+  InLiteral: boolean;
+  LastLiteral: char;
+begin
+  WStart := 1;
+(* Skip whitespaces at the beginning *)
+  while (WStart <= Length (S)) and (S [WStart] in WhiteSpace) do
+   Inc (WStart);
+  InLiteral := false;
+  LastLiteral := #0;
+  while (WStart <= Length (S)) and
+                               (not (S [WStart] in WhiteSpace) or InLiteral) do
+   begin
+    if S [WStart] in Literals then
+     if InLiteral then
+      InLiteral := not (S [WStart] = LastLiteral)
+     else
+      begin
+       InLiteral := true;
+       LastLiteral := S [WStart];
+      end;
+     Inc (WStart);
+    end;
+(* Skip whitespaces at the end *)
+  while (WStart <= Length (S)) and (S [WStart] in WhiteSpace) do
+   Inc (WStart);
+  Result := WStart;
+end;
+
+function MaybeQuote (const S: string): string;
+begin
+  if (Pos (' ', S) <> 0) then
+   Result := '"' + S + '"'
+  else
+   Result := S;
+end;
+
+var
+  UID: Integer = 0;
+
+Procedure TProcess.Execute;
+var
+  I: integer;
+  ExecName, FoundName: string;
+  E2: EProcess;
+  OrigDir: string;
+  Params: string;
+  TempName: string;
+  cos: BPTR;
+begin
+  if (ApplicationName = '') and (CommandLine = '') and (Executable = '') then
+   raise EProcess.Create (SNoCommandline);
+  if (FApplicationName <> '') then
+   ExecName := FApplicationName;
+  if (FCommandLine <> '') then
+   begin
+    Params := FCommandLine;
+    if ExecName = '' then
+     begin
+      I := GetNextWordPos (Params);
+      ExecName := Copy (Params, 1, Pred (I));
+      Trim (ExecName);
+      Delete (Params, 1, Pred (I));
+     end
+    else if Copy (FCommandLine, 1, Length (ExecName)) = ExecName then
+     Delete (Params, 1, Succ (Length (ExecName)))
+    else
+     Delete (Params, 1, Pred (GetNextWordPos (Params)));
+    Trim (Params);
+   end
+  else
+   for I := 0 to Pred (Parameters.Count) do
+    Params := Params + ' ' + MaybeQuote (Parameters [I]);
+  if (FExecutable <> '') and (ExecName = '') then
+   ExecName := Executable;
+  if not FileExists (ExecName) then
+   begin
+    FoundName := ExeSearch (ExecName, '');
+    if FoundName <> '' then
+     ExecName := FoundName
+    else
+     raise EProcess.CreateFmt (SErrNoSuchProgram, [ExecName]);
+   end;
+  if (FCurrentDirectory <> '') then
+   begin
+    GetDir (0, OrigDir);
+    ChDir (FCurrentDirectory);
+   end;
+  try   
+   cos := BPTR(0);
+   repeat
+     Inc(UID);
+     TempName := 'T:'+HexStr(FindTask(nil)) + '_'  + HexStr(Self) + '_'+ IntToStr(UID) + '_Starter.tmp';
+   until not FileExists(TempName);   
+   //sysdebugln('TProcess start: "' + ExecName + ' ' + Params+'"  >' + TempName);
+   cos := AmigaDos.DosOpen(PChar(TempName), MODE_READWRITE);
+   FExitCode := LongInt(amigados.Execute(PChar(ExecName + ' ' + Params), BPTR(0), cos));
+   DosSeek(cos, 0, OFFSET_BEGINNING);
+   CreateStreams(0, THandle(cos),0);
+   //FExitCode := ExecuteProcess (ExecName, Params);
+  except
+(* Normalize the raised exception so that it is aligned to other platforms. *)
+    On E: EOSError do
+     begin
+      raise EProcess.CreateFmt (SErrCannotExecute, [FCommandLine, E.ErrorCode]);
+      if (FCurrentDirectory <> '') then
+       ChDir (OrigDir);
+      end;
+  end;
+  if (FCurrentDirectory <> '') then
+   ChDir (OrigDir);
+end;
+
+Function TProcess.WaitOnExit : Boolean;
+begin
+  Result:=True;
+end;
+
+Function TProcess.Suspend : Longint;
+begin
+  Result:=0;
+end;
+
+Function TProcess.Resume : LongInt;
+begin
+  Result:=0;
+end;
+
+Function TProcess.Terminate(AExitCode : Integer) : Boolean;
+begin
+  Result:=False;
+end;
+
+Procedure TProcess.SetShowWindow (Value : TShowWindowOptions);
+begin
+end;
+
+

+ 258 - 0
packages/fcl-process/src/amicommon/simpleipc.inc

@@ -0,0 +1,258 @@
+{
+  Amiga style simpleipc.inc
+}
+
+{$DEFINE OSNEEDIPCINITDONE}
+
+uses
+  Exec, dos;
+
+ResourceString
+  SErrMsgPortExists = 'MsgPort already exists: %s';
+
+const
+  PORTNAMESTART = 'fpc_';
+
+Var
+  MsgPorts: Classes.TList;
+
+procedure AddMsgPort(AMsgPort: PMsgPort);
+begin
+  if Assigned(MsgPorts) then
+  begin
+    MsgPorts.Add(AMsgPort);
+  end;
+end;
+
+procedure RemoveMsgPort(AMsgPort: PMsgPort);
+var
+  Idx: Integer;
+begin
+  if Assigned(MsgPorts) then
+  begin
+    Idx := MsgPorts.IndexOf(AMsgPort);
+    if Idx >= 0 then
+    begin
+      MsgPorts.Delete(Idx);
+      if Assigned(AMsgPort^.mp_Node.ln_Name) and (string(AMsgPort^.mp_Node.ln_Name) <> '') and Assigned(FindPort(AMsgPort^.mp_Node.ln_Name)) then
+        RemPort(AMsgPort);
+      DeleteMsgPort(AMsgPort);
+    end;  
+  end;
+end;
+
+
+procedure IPCInit;
+begin
+  MsgPorts := Classes.TList.Create;
+end;
+
+procedure IPCDone;
+var
+  I: integer;
+begin
+  try
+    for i := 0 to MsgPorts.Count - 1 do
+        RemoveMsgPort(PMsgPort(MsgPorts[i]));
+    finally  
+      FreeAndNil(MsgPorts);  
+    end;  
+end;
+
+
+Type
+  TAmigaClientComm = Class(TIPCClientComm)
+  Private
+    FMsgPort: PMsgPort;
+    FPortName: String;
+  Public
+    Constructor Create(AOwner: TSimpleIPCClient); override;
+    Procedure Connect; override;
+    Procedure Disconnect; override;
+    Procedure SendMessage(MsgType : TMessageType; AStream : TStream); override;
+    //Function  ServerRunning : Boolean; override;
+  end;
+
+  TAmigaServerComm = Class(TIPCServerComm)
+  Private
+    FMsgPort: PMsgPort;
+    FPortName: String;
+    MsgBody: PMessage;
+  Public
+    Constructor Create(AOwner: TSimpleIPCServer); override;
+    destructor Destroy; override;
+    Procedure StartServer; override;
+    Procedure StopServer; override;
+    Function  PeekMessage(TimeOut : Integer) : Boolean; override;
+    Procedure ReadMessage ; override;
+    Function GetInstanceID : String;override;
+  end;
+  
+// ####### CLIENT  
+  
+function SafePutToPort(Msg: PMessage; Portname: string): Integer;
+ var
+   Port: PMsgPort;
+   PName: PChar;
+ begin
+   Result := -1;
+   PName := PChar(Portname + #0);
+   Forbid();
+   Port := FindPort(PName);
+   if Assigned(Port) then
+   begin
+     PutMsg(Port, Msg);
+     Result := 0;
+   end;
+   Permit();
+ end;
+
+Constructor TAmigaClientComm.Create(AOwner: TSimpleIPCClient);
+begin
+  inherited;
+end;
+
+Procedure TAmigaClientComm.Connect;
+begin
+ 
+end;
+
+Procedure TAmigaClientComm.Disconnect;
+begin
+  
+end;
+
+Procedure TAmigaClientComm.SendMessage(MsgType : TMessageType; AStream : TStream);
+var
+  Size: Integer;
+  FullSize: Integer;
+  Memory: Pointer;
+  Temp: PByte;
+  MsgHead: Exec.PMessage;
+  MP: PMsgPort;
+  PortName: string;
+begin
+  Size := AStream.Size - AStream.Position;
+  FullSize := Size + Sizeof(Exec.TMessage);
+  PortName := PORTNAMESTART + Owner.ServerID;
+  Memory := System.AllocMem(FullSize);
+  MP := CreateMsgPort;
+  try
+    MsgHead := Memory;
+    MsgHead^.mn_ReplyPort := MP;
+    MsgHead^.mn_Length := Size;
+    Temp := Memory;
+    Inc(Temp, SizeOf(Exec.TMessage));
+    AStream.Read(Temp^, Size);
+    if SafePutToPort(MsgHead, PortName) = 0 then
+      WaitPort(MP);
+  finally
+    System.FreeMem(Memory);
+    DeleteMsgPort(MP);
+  end;
+end;
+
+// ###### SERVER
+
+Constructor TAmigaServerComm.Create(AOwner: TSimpleIPCServer);
+begin
+  inherited;
+  FMsgPort := CreateMsgPort;
+  AddMsgPort(FMsgPort);
+  MsgBody := nil;
+end;
+
+destructor TAmigaServerComm.Destroy;
+begin
+  if Assigned(MsgBody) then
+    System.FreeMem(MsgBody);
+  RemoveMsgPort(FMsgPort);
+  inherited;
+end;
+
+Procedure TAmigaServerComm.StartServer;
+begin
+  FPortName := PORTNAMESTART + Owner.ServerID + #0;
+  if Assigned(FindPort(PChar(FPortName))) then
+  begin
+    DoError(SErrMsgPortExists,[FPortName]);
+    Exit;
+  end;
+  FMsgPort^.mp_Node.ln_Name := PChar(FPortName);
+  FMsgPort^.mp_Node.ln_Pri := 0;
+  AddPort(FMsgPort);
+  if Assigned(MsgBody) then
+    System.FreeMem(MsgBody); 
+  MsgBody := nil;
+end;
+
+Procedure TAmigaServerComm.StopServer;
+begin
+  RemPort(FMsgPort);
+  if Assigned(MsgBody) then
+    System.FreeMem(MsgBody);
+  MsgBody := nil;
+end;
+
+Function TAmigaServerComm.PeekMessage(TimeOut : Integer) : Boolean;
+var
+  Msg: PMessage;
+  Temp: PByte;
+  StartTime: Int64;
+begin
+  StartTime := GetMsCount;
+  Result := False;
+  if TimeOut < 0 then
+    TimeOut := MaxInt;
+  repeat
+    Msg := GetMsg(FMsgPort);
+    if Assigned(Msg) then
+    begin
+      Result := True;
+      Temp := PByte(Msg);
+      Inc(Temp, SizeOf(Exec.TMessage));
+      if Assigned(MsgBody) then
+        System.FreeMem(MsgBody);
+      MsgBody := System.AllocMem(SizeOf(Exec.TMessage) + Msg^.mn_Length);
+      Move(Msg^, MsgBody^, SizeOf(Exec.TMessage) + Msg^.mn_Length);
+      ReplyMsg(Msg);
+      break;
+    end;
+    Sleep(25);
+  until GetMsCount - StartTime >= TimeOut;
+end;
+
+Procedure TAmigaServerComm.ReadMessage;
+var
+  Temp: PByte;
+begin
+  if Assigned(MsgBody) then
+  begin
+    Temp := Pointer(MsgBody);
+    Inc(Temp, SizeOf(Exec.TMessage));
+    Owner.FMsgType := mtString;
+    Owner.FMsgData.Size := 0;
+    Owner.FMsgData.Seek(0, soFrombeginning);
+    Owner.FMsgData.WriteBuffer(temp^, MsgBody^.mn_Length);
+    System.FreeMem(MsgBody);
+    MsgBody := nil;
+  end;
+end;
+
+Function TAmigaServerComm.GetInstanceID: String;
+begin
+  Result := HexStr(FindTask(nil));
+end;
+
+// ###### Register
+
+Function TSimpleIPCServer.CommClass : TIPCServerCommClass;
+begin
+  Result:=TAmigaServerComm;
+end;
+
+function TSimpleIPCClient.CommClass: TIPCClientCommClass;
+begin
+  Result:=TAmigaClientComm;
+end;
+

+ 1 - 1
packages/morphunits/src/amigados.pas

@@ -1392,7 +1392,7 @@ type
 
 { dos.library functions }
 
-function Open(fname     : PChar   location 'd1';
+function dosOpen(fname     : PChar   location 'd1';
               accessMode: LongInt location 'd2'): LongInt;
 SysCall MOS_DOSBase 30;
 

+ 4 - 5
rtl/amiga/system.pp

@@ -360,11 +360,13 @@ begin
   if AOS_wbMsg=nil then begin
     StdInputHandle:=dosInput;
     StdOutputHandle:=dosOutput;
+    StdErrorHandle:=StdOutputHandle;
   end else begin
     AOS_ConHandle:=Open(AOS_ConName,MODE_OLDFILE);
     if AOS_ConHandle<>0 then begin
       StdInputHandle:=AOS_ConHandle;
       StdOutputHandle:=AOS_ConHandle;
+      StdErrorHandle:=AOS_ConHandle;
     end else
       Halt(1);
   end;
@@ -377,11 +379,8 @@ begin
   OpenStdIO(Output,fmOutput,StdOutputHandle);
   OpenStdIO(StdOut,fmOutput,StdOutputHandle);
 
-  { * AmigaOS doesn't have a separate stderr * }
-
-  StdErrorHandle:=StdOutputHandle;
-  //OpenStdIO(StdErr,fmOutput,StdErrorHandle);
-  //OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
 end;
 
 function GetProcessID: SizeUInt;

+ 8 - 3
rtl/aros/system.pp

@@ -121,9 +121,6 @@ begin
   Killed := True;
   { Closing opened files }
   CloseList(ASYS_fileList);
-  //
-  if AOS_wbMsg <> nil then
-    ReplyMsg(AOS_wbMsg);
   { Changing back to original directory if changed }
   if ASYS_OrigDir <> 0 then begin
     oldDirLock:=CurrentDir(ASYS_origDir);
@@ -142,6 +139,14 @@ begin
     CloseLibrary(AOS_DOSBase);
   AOS_DOSBase := nil;
   //
+  if AOS_wbMsg <> nil then
+  begin
+    // forbid -> Amiga RKM Libraries Manual 
+    Forbid();
+    // Reply WBStartupMessage
+    ReplyMsg(AOS_wbMsg);
+  end;
+  //
   HaltProc(ExitCode);
 end;
 

+ 2 - 18
rtl/inc/fexpand.inc

@@ -479,7 +479,7 @@ begin
 {$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
 
 {$IFDEF FPC_FEXPAND_UPDIR_HELPER}
-    (* Now remove all references to '//' plus previous directories... *)
+    { Now remove all references to '//' or '::' plus previous directories... }
     I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
     while I <> 0 do
         begin
@@ -507,22 +507,6 @@ begin
         end;
 {$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
 
-{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
-    (* Remove a possible reference to '/' at the *)
-    (* end of line plus the previous directory.  *)
-    I := Length (Dirs);
-    if (I > 0) and (Dirs [I] = DirectorySeparator) then
-        begin
-            J := Pred (I);
-            while (J > 0) and (Dirs [J] <> DirectorySeparator) do
-                Dec (J);
-            if (J = 0) then
-                Dirs := ''
-            else
-                Delete (Dirs, J, Succ (I - J));
-        end;
-{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
-
 {$IFNDEF FPC_FEXPAND_NO_CURDIR}
  {$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
     {...and also a possible reference to '\.'}
@@ -666,7 +650,7 @@ end;
    parent directory and so on (Amiga). Please, note that you can decide
    to support both '..' and DirectorySeparator as references to the parent
    directory at the same time for compatibility reasons - however this
-   support makes it impossible to use anotherwise possibly valid name
+   support makes it impossible to use otherwise possibly valid name
    of '..'.
 
    FPC_FEXPAND_DIRSEP_IS_CURDIR - DirectorySeparator at the beginning of

+ 4 - 4
rtl/morphos/system.pp

@@ -372,11 +372,13 @@ begin
    MOS_ConHandle:=0;
    StdInputHandle:=dosInput;
    StdOutputHandle:=dosOutput;
+   StdErrorHandle:=StdOutputHandle;
  end else begin
    MOS_ConHandle:=Open(MOS_ConName,MODE_OLDFILE);
    if MOS_ConHandle<>0 then begin
      StdInputHandle:=MOS_ConHandle;
      StdOutputHandle:=MOS_ConHandle;
+     StdErrorHandle:=MOS_ConHandle;
    end else
      Halt(1);
  end;
@@ -389,10 +391,8 @@ begin
   OpenStdIO(Output,fmOutput,StdOutputHandle);
   OpenStdIO(StdOut,fmOutput,StdOutputHandle);
 
-  { * MorphOS doesn't have a separate stderr, just like AmigaOS (???) * }
-  StdErrorHandle:=StdOutputHandle;
-  // OpenStdIO(StdErr,fmOutput,StdErrorHandle);
-  // OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
 end;
 
 function GetProcessID: SizeUInt;

+ 44 - 31
tests/test/units/dos/tfexpand.pp

@@ -59,9 +59,16 @@ uses
 {$ENDIF LINUX}
 
 {$IFDEF AMIGA}
+ {$IFNDEF HASAMIGA}
+  {$DEFINE HASAMIGA}
+ {$ENDIF HASAMIGA}
+{$ENDIF AMIGA}
+
+{$IFDEF HASAMIGA}
  {$DEFINE VOLUMES}
  {$DEFINE NODRIVEC}
-{$ENDIF AMIGA}
+ {$DEFINE NODOTS}
+{$ENDIF HASAMIGA}
 
 {$IFDEF NETWARE}
  {$DEFINE VOLUMES}
@@ -103,13 +110,13 @@ const
  DriveSeparator = '/';
  FileNameCasePreserving = true;
    {$ELSE UNIX}
-    {$IFDEF AMIGA}
- DirectorySeparator = ':';
+    {$IFDEF HASAMIGA}
+ DirectorySeparator = '/';
  FileNameCasePreserving = true;
-    {$ELSE AMIGA}
+    {$ELSE HASAMIGA}
  DirectorySeparator = '\';
  FileNameCasePreserving = false;
-    {$ENDIF AMIGA}
+    {$ENDIF HASAMIGA}
    {$ENDIF UNIX}
   {$ENDIF MACOS}
  {$ENDIF DIRECT}
@@ -117,11 +124,7 @@ const
  {$IFDEF MACOS}
  DriveSep = '';
  {$ELSE MACOS}
-  {$IFDEF AMIGA}
- DriveSep = '';
-  {$ELSE AMIGA}
  DriveSep = DriveSeparator;
-  {$ENDIF AMIGA}
  {$ENDIF MACOS}
  {$IFDEF UNIX}
  CDrive = '';
@@ -129,11 +132,11 @@ const
   {$IFDEF MACOS}
  CDrive = 'C';
   {$ELSE MACOS}
-   {$IFDEF AMIGA}
+   {$IFDEF HASAMIGA}
  CDrive = 'C';
-   {$ELSE AMIGA}
+   {$ELSE HASAMIGA}
  CDrive = 'C:';
-   {$ENDIF AMIGA}
+   {$ENDIF HASAMIGA}
   {$ENDIF MACOS}
  {$ENDIF UNIX}
 {$ENDIF FPC}
@@ -289,11 +292,11 @@ begin
  GetDir (3, CDir);
 {$ENDIF NODRIVEC}
  Check (' ', CurDir + DirSep + ' ');
-{$IFDEF AMIGA}
+{$IFDEF HASAMIGA}
  Check ('', CurDir);
-{$ELSE AMIGA}
+{$ELSE HASAMIGA}
  Check ('', CurDir + DirSep);
-{$ENDIF AMIGA}
+{$ENDIF HASAMIGA}
 {$IFDEF MACOS}
  Check (':', CurDir + DirSep);
 {$ELSE MACOS}
@@ -304,26 +307,26 @@ begin
 if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
                          else Check ('c:anything', CDir + DirSep + 'anything');
  Check (CC + DirSep, CDrive + DirSep);
-{$IFDEF NODOTS}
+ {$IFDEF NODOTS}
  Check ('C:.', 'C:.');
  Check (CC + DirSep + '.', CDrive + DirSep + '.');
  Check (CC + DirSep + '..', CDrive + DirSep + '..');
-{$ELSE NODOTS}
+ {$ELSE NODOTS}
  Check ('C:.', CDir);
  Check (CC + DirSep + '.', CDrive + DirSep);
  Check (CC + DirSep + '..', CDrive + DirSep);
-{$ENDIF NODOTS}
+ {$ENDIF NODOTS}
  Check (CC + DirSep + 'DOS', CDrive + DirSep + 'DOS');
-{$IFNDEF NODOTS}
+ {$IFNDEF NODOTS}
  Check (CC + DirSep + '..' + DirSep + 'DOS', CDrive + DirSep + 'DOS');
-{$ENDIF NODOTS}
+ {$ENDIF NODOTS}
  Check (CC + DirSep + 'DOS.', CDrive + DirSep + 'DOS.');
-{$IFDEF AMIGA}
+ {$IFDEF HASAMIGA} (* This has no effect - AMIGA has NODRIVEC defined... *)
  Check (CC + DirSep + 'DOS' + DirSep, CDrive + DirSep);
-{$ELSE AMIGA}
+ {$ELSE HASAMIGA}
  Check (CC + DirSep + 'DOS' + DirSep, CDrive + DirSep + 'DOS' + DirSep);
-{$ENDIF AMIGA}
-{$IFNDEF NODOTS}
+ {$ENDIF HASAMIGA}
+ {$IFNDEF NODOTS}
  Check (CC + DirSep + 'DOS' + DirSep + '.', CDrive + DirSep + 'DOS');
  Check (CC + DirSep + 'DOS' + DirSep + '..', CDrive + DirSep);
  Check (CC + DirSep + 'DOS' + DirSep + '..' + DirSep, CDrive + DirSep);
@@ -331,14 +334,20 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
                                                                DirSep + 'DOS');
  Check ('C:' + DirSep + 'DOS' + DirSep + 'TEST' + DirSep + '..' + DirSep,
                                              CDrive + DirSep + 'DOS' + DirSep);
-{$ENDIF NODOTS}
+ {$ENDIF NODOTS}
 {$ENDIF NODRIVEC}
 
 {$IFNDEF MACOS}
+ {$IFDEF HASAMIGA}
+ Check (DirSep, TestDir + TestDir1Name);
+ Check (DirSep + DirSep + TestFileName, TestDir + TestFileName);
+ Check (DirSep + 'DOS', TestDir + TestDir1Name + DirSep + 'DOS');
+ {$ELSE HASAMIGA}
  Check (DirSep, TestDrive + DirSep);
  Check (DirSep + '.', TestDrive + DirSep);
  Check (DirSep + '..', TestDrive + DirSep);
  Check (DirSep + 'DOS', TestDrive + DirSep + 'DOS');
+ {$ENDIF HASAMIGA}
 {$ENDIF MACOS}
  Check ('d', CurDir + DirSep + 'd');
 {$IFDEF MACOS}
@@ -367,15 +376,15 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
  Check ('.special', CurDir + DirSep + '.special');
  Check ('..special', CurDir + DirSep + '..special');
  Check ('special..', CurDir + DirSep + 'special..');
-{$IFDEF AMIGA}
- Check ('special.' + DirSep, CurDir);
-{$ELSE AMIGA}
+{$IFDEF HASAMIGA}
+ Check ('special.' + DirSep, CurDir + DirSep + 'special.' + DirSep);
+{$ELSE HASAMIGA}
  {$IFDEF MACOS}
  Check ('special.' + DirSep, 'special.' + DirSep);
  {$ELSE MACOS}
  Check ('special.' + DirSep, CurDir + DirSep + 'special.' + DirSep);
  {$ENDIF MACOS}
-{$ENDIF AMIGA}
+{$ENDIF HASAMIGA}
 {$IFDEF MACOS}
  Check (DirSep + DirSep, TestDir + TestDir1Name + DirSep);
  Check (DirSep + DirSep + TestFileName, TestDir + TestDir1Name + DirSep
@@ -481,7 +490,11 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
  {$ENDIF NODRIVEC}
 {$ENDIF UNIX}
 {$IFDEF VOLUMES}
+ {$IFDEF HASAMIGA}
+ Check ('VolName' + DriveSep + 'DIR1', 'VolName' + DriveSep + 'DIR1');
+ {$ELSE HASAMIGA}
  Check ('VolName' + DriveSep + DirSep + 'DIR1', 'VolName' + DriveSep + DirSep + 'DIR1');
+ {$ENDIF HASAMIGA}
  {$IFNDEF NODOTS}
  Check ('VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..', 'VolName' + DriveSep + DirSep);
  Check ('VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..' + DirSep + '..',
@@ -496,13 +509,13 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
  Check ('SrvName/VolName' + DriveSep + DirSep + 'TEST', 'SrvName' + DirSep + 'VolName' +
                                                          DriveSep + DirSep + 'TEST');
  {$ENDIF NETWARE}
- {$IFDEF AMIGA}
+ {$IFDEF HASAMIGA}
   {$IFDEF NODOTS}
  Check ('.', CurDir + DirSep + '.');
   {$ELSE NODOTS}
  Check ('.', CurDir);
   {$ENDIF NODOTS}
- {$ENDIF AMIGA}
+ {$ENDIF HASAMIGA}
 {$ENDIF VOLUMES}
  Erase (F);
 {$IFNDEF NODRIVEC}