Просмотр исходного кода

--- Merging r23036 into '.':
U rtl/objpas/fgl.pp
--- Merging r23079 into '.':
U rtl/objpas/classes/persist.inc
--- Merging r23080 into '.':
U rtl/objpas/classes/classesh.inc
--- Merging r23088 into '.':
G rtl/objpas/classes/classesh.inc
--- Merging r23089 into '.':
G rtl/objpas/classes/persist.inc
U rtl/objpas/classes/lists.inc
--- Merging r23156 into '.':
C tests/Makefile
A tests/test/units/ucomplex
A tests/test/units/ucomplex/tcsqr1.pp
C tests/Makefile.fpc
U rtl/inc/ucomplex.pp
Summary of conflicts:
Text conflicts: 2

# revisions: 23036,23079,23080,23088,23089,23156
r23036 | svenbarth | 2012-11-19 20:23:58 +0100 (Mon, 19 Nov 2012) | 3 lines
Changed paths:
M /trunk/rtl/objpas/fgl.pp

rtl/objpas/fgl.pp:
Fix typo in comment; fixes Mantis #23352
r23079 | michael | 2012-11-29 14:22:51 +0100 (Thu, 29 Nov 2012) | 1 line
Changed paths:
M /trunk/rtl/objpas/classes/persist.inc

* Use sender when notifying observers
r23080 | michael | 2012-11-29 14:28:11 +0100 (Thu, 29 Nov 2012) | 1 line
Changed paths:
M /trunk/rtl/objpas/classes/classesh.inc

* IFPObserver methods made public
r23088 | michael | 2012-12-02 12:09:51 +0100 (Sun, 02 Dec 2012) | 1 line
Changed paths:
M /trunk/rtl/objpas/classes/classesh.inc

* Simplified observer/observed GUIDs, patch from Luiz Americo (Bug ID 23420)
r23089 | michael | 2012-12-02 12:14:49 +0100 (Sun, 02 Dec 2012) | 1 line
Changed paths:
M /trunk/rtl/objpas/classes/lists.inc
M /trunk/rtl/objpas/classes/persist.inc

* Applied and expanded patch from Luiz Americo to implement faster notifyobservers (bug ID 23419)
r23156 | florian | 2012-12-16 11:15:13 +0100 (Sun, 16 Dec 2012) | 5 lines
Changed paths:
M /trunk/rtl/inc/ucomplex.pp
M /trunk/tests/Makefile
M /trunk/tests/Makefile.fpc
A /trunk/tests/test/units/ucomplex
A /trunk/tests/test/units/ucomplex/tcsqr1.pp

+ patch by Vojtech Cihak to add csqr function, resolves #23492
+ init function for complex numbers
+ csamevalue function
+ test
+ run tests in units/ucomplex directory

git-svn-id: branches/fixes_2_6@24956 -

marco 12 лет назад
Родитель
Сommit
3b1bb241cd

+ 1 - 0
.gitattributes

@@ -10898,6 +10898,7 @@ tests/test/units/sysutils/tlocale.pp svneol=native#text/plain
 tests/test/units/sysutils/trwsync.pp svneol=native#text/plain
 tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain
 tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain
+tests/test/units/ucomplex/tcsqr1.pp svneol=native#text/pascal
 tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain
 tests/test/units/variants/tvararrayofintf.pp svneol=native#text/plain
 tests/test/uobjc24.pp svneol=native#text/plain

+ 21 - 1
rtl/inc/ucomplex.pp

@@ -155,6 +155,8 @@ Unit UComplex;
     inline;
     {$endif TEST_INLINE}
 
+    function cinit(_re,_im : real) : complex;inline;
+    function csamevalue(z1, z2 : complex) : boolean;
 
     { complex functions }
     function cong (z : complex) : complex;      { conjuge }
@@ -169,6 +171,7 @@ Unit UComplex;
     { fonctions elementaires }
     function cexp (z : complex) : complex;       { exponential }
     function cln (z : complex) : complex;        { natural logarithm }
