aboutsummaryrefslogtreecommitdiffstats
path: root/medley_new/test
diff options
context:
space:
mode:
authorbrunzelchen <brunzelchen@b956fd51-792f-4845-bead-9b4dfca2ff2c>2010-10-14 18:02:35 +0000
committerbrunzelchen <brunzelchen@b956fd51-792f-4845-bead-9b4dfca2ff2c>2010-10-14 18:02:35 +0000
commit8782261d8fa6d2456d85b245b7d01824414b8d51 (patch)
tree0befc2a96e4dfea7d073f9beb83a310a9f6bdc9c /medley_new/test
parentd165a085eecd9f0d2e9d603de269941d1d30c620 (diff)
downloadusdx-8782261d8fa6d2456d85b245b7d01824414b8d51.tar.gz
usdx-8782261d8fa6d2456d85b245b7d01824414b8d51.tar.xz
usdx-8782261d8fa6d2456d85b245b7d01824414b8d51.zip
new medley branch, based on the actual (1.1) trunk. the old one will be deleted soon
git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/branches/experimental@2666 b956fd51-792f-4845-bead-9b4dfca2ff2c
Diffstat (limited to 'medley_new/test')
-rw-r--r--medley_new/test/TestPortAudioDevice.pas528
-rw-r--r--medley_new/test/TestSignAlgorithm.pas58
-rw-r--r--medley_new/test/switches.inc0
-rw-r--r--medley_new/test/test001.pas86
-rw-r--r--medley_new/test/test_libraries.lpi299
-rw-r--r--medley_new/test/test_libraries.lpr31
-rw-r--r--medley_new/test/testsqllite.pas84
7 files changed, 1086 insertions, 0 deletions
diff --git a/medley_new/test/TestPortAudioDevice.pas b/medley_new/test/TestPortAudioDevice.pas
new file mode 100644
index 00000000..ba394383
--- /dev/null
+++ b/medley_new/test/TestPortAudioDevice.pas
@@ -0,0 +1,528 @@
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * 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. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+program TestPortAudioDevice;
+
+{* TestPortAudioDevice does some basic tests of the portaudio libs.
+ * If all works, it lists all audio input and output devices and their
+ * characteristics. Compile and run with simple commands.
+ *}
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+uses
+ SysUtils,
+ ctypes,
+ crt,
+ math,
+ PortAudio in '../src/lib/portaudio/portaudio.pas';
+
+const
+ paDefaultApi = -1;
+
+ ApiPreferenceOrder:
+{$IF Defined(MSWINDOWS)}
+ // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment
+ // Note2: Windows Default-API is MME, but DirectSound is faster
+ array[0..0] of TPaHostApiTypeId = ( paDirectSound );
+{$ELSEIF Defined(DARWIN)}
+ array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); // paCoreAudio
+{$ELSEIF Defined(UNIX)}
+ // Note: Portmixer has no mixer support for JACK at the moment
+ array[0..2] of TPaHostApiTypeId = ( paALSA, paJACK, paOSS );
+{$ELSE}
+ array[0..0] of TPaHostApiTypeId = ( paDefaultApi );
+{$IFEND}
+
+ standardSampleRates: array[1..13] of cdouble =
+ ( 8000.0, 9600.0, 11025.0, 12000.0, 16000.0,
+ 22050.0, 24000.0, 32000.0, 44100.0, 48000.0,
+ 88200.0, 96000.0, 192000.0
+ );
+
+ SampleFormat: array[1..8] of culong =
+ (paFloat32, paInt32, paInt24, paInt16, paInt8, paUInt8,
+ paCustomFormat, paNonInterleaved
+ );
+ SampleFormatName: array[1..8] of string =
+ ('paFloat32', 'paInt32', 'paInt24', 'paInt16', 'paInt8', 'paUInt8',
+ 'paCustomFormat', 'paNonInterleaved'
+ );
+
+var
+ i, j: integer;
+ PaError: TPaError;
+ paApiIndex: TPaHostApiIndex;
+ paApiInfo: PPaHostApiInfo;
+ deviceIndex: TPaDeviceIndex;
+ deviceInfo: PPaDeviceInfo;
+ inputParameters: PPaStreamParameters;
+ outputParameters: PPaStreamParameters;
+ sampleRate: cdouble;
+ stream: PPaStream;
+ framesPerBuffer: culong;
+ streamFlags: TPaStreamFlags;
+ streamCallback: PPaStreamCallback;
+ callbackStartTime: TDateTime;
+ callbackWorks: boolean;
+ userData: Pointer;
+
+
+function GetPreferredApiIndex(): TPaHostApiIndex;
+var
+ i: integer;
+ apiIndex: TPaHostApiIndex;
+ apiInfo: PPaHostApiInfo;
+begin
+ result := -1;
+
+ // select preferred sound-API
+ for i:= 0 to High(ApiPreferenceOrder) do
+ begin
+ if (ApiPreferenceOrder[i] <> paDefaultApi) then
+ begin
+ // check if API is available
+ apiIndex := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]);
+ if (apiIndex >= 0) then
+ begin
+ // we found an API but we must check if it works
+ // (on linux portaudio might detect OSS but does not provide
+ // any devices if ALSA is enabled)
+ apiInfo := Pa_GetHostApiInfo(apiIndex);
+ if (apiInfo^.deviceCount > 0) then
+ begin
+ Result := apiIndex;
+ break;
+ end;
+ end;
+ end;
+ end;
+
+ // None of the preferred APIs is available -> use default
+ if (result < 0) then
+ begin
+ result := Pa_GetDefaultHostApi();
+ end;
+end;
+
+{
+type
+ TAudioSampleFormat = (
+ asfU8, asfS8, // unsigned/signed 8 bits
+ asfU16LSB, asfS16LSB, // unsigned/signed 16 bits (endianness: LSB)
+ asfU16MSB, asfS16MSB, // unsigned/signed 16 bits (endianness: MSB)
+ asfU16, asfS16, // unsigned/signed 16 bits (endianness: System)
+ asfS32, // signed 32 bits (endianness: System)
+ asfFloat, // float
+ asfDouble // double
+ );
+ TAudioFormatInfo = ;
+ TAudioInputDevice = record
+ AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo)
+ CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data
+ end;
+
+procedure HandleMicrophoneData(Buffer: PByteArray; Size: integer; InputDevice: TAudioInputDevice);
+var
+ MultiChannelBuffer: PByteArray; // buffer handled as array of bytes (offset relative to channel)
+ SingleChannelBuffer: PByteArray; // temporary buffer for new samples per channel
+ SingleChannelBufferSize: integer;
+ ChannelIndex: integer;
+ CaptureChannel: TCaptureBuffer;
+ AudioFormat: TAudioFormatInfo;
+ SampleSize: integer;
+ SamplesPerChannel: integer;
+ i: integer;
+begin
+ AudioFormat := InputDevice.AudioFormat;
+ SampleSize := AudioSampleSize[AudioFormat.Format];
+ SamplesPerChannel := Size div AudioFormat.FrameSize;
+
+ SingleChannelBufferSize := SamplesPerChannel * SampleSize;
+ GetMem(SingleChannelBuffer, SingleChannelBufferSize);
+
+ // process channels
+ for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do
+ begin
+ CaptureChannel := InputDevice.CaptureChannel[ChannelIndex];
+ // check if a capture buffer was assigned, otherwise there is nothing to do
+ if (CaptureChannel <> nil) then
+ begin
+ // set offset according to channel index
+ MultiChannelBuffer := @Buffer[ChannelIndex * SampleSize];
+ // separate channel-data from interleaved multi-channel (e.g. stereo) data
+ for i := 0 to SamplesPerChannel-1 do
+ begin
+ Move(MultiChannelBuffer[i*AudioFormat.FrameSize],
+ SingleChannelBuffer[i*SampleSize],
+ SampleSize);
+ end;
+ CaptureChannel.ProcessNewBuffer(SingleChannelBuffer, SingleChannelBufferSize);
+ end;
+ end;
+
+ FreeMem(SingleChannelBuffer);
+end;
+}
+
+procedure TestInitTerminate();
+begin
+ writeln ('*** Test of Pa_Initialize and Pa_Terminate ***');
+ PaError := Pa_Initialize;
+ if PaError = paNoError then
+ writeln ('Pa_Initialize: No error')
+ else
+ writeln ('Pa_Initialize: Error No ', PaError);
+
+ PaError := Pa_Terminate;
+ if PaError = paNoError then
+ writeln ('Pa_Terminate: No error')
+ else
+ writeln ('Pa_Terminate: Error No: ', PaError);
+ writeln;
+end;
+
+procedure TestErrorText();
+begin
+ writeln ('*** Test of Pa_GetErrorText ***');
+ PaError := Pa_Initialize;
+ writeln ('paNoError (0): ', Pa_GetErrorText(PaError));
+ writeln;
+ writeln ('Code Text');
+ writeln ('------------------------------------');
+ i := paNotInitialized;
+ repeat
+ writeln (i:6, ' ', Pa_GetErrorText(i));
+ i := succ(i);
+ until SameText(Pa_GetErrorText(i), 'Invalid error code') or (i = paNotInitialized + 100);
+ writeln (i:6, ' ', Pa_GetErrorText(i));
+ PaError := Pa_Terminate;
+ writeln;
+end;
+
+procedure TestVersion();
+begin
+ writeln ('*** Test of Pa_GetVersion and Pa_GetVersionText ***');
+ PaError := Pa_Initialize;
+ writeln ('Pa_GetVersion: ', Pa_GetVersion);
+ writeln ('Pa_GetVersionText: ', Pa_GetVersionText);
+ PaError := Pa_Terminate;
+ writeln;
+end;
+
+procedure TestApiInfo();
+begin
+ writeln ('*** Test of GetPreferredApiIndex ***');
+ PaError := Pa_Initialize;
+ paApiIndex := GetPreferredApiIndex();
+ if (paApiIndex = -1) then
+ writeln ('GetPreferredApiIndex: No working Audio-API found.')
+ else
+ writeln ('GetPreferredApiIndex: working Audio-API found. No: ', paApiIndex);
+ PaError := Pa_Terminate;
+ writeln;
+
+ writeln ('*** Test of Pa_GetHostApiInfo ***');
+ PaError := Pa_Initialize;
+ paApiIndex := GetPreferredApiIndex();
+ paApiInfo := Pa_GetHostApiInfo(paApiIndex);
+ writeln ('Pa_GetHostApiInfo:');
+ writeln ('paApiInfo.structVersion: ', paApiInfo.structVersion);
+ writeln ('paApiInfo._type: ', paApiInfo._type);
+ writeln ('paApiInfo.name: ', paApiInfo.name);
+ writeln ('paApiInfo.deviceCount: ', paApiInfo.deviceCount);
+ writeln ('paApiInfo.defaultInputDevice: ', paApiInfo.defaultInputDevice);
+ writeln ('paApiInfo.defaultOutputDevice: ', paApiInfo.defaultOutputDevice);
+ PaError := Pa_Terminate;
+ writeln;
+
+ writeln ('*** Test of Pa_HostApiDeviceIndexToDeviceIndex ***');
+ PaError := Pa_Initialize;
+ paApiIndex := GetPreferredApiIndex();
+ paApiInfo := Pa_GetHostApiInfo(paApiIndex);
+ for i:= 0 to paApiInfo^.deviceCount-1 do
+ begin
+ deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i);
+ writeln ('deviceIndex[', i, ']: ', deviceIndex);
+ end;
+ PaError := Pa_Terminate;
+ writeln;
+end;
+
+procedure TestDeviceInfo();
+begin
+ writeln ('*** Test of Pa_GetDeviceCount ***');
+ PaError := Pa_Initialize;
+ writeln ('Pa_GetDeviceCount: ', Pa_GetDeviceCount);
+ PaError := Pa_Terminate;
+ writeln;
+
+ writeln ('*** Test of Pa_GetDefaultInputDevice ***');
+ PaError := Pa_Initialize;
+ writeln ('Pa_GetDefaultInputDevice: ', Pa_GetDefaultInputDevice);
+ PaError := Pa_Terminate;
+ writeln;
+
+ writeln ('*** Test of Pa_GetDefaultOutputDevice ***');
+ PaError := Pa_Initialize;
+ writeln ('Pa_GetDefaultOutputDevice: ', Pa_GetDefaultOutputDevice);
+ PaError := Pa_Terminate;
+ writeln;
+
+ writeln ('*** Test of Pa_GetDeviceInfo ***');
+// Note: the fields of deviceInfo can also be used without the '^'.
+// deviceInfo.name works as well as deviceInfo^.name
+ PaError := Pa_Initialize;
+ paApiIndex := GetPreferredApiIndex();
+ paApiInfo := Pa_GetHostApiInfo(paApiIndex);
+ for i:= 0 to paApiInfo^.deviceCount - 1 do
+ begin
+ deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i);
+ deviceInfo := Pa_GetDeviceInfo(deviceIndex);
+ writeln ('deviceInfo[', i, '].name: ', deviceInfo^.name);
+ writeln ('deviceInfo[', i, '].structVersion: ', deviceInfo^.structVersion, ' (should be 2)');
+ writeln ('deviceInfo[', i, '].hostApi: ', deviceInfo^.hostApi);
+ writeln ('deviceInfo[', i, '].maxInputChannels: ', deviceInfo^.maxInputChannels);
+ writeln ('deviceInfo[', i, '].maxOutputChannels: ', deviceInfo^.maxOutputChannels);
+ writeln ('deviceInfo[', i, '].defaultLowInputLatency: ', deviceInfo^.defaultLowInputLatency:6:4);
+ writeln ('deviceInfo[', i, '].defaultLowOutputLatency: ', deviceInfo^.defaultLowOutputLatency:6:4);
+ writeln ('deviceInfo[', i, '].defaultHighInputLatency: ', deviceInfo^.defaultHighInputLatency:6:4);
+ writeln ('deviceInfo[', i, '].defaultHighOutputLatency: ', deviceInfo^.defaultHighOutputLatency:6:4);
+ writeln ('deviceInfo[', i, '].defaultSampleRate: ', deviceInfo^.defaultSampleRate:5:0);
+ writeln;
+ end;
+ PaError := Pa_Terminate;
+end;
+
+procedure TestFormatInfo();
+begin
+ writeln ('*** Test of Pa_IsFormatSupported ***');
+ PaError := Pa_Initialize;
+ paApiIndex := GetPreferredApiIndex();
+ paApiInfo := Pa_GetHostApiInfo(paApiIndex);
+ for i:= 0 to paApiInfo^.deviceCount - 1 do
+ begin
+ deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i);
+ deviceInfo := Pa_GetDeviceInfo(deviceIndex);
+ writeln ('Device[', i, '] ', deviceInfo^.name, ':');
+ New(inputParameters);
+ New(outputParameters);
+
+ if deviceInfo^.maxInputChannels > 0 then
+ begin
+ inputParameters^.device := deviceIndex;
+ inputParameters^.channelCount := deviceInfo^.maxInputChannels;
+ inputParameters^.sampleFormat := paInt16;
+ inputParameters^.suggestedLatency := 0;
+ inputParameters^.hostApiSpecificStreamInfo := nil;
+ outputParameters := nil;
+ end
+ else
+ begin
+ inputParameters := nil;
+ outputParameters^.device := deviceIndex;
+ outputParameters^.channelCount := deviceInfo^.maxOutputChannels;
+ outputParameters^.sampleFormat := paInt16;
+ outputParameters^.suggestedLatency := 0;
+ outputParameters^.hostApiSpecificStreamInfo := nil;
+ end;
+
+ sampleRate := deviceInfo^.defaultSampleRate;
+ PaError := Pa_IsFormatSupported(inputParameters, outputParameters, sampleRate);
+ if PaError = paFormatIsSupported then
+ writeln ('Sample rate: ', sampleRate:5:0, ' : supported')
+ else
+ writeln ('Sample rate: ', sampleRate:5:0, ' : Error: ', Pa_GetErrorText(PaError));
+
+ for j := low(standardSampleRates) to high(standardSampleRates) do
+ begin
+ sampleRate := standardSampleRates[j];
+ PaError := Pa_IsFormatSupported(inputParameters, outputParameters, sampleRate);
+ if PaError = paFormatIsSupported then
+ writeln ('Sample rate: ', sampleRate:5:0, ' : supported')
+ else
+ writeln ('Sample rate: ', sampleRate:5:0, ' : Error: ', PaError);
+ end;
+
+ writeln;
+ for j := low(SampleFormat) to high(SampleFormat) do
+ begin
+ if inputParameters <> nil then
+ inputParameters^.sampleFormat := SampleFormat[j]
+ else
+ outputParameters^.sampleFormat := SampleFormat[j];
+ PaError := Pa_IsFormatSupported(inputParameters, outputParameters, sampleRate);
+ if PaError = paFormatIsSupported then
+ writeln ('Sample Format ', SampleFormatName[j], ': supported')
+ else
+ writeln ('Sample Format ', SampleFormatName[j], ': ', Pa_GetErrorText(PaError));
+ end;
+
+ Dispose(inputParameters);
+ Dispose(outputParameters);
+ writeln;
+ end;
+ PaError := Pa_Terminate;
+end;
+
+function AudioCallback(input: pointer; output: pointer; frameCount: culong;
+ timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
+ inputDevice: pointer): cint; cdecl;
+var
+ duration: real;
+begin
+ duration := (Now() - callbackStartTime) * 24 * 3600;
+ if (duration < 2.0) then
+ result := paContinue
+ else
+ begin
+ callbackWorks := true;
+ result := paComplete;
+ end;
+end;
+
+procedure TestStreams();
+begin
+ writeln ('*** Test of Pa_OpenStream and Pa_CloseStream ***');
+ PaError := Pa_Initialize;
+ paApiIndex := GetPreferredApiIndex();
+ paApiInfo := Pa_GetHostApiInfo(paApiIndex);
+ for i:= 0 to paApiInfo^.deviceCount - 1 do
+ begin
+ deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i);
+ deviceInfo := Pa_GetDeviceInfo(deviceIndex);
+ writeln ('Device[', i, '] ', deviceInfo^.name, ':');
+ New(inputParameters);
+ New(outputParameters);
+ if deviceInfo^.maxInputChannels > 0 then
+ begin
+ inputParameters^.device := deviceIndex;
+ inputParameters^.channelCount := deviceInfo^.maxInputChannels;
+ inputParameters^.sampleFormat := paInt16;
+ inputParameters^.suggestedLatency := deviceInfo.defaultHighInputLatency;
+ inputParameters^.hostApiSpecificStreamInfo := nil;
+ outputParameters := nil;
+ end
+ else
+ begin
+ inputParameters := nil;
+ outputParameters^.device := deviceIndex;
+ outputParameters^.channelCount := deviceInfo^.maxOutputChannels;
+ outputParameters^.sampleFormat := paInt16;
+ outputParameters^.suggestedLatency := deviceInfo.defaultLowOutputLatency;
+ outputParameters^.hostApiSpecificStreamInfo := nil;
+ end;
+
+ sampleRate := deviceInfo^.defaultSampleRate;
+ framesPerBuffer := paFramesPerBufferUnspecified;
+ streamFlags := paNoFlag;
+ streamCallback := @AudioCallback;
+ userData := nil;
+
+ PaError := Pa_OpenStream(
+ stream,
+ inputParameters,
+ outputParameters,
+ sampleRate,
+ framesPerBuffer,
+ streamFlags,
+ streamCallback,
+ userData
+ );
+ if (PaError = paNoError) and (stream <> nil) then
+ writeln ('Pa_OpenStream: success')
+ else
+ writeln ('Pa_OpenStream: ', Pa_GetErrorText(PaError));
+
+ if (PaError = paNoError) and (stream <> nil) then
+ begin
+ callbackStartTime := Now();
+
+ PaError := Pa_StartStream(stream);
+ if (PaError = paNoError) then
+ writeln ('Pa_StartStream: success')
+ else
+ writeln ('Pa_StartStream: ', Pa_GetErrorText(PaError));
+
+ callbackWorks := false;
+
+ // wait twice the time a successful callback would need for termination
+ writeln('Wait for callback');
+ delay(4000);
+
+ if (callbackWorks and (Pa_IsStreamStopped(stream) = 0)) then
+ begin
+ writeln ('Success: Device works');
+ PaError := Pa_StopStream(stream);
+ if (PaError = paNoError) then
+ writeln ('Pa_StopStream: success')
+ else
+ writeln ('Pa_StopStream: ', Pa_GetErrorText(PaError));
+ end
+ else
+ begin
+ writeln ('Error: Non working device');
+ PaError := Pa_AbortStream(stream);
+ if (PaError = paNoError) then
+ writeln ('Pa_AbortStream: success')
+ else
+ writeln ('Pa_AbortStream: ', Pa_GetErrorText(PaError));
+
+ end;
+ end;
+
+ PaError := Pa_CloseStream(stream);
+ if PaError = paNoError then
+ writeln ('Pa_CloseStream: success')
+ else
+ writeln ('Pa_CloseStream: ', Pa_GetErrorText(PaError));
+
+ Dispose(inputParameters);
+ Dispose(outputParameters);
+
+ writeln;
+ end;
+ PaError := Pa_Terminate;
+end;
+
+begin
+ // floating point exceptions are raised. Therefore, set the exception mask.
+ SetExceptionMask([exZeroDivide, exPrecision]);
+
+ writeln ('Start: Test of Portaudio libs');
+ writeln;
+
+ //TestInitTerminate();
+ //TestErrorText();
+ //TestVersion();
+ //TestApiInfo();
+ //TestDeviceInfo();
+ //TestFormatInfo();
+ TestStreams();
+
+ writeln ('End: Test of Portaudio libs');
+end. \ No newline at end of file
diff --git a/medley_new/test/TestSignAlgorithm.pas b/medley_new/test/TestSignAlgorithm.pas
new file mode 100644
index 00000000..915e5681
--- /dev/null
+++ b/medley_new/test/TestSignAlgorithm.pas
@@ -0,0 +1,58 @@
+program TestSignAlgorithm;
+
+uses
+ sysutils;
+
+const
+ a1 = 2;
+ a2 = 1;
+ a3 = 0;
+ a4 = -1;
+ a5 = -2;
+
+var
+ index, number: longint;
+
+begin
+ writeln;
+ writeln ('This tests the arithmetic procedure used in libavutil and libavcodec.');
+ writeln ('positive numbers should give 1, negative numbers -1.');
+ writeln ('-17: ', not((-17 shr 30) and $00000002) + 2);
+ writeln ('-16: ', not((-16 shr 30) and $00000002) + 2);
+ writeln ('-15: ', not((-15 shr 30) and $00000002) + 2);
+ writeln (' -3: ', not(( -3 shr 30) and $00000002) + 2);
+ writeln (' -2: ', not(( -2 shr 30) and $00000002) + 2);
+ writeln (' -1: ', not(( -1 shr 30) and $00000002) + 2);
+ writeln (' 0: ', not(( 0 shr 30) and $00000002) + 2);
+ writeln (' 1: ', not(( 1 shr 30) and $00000002) + 2);
+ writeln (' 2: ', not(( 2 shr 30) and $00000002) + 2);
+ writeln (' 3: ', not(( 3 shr 30) and $00000002) + 2);
+ writeln (' 8: ', not(( 8 shr 30) and $00000002) + 2);
+ writeln ('MaxInt: ', MaxInt:12, ' ', IntToHex(MaxInt,8), ' ', not((MaxInt shr 30) and $00000002) + 2);
+ writeln ('MaxLongint: ', MaxLongint:12, ' ', IntToHex(MaxLongint,8), ' ', not((MaxLongint shr 30) and $00000002) + 2);
+ writeln ('MinInt: ', -MaxInt - 1:12, ' ', IntToHex(-MaxInt - 1,8), ' ', not(((-MaxInt - 1) shr 30) and $00000002) + 2);
+ writeln ('MinLongInt: ', -MaxLongint - 1:12, ' ', IntToHex(-MaxLongint - 1,8), ' ', not(((-MaxLongint - 1) shr 30) and $00000002) + 2);
+ writeln (a1, ' ', IntToHex(a1,8) , ' ', not((a1 shr 30) and $00000002) + 2);
+ writeln (a2, ' ', IntToHex(a2,8) , ' ', not((a2 shr 30) and $00000002) + 2);
+ writeln (a3, ' ', IntToHex(a3,8) , ' ', not((a3 shr 30) and $00000002) + 2);
+ writeln (a4, ' ', IntToHex(a4,8) , ' ', not((a4 shr 30) and $00000002) + 2);
+ writeln (a5, ' ', IntToHex(a5,8) , ' ', not((a5 shr 30) and $00000002) + 2);
+ writeln;
+ writeln ('Hit RETURN for more positive numbers. The last one overflows and becomes negative.');
+ readln;
+ number := 1;
+ for index := 1 to 32 do
+ begin
+ writeln (index:2, ': ', number:11, ' ', IntToHex(number shr 30 ,8):10, ' ', not((number shr 30) and $00000002) + 2);
+ number := number * 2;
+ end;
+ writeln;
+ writeln ('Hit RETURN for more positive numbers.');
+ readln;
+ number := -1;
+ for index := 1 to 32 do
+ begin
+ writeln (index:2, ': ', number:11, ' ', IntToHex(number shr 30 ,8):10, ' ', not((number shr 30) and $00000002) + 2);
+ number := number * 2;
+ end;
+end. \ No newline at end of file
diff --git a/medley_new/test/switches.inc b/medley_new/test/switches.inc
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/medley_new/test/switches.inc
diff --git a/medley_new/test/test001.pas b/medley_new/test/test001.pas
new file mode 100644
index 00000000..c9ba266f
--- /dev/null
+++ b/medley_new/test/test001.pas
@@ -0,0 +1,86 @@
+program test001;
+
+{
+This program tests the function glext_ExtensionSupported from unit glext.
+}
+
+uses
+ SysUtils,
+ SDL in '../src/lib/JEDI-SDL/SDL/Pas/sdl.pas',
+ moduleloader in '../src/lib/JEDI-SDL/SDL/Pas/moduleloader.pas',
+ gl in '../src/lib/JEDI-SDL/OpenGL/Pas/gl.pas',
+ glext in '../src/lib/JEDI-SDL/OpenGL/Pas/glext.pas';
+
+const
+ s1: pchar = '';
+ s2: pchar = 'ext';
+ s3: pchar = ' ext';
+ s4: pchar = ' ext ';
+ s5: pchar = 'kkshf kjsfh ext';
+ s6: pchar = 'fakh sajhf ext jskdhf';
+ s7: pchar = 'ext jshf';
+ s8: pchar = 'sdkjfh ksjhext sjdha';
+ s9: pchar = 'sdkjfh ksjh extsjdha';
+ s10: pchar = 'sdkjfh ksjhextsjdha';
+ s11: pchar = 'sd kjf jdha';
+
+ e1: pchar = '';
+ e2: pchar = 'ext';
+ e3: pchar = 'GL_ARB_window_pos';
+
+ SCREEN_WIDTH = 640;
+ SCREEN_HEIGHT = 480;
+ SCREEN_BPP = 16;
+
+var
+ surface: PSDL_Surface;
+ videoFlags: integer;
+ testFailed: boolean;
+
+procedure treatTestFailure(testNumber: integer, var testFailed: boolean);
+begin
+ writeln;
+ write ('test001, ', testNumber, ': failed');
+ testFailed := true;
+end;
+
+begin
+ write ('test001: Start ... ');
+ testFailed := false;
+
+// initialize SDL and OpenGL for the use of glGetString(GL_EXTENSIONS)
+// within glext_ExtensionSupported.
+
+ SDL_Init( SDL_INIT_VIDEO);
+
+// the flags to pass to SDL_SetVideoMode
+ videoFlags := SDL_OPENGL;
+
+// get a SDL surface
+ surface := SDL_SetVideoMode(SCREEN_WIDTH, SCREEN_HEIGHT, SCREEN_BPP, videoFlags);
+
+// Initialization finished
+
+ if glext_ExtensionSupported(e1, s1) then treatTestFailure( 1, testFailed);
+ if glext_ExtensionSupported(e1, s2) then treatTestFailure( 2, testFailed);
+ if glext_ExtensionSupported(e2, s1) then treatTestFailure( 3, testFailed);
+ if not glext_ExtensionSupported(e2, s2) then treatTestFailure( 4, testFailed);
+ if not glext_ExtensionSupported(e2, s3) then treatTestFailure( 5, testFailed);
+ if not glext_ExtensionSupported(e2, s4) then treatTestFailure( 6, testFailed);
+ if not glext_ExtensionSupported(e2, s5) then treatTestFailure( 7, testFailed);
+ if not glext_ExtensionSupported(e2, s6) then treatTestFailure( 8, testFailed);
+ if not glext_ExtensionSupported(e2, s7) then treatTestFailure( 9, testFailed);
+ if glext_ExtensionSupported(e2, s8) then treatTestFailure(10, testFailed);
+ if glext_ExtensionSupported(e2, s9) then treatTestFailure(11, testFailed);
+ if glext_ExtensionSupported(e2, s10) then treatTestFailure(12, testFailed);
+ if glext_ExtensionSupported(e2, s11) then treatTestFailure(13, testFailed);
+ if not glext_ExtensionSupported(e3, s1) then treatTestFailure(14, testFailed);
+
+ if testFailed then
+ begin
+ writeln;
+ writeln ('test001: End');
+ end
+ else
+ writeln ('End');
+end. \ No newline at end of file
diff --git a/medley_new/test/test_libraries.lpi b/medley_new/test/test_libraries.lpi
new file mode 100644
index 00000000..cc3a6ddf
--- /dev/null
+++ b/medley_new/test/test_libraries.lpi
@@ -0,0 +1,299 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="/"/>
+ <Version Value="6"/>
+ <General>
+ <MainUnit Value="0"/>
+ <TargetFileExt Value=""/>
+ <ActiveEditorIndexAtStart Value="0"/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ <Language Value=""/>
+ <CharSet Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IgnoreBinaries Value="False"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="2">
+ <Item1>
+ <PackageName Value="FPCUnitConsoleRunner"/>
+ </Item1>
+ <Item2>
+ <PackageName Value="FCL"/>
+ </Item2>
+ </RequiredPackages>
+ <Units Count="3">
+ <Unit0>
+ <Filename Value="test_libraries.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="Test_Libraries"/>
+ <CursorPos X="77" Y="17"/>
+ <TopLine Value="1"/>
+ <EditorIndex Value="1"/>
+ <UsageCount Value="20"/>
+ <Loaded Value="True"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="testsqllite.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="TestSQLLite"/>
+ <CursorPos X="23" Y="57"/>
+ <TopLine Value="39"/>
+ <EditorIndex Value="0"/>
+ <UsageCount Value="20"/>
+ <Loaded Value="True"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="../lib/SQLite/SQLiteTable3.pas"/>
+ <UnitName Value="SQLiteTable3"/>
+ <CursorPos X="37" Y="29"/>
+ <TopLine Value="11"/>
+ <EditorIndex Value="2"/>
+ <UsageCount Value="10"/>
+ <Loaded Value="True"/>
+ </Unit2>
+ </Units>
+ <JumpHistory Count="11" HistoryIndex="10">
+ <Position1>
+ <Filename Value="testsqllite.pas"/>
+ <Caret Line="8" Column="68" TopLine="1"/>
+ </Position1>
+ <Position2>
+ <Filename Value="../lib/SQLite/SQLiteTable3.pas"/>
+ <Caret Line="1" Column="1" TopLine="1"/>
+ </Position2>
+ <Position3>
+ <Filename Value="../lib/SQLite/SQLiteTable3.pas"/>
+ <Caret Line="37" Column="64" TopLine="14"/>
+ </Position3>
+ <Position4>
+ <Filename Value="testsqllite.pas"/>
+ <Caret Line="26" Column="34" TopLine="1"/>
+ </Position4>
+ <Position5>
+ <Filename Value="testsqllite.pas"/>
+ <Caret Line="13" Column="10" TopLine="1"/>
+ </Position5>
+ <Position6>
+ <Filename Value="testsqllite.pas"/>
+ <Caret Line="20" Column="29" TopLine="4"/>
+ </Position6>
+ <Position7>
+ <Filename Value="testsqllite.pas"/>
+ <Caret Line="28" Column="22" TopLine="5"/>
+ </Position7>
+ <Position8>
+ <Filename Value="testsqllite.pas"/>
+ <Caret Line="33" Column="42" TopLine="5"/>
+ </Position8>
+ <Position9>
+ <Filename Value="testsqllite.pas"/>
+ <Caret Line="21" Column="15" TopLine="5"/>
+ </Position9>
+ <Position10>
+ <Filename Value="testsqllite.pas"/>
+ <Caret Line="20" Column="38" TopLine="5"/>
+ </Position10>
+ <Position11>
+ <Filename Value="testsqllite.pas"/>
+ <Caret Line="61" Column="47" TopLine="39"/>
+ </Position11>
+ </JumpHistory>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+ <Debugging>
+ <BreakPoints Count="37">
+ <Item1>
+ <Source Value="../../../../../project_mutliloader/fmmultiloaderform.pas"/>
+ <Line Value="370"/>
+ </Item1>
+ <Item2>
+ <Source Value="../../../../../project_mutliloader/uploader_infomine.pas"/>
+ <Line Value="1"/>
+ </Item2>
+ <Item3>
+ <Source Value="../../../../../project_mutliloader/uploader_seek_publicweb.pas"/>
+ <Line Value="515"/>
+ </Item3>
+ <Item4>
+ <Source Value="../../../../../project_mutliloader/fmmultiloaderform.pas"/>
+ <Line Value="803"/>
+ </Item4>
+ <Item5>
+ <Source Value="../../../../../project_mutliloader/fmmultiloaderform.pas"/>
+ <Line Value="822"/>
+ </Item5>
+ <Item6>
+ <Source Value="../../../../../project_mutliloader/fmmultiloaderform.pas"/>
+ <Line Value="824"/>
+ </Item6>
+ <Item7>
+ <Source Value="../../../../../project_mutliloader/fmmultiloaderform.pas"/>
+ <Line Value="1492"/>
+ </Item7>
+ <Item8>
+ <Source Value="../../../../../project_mutliloader/fmmultiloaderform.pas"/>
+ <Line Value="1536"/>
+ </Item8>
+ <Item9>
+ <Source Value="../../../../../Common/aSpell/spellcheck_controlls.pas"/>
+ <Line Value="425"/>
+ </Item9>
+ <Item10>
+ <Source Value="../../../../../Common/aSpell/spellcheck_controlls.pas"/>
+ <Line Value="455"/>
+ </Item10>
+ <Item11>
+ <Source Value="../../../../../Common/aSpell/spellcheck_controlls.pas"/>
+ <Line Value="574"/>
+ </Item11>
+ <Item12>
+ <Source Value="../../../../../Common/aSpell/spellcheck_controlls.pas"/>
+ <Line Value="602"/>
+ </Item12>
+ <Item13>
+ <Source Value="../../../../../project_mutliloader/fmmultiloaderform.pas"/>
+ <Line Value="1621"/>
+ </Item13>
+ <Item15>
+ <Source Value="../../../../../project_SkyeDB/fmclient.pas"/>
+ <Line Value="986"/>
+ </Item15>
+ <Item16>
+ <Source Value="../../../../../project_SkyeDB/fmclient.pas"/>
+ <Line Value="2065"/>
+ </Item16>
+ <Item17>
+ <Source Value="../../../../../project_SkyeDB/fmclient.pas"/>
+ <Line Value="1541"/>
+ </Item17>
+ <Item18>
+ <Source Value="../../../../../project_SkyeDB/fmcandidate.pas"/>
+ <Line Value="741"/>
+ </Item18>
+ <Item19>
+ <Source Value="../../../../../project_SkyeDB/fmcandidate.pas"/>
+ <Line Value="1633"/>
+ </Item19>
+ <Item20>
+ <Source Value="../../../../../project_SkyeDB/fmclient.pas"/>
+ <Line Value="3554"/>
+ </Item20>
+ <Item21>
+ <Source Value="../../../../../project_SkyeDB/fmcandidate.pas"/>
+ <Line Value="5037"/>
+ </Item21>
+ <Item22>
+ <Source Value="../../../../../project_SkyeDB/fmcandidate.pas"/>
+ <Line Value="2994"/>
+ </Item22>
+ <Item23>
+ <Source Value="../../../../../common/asterisk/comManagerMessage.pas"/>
+ <Line Value="564"/>
+ </Item23>
+ <Item24>
+ <Source Value="../../../../../common/asterisk/comManagerMessage.pas"/>
+ <Line Value="549"/>
+ </Item24>
+ <Item25>
+ <Source Value="../../../../../common/asterisk/comManagerMessage.pas"/>
+ <Line Value="438"/>
+ </Item25>
+ <Item26>
+ <Source Value="../../../../../common/asterisk/comManagerMessage.pas"/>
+ <Line Value="436"/>
+ </Item26>
+ <Item27>
+ <Source Value="../../../../../project_SkyeDB/fmcandidate.pas"/>
+ <Line Value="5648"/>
+ </Item27>
+ <Item28>
+ <Source Value="../../../../../project_SkyeDB/fmcandidate.pas"/>
+ <Line Value="636"/>
+ </Item28>
+ <Item29>
+ <Source Value="../../../../../common/common/ConvertUnicode.pas"/>
+ <Line Value="83"/>
+ </Item29>
+ <Item30>
+ <Source Value="/usr/share/lazarus/components/uniqueinstance/uniqueinstance.pas"/>
+ <Line Value="124"/>
+ </Item30>
+ <Item31>
+ <Source Value="/usr/share/lazarus/components/uniqueinstance/uniqueinstance.pas"/>
+ <Line Value="112"/>
+ </Item31>
+ <Item32>
+ <Source Value="/usr/share/lazarus/components/uniqueinstance/uniqueinstance.pas"/>
+ <Line Value="174"/>
+ </Item32>
+ <Item33>
+ <Source Value="/usr/share/lazarus/components/uniqueinstance/uniqueinstance.pas"/>
+ <Line Value="199"/>
+ </Item33>
+ <Item34>
+ <Source Value="../../../../../common/asterisk/comManagerMessage.pas"/>
+ <Line Value="800"/>
+ </Item34>
+ <Item35>
+ <Source Value="../../../../../common/asterisk/comManagerMessage.pas"/>
+ <Line Value="798"/>
+ </Item35>
+ <Item36>
+ <Source Value="../../../../../common/asterisk/comManagerMessage.pas"/>
+ <Line Value="778"/>
+ </Item36>
+ <Item37>
+ <Source Value="../../../../../common/asterisk/comManagerMessage.pas"/>
+ <Line Value="522"/>
+ </Item37>
+ </BreakPoints>
+ <Watches Count="6">
+ <Item1>
+ <Expression Value="edSearchSummry.text"/>
+ </Item1>
+ <Item2>
+ <Expression Value=" trim(edSearhSummary.text) "/>
+ </Item2>
+ <Item3>
+ <Expression Value="lData"/>
+ </Item3>
+ <Item4>
+ <Expression Value="ord(a)"/>
+ </Item4>
+ <Item5>
+ <Expression Value="lHTTP.headers.text"/>
+ </Item5>
+ <Item6>
+ <Expression Value="lSummaryContactName"/>
+ </Item6>
+ </Watches>
+ <Exceptions Count="2">
+ <Item1>
+ <Name Value="ECodetoolError"/>
+ </Item1>
+ <Item2>
+ <Name Value="EFOpenError"/>
+ </Item2>
+ </Exceptions>
+ </Debugging>
+</CONFIG>
diff --git a/medley_new/test/test_libraries.lpr b/medley_new/test/test_libraries.lpr
new file mode 100644
index 00000000..3e3ae380
--- /dev/null
+++ b/medley_new/test/test_libraries.lpr
@@ -0,0 +1,31 @@
+program Test_Libraries;
+
+{$mode objfpc}{$H+}
+
+uses
+ Classes,
+ consoletestrunner,
+ TestSQLLite,
+ SQLite3 in '../lib/SQLite/SQLite3.pas',
+
+ SQLiteTable3 in '../lib/SQLite/SQLiteTable3.pas';
+
+type
+
+ { TLazTestRunner }
+
+ TMyTestRunner = class(TTestRunner)
+ protected
+ // override the protected methods of TTestRunner to customize its behavior
+ end;
+
+var
+ Application: TMyTestRunner;
+
+begin
+ Application := TMyTestRunner.Create(nil);
+ Application.Initialize;
+ Application.Title := 'FPCUnit Console test runner';
+ Application.Run;
+ Application.Free;
+end.
diff --git a/medley_new/test/testsqllite.pas b/medley_new/test/testsqllite.pas
new file mode 100644
index 00000000..b1b682d2
--- /dev/null
+++ b/medley_new/test/testsqllite.pas
@@ -0,0 +1,84 @@
+unit TestSQLLite;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, fpcunit, testutils, testregistry, SQLiteTable3, unix;
+
+type
+
+ TTest_SqlLite= class(TTestCase)
+ private
+ fSQLLite : TSQLiteDatabase;
+ fFileName : string;
+ protected
+ procedure SetUp; override;
+ procedure TearDown; override;
+ published
+ procedure Test_Random_TableExists;
+ procedure Test_Delete_NonExistant_Table;
+ procedure Test_TableExists_On_0Length_File;
+ end;
+
+implementation
+
+procedure TTest_SqlLite.Test_Random_TableExists;
+begin
+ deletefile( fFileName );
+ fSQLLite := TSQLiteDatabase.Create( fFileName );
+
+ // Test if some random table exists
+ check( not fSQLLite.TableExists( 'testTable'+floattostr(now()) ) , 'Randomly Named Table Should NOT Exists (In an empty database file)' );
+end;
+
+procedure TTest_SqlLite.Test_Delete_NonExistant_Table;
+var
+ lSQL : String;
+begin
+ deletefile( fFileName );
+ fSQLLite := TSQLiteDatabase.Create( fFileName );
+ try
+ lSQL := 'DROP TABLE testtable';
+ fSQLLite.execsql( lSQL );
+ except
+ exit;
+ end;
+
+ Fail('SQLLite did not except when trying to delete a non existant table' );
+end;
+
+procedure TTest_SqlLite.Test_TableExists_On_0Length_File;
+var
+ lSQL : String;
+begin
+ deletefile( fFileName );
+ shell('cat /dev/null > '+fFileName);
+
+ if not fileexists( fFileName ) then
+ Fail('0 Length file was not created... oops' );
+
+ fSQLLite := TSQLiteDatabase.Create( fFileName );
+
+ check( not fSQLLite.TableExists( 'testTable' ) , 'Randomly Named Table Should NOT Exists' );
+end;
+
+
+procedure TTest_SqlLite.SetUp;
+begin
+ fFileName := 'test.db';
+// fSQLLite := TSQLiteDatabase.Create( fFileName );
+end;
+
+
+procedure TTest_SqlLite.TearDown;
+begin
+ freeandnil( fSQLLite );
+end;
+
+initialization
+
+ RegisterTest(TTest_SqlLite);
+end.
+