+ 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: trunk@23156 -

.gitattributes

@@ -11692,6 +11692,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

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}

tests/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/09/22]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/12/16]
 #
 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 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 powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux jvm-java jvm-android
@@ -2081,7 +2081,7 @@ export LOG:=$(TEST_OUTPUTDIR)/log
 endif
 LOGFILES=$(TEST_OUTPUTDIR)/log $(TEST_OUTPUTDIR)/longlog $(TEST_OUTPUTDIR)/faillist
 LOGEXT=.testlog .tbslog .tbflog .webtbslog .webtbflog
-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/lineinfo
+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/lineinfo 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

tests/Makefile.fpc

@@ -146,7 +146,7 @@ LOGFILES=$(TEST_OUTPUTDIR)/log $(TEST_OUTPUTDIR)/longlog $(TEST_OUTPUTDIR)/faill
 LOGEXT=.testlog .tbslog .tbflog .webtbslog .webtbflog
 
 # 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 units/lineinfo
+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/lineinfo 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

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.