+    function csqr (z: complex) : complex;        { square }
     function csqrt (z : complex) : complex;      { square root }
 
     { complex trigonometric functions  }
@@ -198,6 +201,17 @@ Unit UComplex;
 
   implementation
 
+    function cinit(_re,_im : real) : complex;inline;
+    begin
+      cinit.re:=_re;
+      cinit.im:=_im;
+    end;
+
+    function csamevalue(z1, z2: complex): boolean;
+    begin
+      csamevalue:=SameValue(z1.re, z2.re) and SameValue(z1.im, z2.im);
+    end;
+
   operator := (r : real) z : complex;
   {$ifdef TEST_INLINE}
   inline;
@@ -435,6 +449,13 @@ Unit UComplex;
        cln.im := arctan2(z.im, z.re);
     end;
 
+  function csqr(z: complex): complex;
+    { square : r := z*z }
+    begin
+      csqr.re := z.re * z.re - z.im * z.im;
+      csqr.im := 2 * z.re * z.im;
+    end;
+
   function csqrt (z : complex) : complex;
     { square root : r := sqrt(z) }
     var
@@ -633,7 +654,6 @@ Unit UComplex;
          cstr:=cstr+'+'+istr+'i';
     end;
 
-
 {$else}
 implementation
 {$endif FPUNONE}

+ 7 - 16
rtl/objpas/classes/classesh.inc

@@ -153,17 +153,8 @@ type
 
 
 Const
-  BaseGUIDObserved = '{663C603C-3F3C-4CC5-823C-AC8079F979E5}';
-  BaseGUIDObserver = '{BC7376EA-199C-4C2A-8684-F4805F0691CA}';
-
-  GUIDObserved : TGUID = BaseGUIDObserved;
-  GUIDObserver : TGUID = BaseGUIDObserver;
-
-  // String is needed for testing
-  SGUIDObserver = BaseGUIDObserver;
-  SGUIDObserved = BaseGUIDObserved;
-
-
+  SGUIDObserved = '{663C603C-3F3C-4CC5-823C-AC8079F979E5}';
+  SGUIDObserver = '{BC7376EA-199C-4C2A-8684-F4805F0691CA}';
 
 Type
   // Notification operations :
@@ -173,7 +164,7 @@ Type
 
   { IFPObserved }
 
-  IFPObserved = Interface [BaseGUIDObserved]
+  IFPObserved = Interface [SGUIDObserved]
     // attach a new observer
     Procedure FPOAttachObserver(AObserver : TObject);
     // Detach an observer
@@ -184,7 +175,7 @@ Type
 
   { IFPObserver }
 
-  IFPObserver = Interface  [BaseGUIDObserver]
+  IFPObserver = Interface  [SGUIDObserver]
     // Called by observed when observers are notified.
     Procedure FPOObservedChanged(ASender : TObject; Operation : TFPObservedOperation; Data : Pointer);
   end;
@@ -443,12 +434,12 @@ type
     procedure AssignTo(Dest: TPersistent); virtual;
     procedure DefineProperties(Filer: TFiler); virtual;
     function  GetOwner: TPersistent; dynamic;
-    Procedure FPOAttachObserver(AObserver : TObject);
-    Procedure FPODetachObserver(AObserver : TObject);
-    Procedure FPONotifyObservers(ASender : TObject; AOperation : TFPObservedOperation; Data : Pointer);
   public
     Destructor Destroy; override;
     procedure Assign(Source: TPersistent); virtual;
+    Procedure FPOAttachObserver(AObserver : TObject);
+    Procedure FPODetachObserver(AObserver : TObject);
+    Procedure FPONotifyObservers(ASender : TObject; AOperation : TFPObservedOperation; Data : Pointer);
     function  GetNamePath: string; virtual; {dynamic;}
   end;
 

+ 4 - 6
rtl/objpas/classes/lists.inc

@@ -667,7 +667,7 @@ begin
     Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
   If not Assigned(FObservers) then
     FObservers:=TFPList.Create;
-  FObservers.Add(AObserver);
+  FObservers.Add(I);
 end;
 
 procedure TList.FPODetachObserver(AObserver: TObject);
