浏览代码

Merged revisions 10809-10810,10830-10832,10837,10848,10858,10860,10862-10864,10875,10882,10891,10907,10909,10915-10916,10922-10923,10928,10930,10933,10935,10939,10942,10948-10949 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

........
r10809 | jonas | 2008-04-26 23:29:45 +0200 (Sa, 26 Apr 2008) | 2 lines

+ test for md2/md4/md5 based on the md* example program
........
r10810 | jonas | 2008-04-26 23:34:44 +0200 (Sa, 26 Apr 2008) | 2 lines

* also test test/packages/hash
........
r10949 | florian | 2008-05-12 11:15:39 +0200 (Mo, 12 Mai 2008) | 2 lines

+ added overload directive as requested by Paul
........

git-svn-id: branches/fixes_2_2@10954 -

florian 17 年之前
父节点
当前提交
15f4dfcc74

+ 2 - 0
.gitattributes

@@ -7187,6 +7187,8 @@ tests/test/opt/treg3.pp svneol=native#text/plain
 tests/test/opt/treg4.pp svneol=native#text/plain
 tests/test/opt/tretopt.pp svneol=native#text/plain
 tests/test/opt/tspace.pp svneol=native#text/plain
+tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
+tests/test/packages/hash/tmdtest.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw1808.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw3820.pp svneol=native#text/plain
 tests/test/packages/win-base/tdispvar1.pp svneol=native#text/plain

+ 2 - 2
packages/fcl-registry/src/registry.pp

@@ -69,7 +69,7 @@ type
     procedure SetCurrentKey(Value: HKEY);
   public
     constructor Create; overload;
-    constructor Create(aaccess:longword);
+    constructor Create(aaccess:longword); overload;
     destructor Destroy; override;
 
     function CreateKey(const Key: string): Boolean;
@@ -133,7 +133,7 @@ type
     fFileName: String;
     fPath    : String;
   public
-    constructor Create(const FN: string);
+    constructor Create(const FN: string); overload;
     constructor Create(const FN: string;aaccess:longword); overload;
     function ReadString(const Section, Ident, Default: string): string;
     function ReadInteger(const Section, Ident: string;

+ 1 - 1
tests/Makefile

@@ -1430,7 +1430,7 @@ ifndef LOG
 export LOG:=$(TEST_OUTPUTDIR)/log
 endif
 TESTSUBDIRS=cg cg/variants cg/cdecl opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem
-TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs
+TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry
 ifdef QUICKTEST
 export QUICKTEST
 else

+ 1 - 1
tests/Makefile.fpc

@@ -123,7 +123,7 @@ endif
 
 # Subdirs available in the test subdir
 TESTSUBDIRS=cg cg/variants cg/cdecl opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem
-TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs
+TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry
 
 ifdef QUICKTEST
 export QUICKTEST

+ 8 - 0
tests/test/packages/fcl-registry/tregistry1.pp

@@ -0,0 +1,8 @@
+uses
+  registry;
+var
+  fReg: TRegIniFile;
+begin
+  fReg := TRegIniFile.Create;
+  fReg.Free;
+end.

+ 100 - 0
tests/test/packages/hash/tmdtest.pp

@@ -0,0 +1,100 @@
+{
+    This file is part of the Free Pascal packages.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Tests the MD5 program.
+
+    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.
+
+ **********************************************************************}
+
+program mdtest;
+
+{$h+}
+
+uses
+  md5;
+
+var
+  error: boolean;
+
+const
+  Suite: array[1..7] of string = (
+    '',
+    'a',
+    'abc',
+    'message digest',
+    'abcdefghijklmnopqrstuvwxyz',
+    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789',
+    '12345678901234567890123456789012345678901234567890123456789012345678901234567890'
+    );
+
+  Results: array[TMDVersion, Low(Suite)..High(Suite)] of string = (
+    // MD_VERSION_2
+    ('8350e5a3e24c153df2275c9f80692773',
+     '32ec01ec4a6dac72c0ab96fb34c0b5d1',
+     'da853b0d3f88d99b30283a69e6ded6bb',
+     'ab4f496bfb2a530b219ff33031fe06b0',
+     '4e8ddff3650292ab5a4108c3aa47940b',
+     'da33def2a42df13975352846c30338cd',
+     'd5976f79d83d3a0dc9806c3c66f3efd8'),
+
+    // MD_VERSION_4
+    ('31d6cfe0d16ae931b73c59d7e0c089c0',
+     'bde52cb31de33e46245e05fbdbd6fb24',
+     'a448017aaf21d8525fc10ae87aa6729d',
+     'd9130a8164549fe818874806e1c7014b',
+     'd79e1c308aa5bbcdeea8ed63df412da9',
+     '043f8582f241db351ce627e153e7f0e4',
+     'e33b4ddc9c38f2199c3e7b164fcc0536'),
+
+    // MD_VERSION_5
+    ('d41d8cd98f00b204e9800998ecf8427e',
+     '0cc175b9c0f1b6a831c399e269772661',
+     '900150983cd24fb0d6963f7d28e17f72',
+     'f96b697d7cb7938d525a2f31aaf161d0',
+     'c3fcd3d76192e4007dfb496cca67e13b',
+     'd174ab98d277d9f5a5611c2c9f419d9f',
+     '57edf4a22be3c955ac49da2e2107b67a')
+  );
+
+procedure performTest(const Ver: TMDVersion);
+var
+  I: Integer;
+  S: String;
+begin
+  for I := Low(Suite) to High(Suite) do
+  begin
+    S := LowerCase(MDPrint(MDString(Suite[I], Ver)));
+    if S = Results[Ver, I] then
+      Write('passed  ')
+    else
+      begin
+        error:=true;
+        Write('failed  ');
+      end;
+    WriteLn('  "', Suite[I], '" = ', S);
+  end;
+end;
+
+begin
+  error:=false;
+  Writeln('Executing RFC 1319 test suite ...');
+  performTest(MD_VERSION_2);
+  Writeln;
+
+  Writeln('Executing RFC 1320 test suite ...');
+  performTest(MD_VERSION_4);
+  Writeln;
+
+  Writeln('Executing RFC 1321 test suite ...');
+  performTest(MD_VERSION_5);
+  Writeln;
+  if (error) then
+    halt(1);
+end.