@@ -679,7 +679,7 @@ begin
     Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
   If Assigned(FObservers) then
     begin
-    FObservers.Remove(AObserver);
+    FObservers.Remove(I);
     If (FObservers.Count=0) then
       FreeAndNil(FObservers);
     end;
@@ -689,7 +689,6 @@ procedure TList.FPONotifyObservers(ASender: TObject;
   AOperation: TFPObservedOperation; Data : Pointer);
 
 Var
-  O : TObject;
   I : Integer;
   Obs : IFPObserver;
 
@@ -697,9 +696,8 @@ begin
   If Assigned(FObservers) then
     For I:=FObservers.Count-1 downto 0 do
       begin
-      O:=TObject(FObservers[i]);
-      If O.GetInterface(SGUIDObserver,Obs) then
-        Obs.FPOObservedChanged(Self,AOperation,Data);
+      Obs:=IFPObserver(FObservers[i]);
+      Obs.FPOObservedChanged(ASender,AOperation,Data);
       end;
 end;
 

+ 4 - 6
rtl/objpas/classes/persist.inc

@@ -68,7 +68,7 @@ begin
      Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
    If not Assigned(FObservers) then
      FObservers:=TFPList.Create;
-   FObservers.Add(AObserver);
+   FObservers.Add(I);
 end;
 
 procedure TPersistent.FPODetachObserver(AObserver: TObject);
@@ -80,7 +80,7 @@ begin
     Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
   If Assigned(FObservers) then
     begin
-    FObservers.Remove(AObserver);
+    FObservers.Remove(I);
     If (FObservers.Count=0) then
       FreeAndNil(FObservers);
     end;
@@ -89,7 +89,6 @@ end;
 procedure TPersistent.FPONotifyObservers(ASender: TObject;
   AOperation: TFPObservedOperation; Data : Pointer);
 Var
-  O : TObject;
   I : Integer;
   Obs : IFPObserver;
 
@@ -97,9 +96,8 @@ begin
   If Assigned(FObservers) then
     For I:=FObservers.Count-1 downto 0 do
       begin
-      O:=TObject(FObservers[i]);
-      If O.GetInterface(SGUIDObserver,Obs) then
-        Obs.FPOObservedChanged(Self,AOperation,Data);
+      Obs:=IFPObserver(FObservers[i]);
+      Obs.FPOObservedChanged(Self,AOperation,Data);
       end;
 end;
 

+ 1 - 1
rtl/objpas/fgl.pp

@@ -1241,7 +1241,7 @@ end;
 
 function TFPSMap.Find(AKey: Pointer; out Index: Integer): Boolean;
 { Searches for the first item <= Key, returns True if exact match,
-  sets index to the index f the found string. }
+  sets index to the index of the found string. }
 var
   I,L,R,Dir: Integer;
 begin

+ 64 - 9
tests/Makefile

@@ -1,10 +1,10 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2013/01/27]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2013-03-25 rev 23995]
 #
 default: allexectests
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux jvm-java jvm-android
 BSDs = freebsd netbsd openbsd darwin
-UNIXs = linux $(BSDs) solaris qnx haiku
+UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
@@ -178,6 +178,12 @@ else
 ARCH=$(CPU_TARGET)
 endif
 endif
+ifeq ($(FULL_TARGET),arm-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 TARGETSUFFIX=$(OS_TARGET)
 SOURCESUFFIX=$(OS_SOURCE)
@@ -203,6 +209,14 @@ endif
 ifeq ($(OS_TARGET),linux)
 linuxHier=1
 endif
+ifndef CROSSCOMPILE
+BUILDFULLNATIVE=1
+export BUILDFULLNATIVE
+endif
+ifdef BUILDFULLNATIVE
+BUILDNATIVE=1
+export BUILDNATIVE
+endif
 export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
 ifdef FPCDIR
 override FPCDIR:=$(subst \,/,$(FPCDIR))
@@ -252,7 +266,22 @@ ifndef BINUTILSPREFIX
 ifndef CROSSBINDIR
 ifdef CROSSCOMPILE
 ifndef DARWIN2DARWIN
+ifneq ($(CPU_TARGET),jvm)
 BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+ifeq ($(OS_TARGET),android)
+ifeq ($(CPU_TARGET),arm)
+BINUTILSPREFIX=arm-linux-androideabi-
+else
+ifeq ($(CPU_TARGET),i386)
+BINUTILSPREFIX=i686-linux-android-
+else
+ifeq ($(CPU_TARGET),mips)
+BINUTILSPREFIX=mipsel-linux-android-
+endif
+endif
+endif
+endif
+endif
 endif
 endif
 endif
@@ -515,6 +544,14 @@ SHAREDLIBEXT=.dll
 SHORTSUFFIX=wat
 IMPORTLIBPREFIX=
 endif
+ifneq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+endif
 ifeq ($(OS_TARGET),linux)
 BATCHEXT=.sh
 EXEEXT=
@@ -639,6 +676,25 @@ EXEEXT=.dol
 SHAREDLIBEXT=.so
 SHORTSUFFIX=wii
 endif
+ifeq ($(OS_TARGET),aix)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=aix
+endif
+ifeq ($(OS_TARGET),java)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=java
+endif
+ifeq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=android
+endif
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -860,7 +916,11 @@ AS=$(ASPROG)
 LD=$(LDPROG)
 RC=$(RCPROG)
 AR=$(ARPROG)
+ifdef inUnix
+PPAS=./ppas$(SRCBATCHEXT)
+else
 PPAS=ppas$(SRCBATCHEXT)
+endif
 ifdef inUnix
 LDCONFIG=ldconfig
 else
@@ -992,17 +1052,12 @@ endif
 endif
 ifdef CREATESHARED
 override FPCOPT+=-Cg
-ifeq ($(CPU_TARGET),i386)
-override FPCOPT+=-Aas
-endif
 endif
-ifeq ($(findstring 2.0.,$(FPC_VERSION)),)
 ifneq ($(findstring $(OS_TARGET),freebsd openbsd netbsd linux solaris),)
 ifeq ($(CPU_TARGET),x86_64)
 override FPCOPT+=-Cg
 endif
 endif
-endif
 ifdef LINKSHARED
 endif
 ifdef OPT
@@ -1340,7 +1395,7 @@ endif
 ifndef LOG
 export LOG:=$(TEST_OUTPUTDIR)/log
 endif
-TESTSUBDIRS=cg cg/variants cg/cdecl library opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem units/strutils units/matrix
+TESTSUBDIRS=cg cg/variants cg/cdecl library opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem units/strutils units/matrix units/ucomplex
 TESTPACKAGESUBDIRS=packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/fcl-process packages/zlib packages/fcl-db packages/fcl-base packages/fcl-xml packages/cocoaint packages/bzip2
 ifdef QUICKTEST
 export QUICKTEST

+ 1 - 1
tests/Makefile.fpc

@@ -135,7 +135,7 @@ endif
 
 
 # Subdirs available in the test subdir
-TESTSUBDIRS=cg cg/variants cg/cdecl library opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem units/strutils units/matrix
+TESTSUBDIRS=cg cg/variants cg/cdecl library opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem units/strutils units/matrix units/ucomplex
 TESTPACKAGESUBDIRS=packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/fcl-process packages/zlib packages/fcl-db packages/fcl-base packages/fcl-xml packages/cocoaint packages/bzip2
 
 ifdef QUICKTEST

+ 21 - 0
tests/test/units/ucomplex/tcsqr1.pp

@@ -0,0 +1,21 @@
+uses
+  ucomplex;
+
+var
+  c1,c2,c3 : complex;
+
+begin
+  c1:=cinit(1,1);
+  c2:=csqr(c1);
+  if c2.re<>0 then
+    halt(1);
+  if c2.im<>2 then
+   halt(1);
+
+  c3:=csqrt(c2);
+
+  if not csamevalue(c1,c3) then
+    halt(1);
+
+  writeln('ok');
+end.