pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

TTDurationRemotable and TTimeRemotable and TDateRemotable now use an uniform API :

Browse Source 
* ToStr()
  * Parse()

Note that this patch break compatibility a source level ( of these classes ).

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@898 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-07-07 10:45:45 +00:00
parent dfd5b765f9
commit ed00c63b47
4 changed files with 455 additions and 507 deletions
Download Patch File Download Diff File Expand all files Collapse all files

367
wst/trunk/base_service_intf.pas
View File

@ -359,7 +359,9 @@ type
private
FDate : TDateTimeRec;
private
function GetAsString: string;
function GetOffset(const Index: Integer): Shortint;
procedure SetAsString(const AValue: string);
procedure SetOffset(const Index: Integer; const Value: Shortint);
function GetDate(const AIndex : Integer) : TDateTime;
protected
@ -378,9 +380,9 @@ type
var AName : string;
const ATypeInfo : PTypeInfo
);override;
class function FormatDate(const ADate : TDateTime):string;overload;
class function FormatDate(const ADate : TDateTimeRec):string;overload;virtual;abstract;
class function ParseDate(const ABuffer : string):TDateTime;virtual;abstract;
class function ToStr(const ADate : TDateTime):string;overload;
class function ToStr(const ADate : TDateTimeRec):string;overload;virtual;abstract;
class function Parse(const ABuffer : string):TDateTimeRec;virtual;abstract;
procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
@ -392,6 +394,7 @@ type
property Day : Integer index 2 read GetDatepart;
property HourOffset : Shortint index 0 read GetOffset write SetOffset;
property MinuteOffset : Shortint index 1 read GetOffset write SetOffset;
property AsString : string read GetAsString write SetAsString;
end;
{ TDateRemotable }
@ -400,8 +403,8 @@ type
protected
function GetDatepart(const AIndex : Integer) : Integer;override;
public
class function FormatDate(const ADate : TDateTimeRec):string;override;
class function ParseDate(const ABuffer : string):TDateTime;override;
class function ToStr(const ADate : TDateTimeRec):string;override;
class function Parse(const ABuffer : string):TDateTimeRec;override;
property Hour : Integer index 3 read GetDatepart;
property Minute : Integer index 4 read GetDatepart;
property Second : Integer index 5 read GetDatepart;
@ -411,14 +414,14 @@ type
TDurationRemotable = class(TAbstractSimpleRemotable)
private
FDay : PtrUInt;
FFractionalSecond : PtrUInt;
FHour : PtrUInt;
FMinute : PtrUInt;
FMonth : PtrUInt;
FNegative : Boolean;
FSecond : PtrUInt;
FYear : PtrUInt;
FData : TDurationRec;
private
function GetAsString: string;
function GetNegative: Boolean;
function GetPart(AIndex: integer): PtrUInt;
procedure SetAsString(const AValue: string);
procedure SetNegative(const AValue: Boolean);
procedure SetPart(AIndex: integer; const AValue: PtrUInt);
public
class procedure Save(
AObject : TBaseRemotable;
@ -436,17 +439,19 @@ type
procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
procedure Clear();
procedure Parse(const ABuffer : string);
function AsString() : string;
property Negative : Boolean read FNegative write FNegative;
property Year : PtrUInt read FYear write FYear;
property Month : PtrUInt read FMonth write FMonth;
property Day : PtrUInt read FDay write FDay;
property Hour : PtrUInt read FHour write FHour;
property Minute : PtrUInt read FMinute write FMinute;
property Second : PtrUInt read FSecond write FSecond;
property FractionalSecond : PtrUInt read FFractionalSecond write FFractionalSecond;
class function Parse(const ABuffer : string) : TDurationRec;
class function ToStr(const AValue : TDurationRec):string;
property Negative : Boolean read GetNegative write SetNegative;
property Year : PtrUInt index 0 read GetPart write SetPart;
property Month : PtrUInt index 1 read GetPart write SetPart;
property Day : PtrUInt index 2 read GetPart write SetPart;
property Hour : PtrUInt index 3 read GetPart write SetPart;
property Minute : PtrUInt index 4 read GetPart write SetPart;
property Second : PtrUInt index 5 read GetPart write SetPart;
property FractionalSecond : PtrUInt index 6 read GetPart write SetPart;
property AsString : string read GetAsString write SetAsString;
end;
{ TTimeRemotable }
@ -482,7 +487,7 @@ type
procedure Clear();
class function Parse(const ABuffer : string) : TTimeRec;
class function ToString(const AValue : TTimeRec) : string;
class function ToStr(const AValue : TTimeRec) : string;
property Hour : Byte index 0 read GetPart write SetPart;
property Minute : Byte index 1 read GetPart write SetPart;
@ -3569,9 +3574,9 @@ begin
Assert(AObject.InheritsFrom(TObjectCollectionRemotable));
nativObj := AObject as TObjectCollectionRemotable;
styl := GetStyle();
itmTypInfo := PTypeInfo(GetItemClass().ClassInfo);
arrayLen := nativObj.Length;
if ( arrayLen > 0 ) then begin
itmTypInfo := PTypeInfo(GetItemClass().ClassInfo);
AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,Pred(arrayLen)],styl);
try
if ( styl = asScoped ) then begin
@ -5627,80 +5632,14 @@ end;
{ TDateRemotable }
class function TDateRemotable.FormatDate(const ADate: TDateTimeRec): string;
class function TDateRemotable.ToStr(const ADate: TDateTimeRec): string;
begin
Result := xsd_DateTimeToStr(ADate);
end;
class function TDateRemotable.ParseDate(const ABuffer: string): TDateTime;
var
buffer : string;
bufferPos, bufferLen : PtrUInt;
function ReadInt() : PtrUInt;
var
neg : Boolean;
s : shortstring;
class function TDateRemotable.Parse(const ABuffer: string): TDateTimeRec;
begin
neg := False;
while ( bufferPos <= bufferLen ) and ( buffer[bufferPos] < #33 ) do begin
Inc(bufferPos);
end;
if ( bufferPos <= bufferLen ) then begin
if ( ABuffer[bufferPos] = '-' ) then begin
neg := True;
Inc(bufferPos);
end;
end;
s := '';
while ( bufferPos <= bufferLen ) and ( buffer[bufferPos] in ['0'..'9'] ) do begin
s := s + buffer[bufferPos];
Inc(bufferPos);
end;
if ( Length(s) = 0 ) then
raise EServiceException.Create('Invalid INTEGER BUFFER');
Result := StrToInt(s);
if neg then begin
Result := -Result;
end;
end;
var
d, m, y : Word;
hh, mn, ss : Word;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
buffer := Trim(ABuffer);
bufferPos := 1;
bufferLen := Length(buffer);
if ( bufferLen > 0 ) then begin
y := ReadInt();
Inc(bufferPos);
m := ReadInt();
Inc(bufferPos);
d := ReadInt();
Inc(bufferPos);
hh := ReadInt();
Inc(bufferPos);
mn := ReadInt();
Inc(bufferPos);
ss := ReadInt();
if ( ( y + m + d + hh + mn + ss ) = 0 ) then
Result := 0
else
Result := EncodeDate(y,m,d) + EncodeTime(hh,mn,ss,0);
end else begin
Result := 0;
end;
Result := xsd_StrToDate(ABuffer);
end;
function TDateRemotable.GetDatepart(const AIndex: Integer): Integer;
@ -5736,7 +5675,7 @@ class procedure TBaseDateRemotable.Save(
var
buffer : string;
begin
buffer := FormatDate(TDateRemotable(AObject).AsDate);
buffer := TDateRemotable(AObject).AsString;
AStore.BeginObject(AName,ATypeInfo);
try
AStore.PutScopeInnerValue(TypeInfo(string),buffer);
@ -5758,7 +5697,7 @@ begin
try
strBuffer := '';
AStore.GetScopeInnerValue(TypeInfo(string),strBuffer);
(AObject as TDateRemotable).AsDate := ParseDate(strBuffer);
(AObject as TDateRemotable).AsString := strBuffer
finally
AStore.EndScopeRead();
end;
@ -5805,6 +5744,11 @@ begin
end;
end;
function TBaseDateRemotable.GetAsString: string;
begin
Result := ToStr(FDate);
end;
function TBaseDateRemotable.GetOffset(const Index: Integer): Shortint;
begin
if ( Index = 0 ) then
@ -5813,6 +5757,11 @@ begin
Result := FDate.MinuteOffset;
end;
procedure TBaseDateRemotable.SetAsString(const AValue: string);
begin
FDate := Parse(AValue);
end;
procedure TBaseDateRemotable.SetOffset(const Index: Integer; const Value: Shortint);
begin
if ( Index = 0 ) then begin
@ -5828,14 +5777,14 @@ begin
end;
end;
class function TBaseDateRemotable.FormatDate(const ADate: TDateTime): string;
class function TBaseDateRemotable.ToStr(const ADate: TDateTime): string;
var
locTemp : TDateTimeRec;
begin
locTemp.Date := ADate;
locTemp.HourOffset := 0;
locTemp.MinuteOffset := 0;
Result := FormatDate(locTemp);
Result := ToStr(locTemp);
end;
{ TComplexInt8SContentRemotable }
@ -6434,6 +6383,54 @@ end;
{ TDurationRemotable }
function TDurationRemotable.GetAsString: string;
begin
Result := ToStr(FData);
end;
function TDurationRemotable.GetNegative: Boolean;
begin
Result := FData.Negative;
end;
function TDurationRemotable.GetPart(AIndex: integer): PtrUInt;
begin
case AIndex of
0 : Result := FData.Year;
1 : Result := FData.Month;
2 : Result := FData.Day;
3 : Result := FData.Hour;
4 : Result := FData.Minute;
5 : Result := FData.Second;
6 : Result := FData.FractionalSecond;
else
Result := 0;
end;
end;
procedure TDurationRemotable.SetAsString(const AValue: string);
begin
FData := Parse(AValue);
end;
procedure TDurationRemotable.SetNegative(const AValue: Boolean);
begin
FData.Negative := AValue;
end;
procedure TDurationRemotable.SetPart(AIndex: integer; const AValue: PtrUInt);
begin
case AIndex of
0 : FData.Year := AValue;
1 : FData.Month := AValue;
2 : FData.Day := AValue;
3 : FData.Hour := AValue;
4 : FData.Minute := AValue;
5 : FData.Second := AValue;
6 : FData.FractionalSecond := AValue;
end;
end;
class procedure TDurationRemotable.Save(
AObject : TBaseRemotable;
AStore : IFormatterBase;
@ -6443,7 +6440,7 @@ class procedure TDurationRemotable.Save(
var
buffer : string;
begin
buffer := TDurationRemotable(AObject).AsString();
buffer := TDurationRemotable(AObject).AsString;
AStore.BeginObject(AName,ATypeInfo);
try
AStore.PutScopeInnerValue(TypeInfo(string),buffer);
@ -6473,180 +6470,38 @@ begin
end;
procedure TDurationRemotable.Assign(Source : TPersistent);
var
src : TDurationRemotable;
begin
if ( Source <> nil ) and Source.InheritsFrom(TDurationRemotable) then begin
src := TDurationRemotable(Source);
Self.FYear := src.FYear;
Self.FMonth := src.FMonth;
Self.FDay := src.FDay;
Self.FHour := src.FHour;
Self.FMinute := src.FMinute;
Self.FSecond := src.FSecond;
Self.FFractionalSecond := src.FFractionalSecond;
end else begin
if ( Source <> nil ) and Source.InheritsFrom(TDurationRemotable) then
Self.FData := TDurationRemotable(Source).FData
else
inherited Assign(Source);
end;
end;
function TDurationRemotable.Equal(const ACompareTo : TBaseRemotable) : Boolean;
var
src : TDurationRemotable;
begin
if ( Self = ACompareTo ) then begin
Result := True;
end else begin
if ( ACompareTo <> nil ) and ACompareTo.InheritsFrom(TDurationRemotable) then begin
src := TDurationRemotable(ACompareTo);
Result := ( Self.FYear = src.FYear ) and
( Self.FMonth = src.FMonth ) and
( Self.FDay = src.FDay ) and
( Self.FHour = src.FHour ) and
( Self.FMinute = src.FMinute ) and
( Self.FSecond = src.FSecond ) and
( Self.FFractionalSecond = src.FFractionalSecond );
end else begin
if ( ACompareTo <> nil ) and ACompareTo.InheritsFrom(TDurationRemotable) then
Result := ValueEquals(Self.FData,TDurationRemotable(ACompareTo).FData)
else
Result := inherited Equal(ACompareTo);
end;
end;
end;
procedure TDurationRemotable.Clear();
begin
FYear := 0;
FMonth := 0;
FDay := 0;
FHour := 0;
FMinute := 0;
FSecond := 0;
FFractionalSecond := 0;
FNegative := False;
FData := ZERO_DURATION;
end;
type TDatePart = ( dpNone, dpYear, dpMonth, dpDay, dpHour, dpMinute, dpSecond, dpFractionalSecond );
procedure TDurationRemotable.Parse(const ABuffer : string);
procedure RaiseInvalidBuffer();
class function TDurationRemotable.Parse(const ABuffer : string) : TDurationRec;
begin
raise EConvertError.CreateFmt('Invalid duration string : ',[ABuffer]);
Result := xsd_StrToDuration(ABuffer);
end;
var
pc : PChar;
locIntBuffer : array[dpYear..dpFractionalSecond] of PtrUInt;
i, bufferLength, lastPos : PtrInt;
localBuffer : string;
part, oldPart : TDatePart;
inTimePart : Boolean;
isNeg : Boolean;
class function TDurationRemotable.ToStr(const AValue: TDurationRec): string;
begin
bufferLength := Length(ABuffer);
if ( bufferLength < 3 ) then
RaiseInvalidBuffer();
pc := PChar(ABuffer);
i := 1;
isNeg := False;
if ( pc^ = '-' ) then begin
Inc(pc); Inc(i);
isNeg := True;
end;
if ( pc^ <> 'P' ) then
RaiseInvalidBuffer();
Inc(pc); Inc(i); //eat 'P'
FillChar(locIntBuffer,SizeOf(locIntBuffer),#0);
part := dpNone;
inTimePart := False;
if ( pc^ = 'T' ) then begin
inTimePart := True;
Inc(pc); Inc(i);
end;
repeat
lastPos := i;
while ( i < bufferLength ) and ( pc^ in ['0'..'9'] ) do begin
Inc(pc); Inc(i);
end;
if ( ( lastPos = i ) and ( pc^ <> 'T' ) ) then
RaiseInvalidBuffer();
localBuffer := Copy(ABuffer,lastPos,( i - lastPos ));
oldPart := part;
case pc^ of
'Y' : part := dpYear;
'M' :
begin
if inTimePart then
part := dpMinute
else
part := dpMonth;
end;
'D' : part := dpDay;
'H' : part := dpHour;
'S', '.' :
begin
if ( part < dpSecond ) then
part := dpSecond
else
part := dpFractionalSecond;
end;
'T' :
begin
inTimePart := True;
oldPart := dpNone;
part := dpNone;
end;
else
RaiseInvalidBuffer();
end;
if inTimePart and ( part in [dpYear..dpDay] ) then
RaiseInvalidBuffer();
if ( part > dpNone ) then begin
if ( part < oldPart ) then
RaiseInvalidBuffer();
locIntBuffer[part] := StrToInt(localBuffer);
end;
Inc(pc); Inc(i);
until ( i >= bufferLength );
if ( i = bufferLength ) then
RaiseInvalidBuffer();
FNegative := isNeg;
FYear := locIntBuffer[dpYear];
FMonth := locIntBuffer[dpMonth];
FDay := locIntBuffer[dpDay];
FHour := locIntBuffer[dpHour];
FMinute := locIntBuffer[dpMinute];
FSecond := locIntBuffer[dpSecond];
FFractionalSecond := locIntBuffer[dpFractionalSecond];
end;
function TDurationRemotable.AsString() : string;
var
strTime, strDate : string;
begin
if ( FractionalSecond > 0 ) then begin
strTime := IntToStr(Second) + '.' + IntToStr(FractionalSecond) + 'S';
end else begin
if ( Second > 0 ) then
strTime := IntToStr(Second) + 'S';
end;
if ( Minute > 0 ) then
strTime := IntToStr(Minute) + 'M' + strTime;
if ( Hour > 0 ) then
strTime := IntToStr(Hour) + 'H' + strTime;
if ( Day > 0 ) then
strDate := IntToStr(Day) + 'D';
if ( Month > 0 ) then
strDate := IntToStr(Month) + 'M' + strDate;
if ( Year > 0 ) then
strDate := IntToStr(Year) + 'Y' + strDate;
if ( strTime <> '' ) then
Result := 'T' + strTime;
Result := strDate + Result;
if ( Result = '' ) then
Result := '0Y';
Result := 'P' + Result;
if Negative and ( ( strDate <> '' ) or ( strTime <> '' ) ) then
Result := '-' + Result;
Result := xsd_DurationToStr(AValue);
end;
{ TRemotableTypeInitializer }
@ -6888,7 +6743,7 @@ end;
function TTimeRemotable.GetAsString : string;
begin
Result := ToString(Data);
Result := ToStr(Data);
end;
function TTimeRemotable.GetMilliSecond: Word;
@ -7002,10 +6857,10 @@ end;
function TTimeRemotable.Equal(const ACompareTo: TBaseRemotable): Boolean;
begin
if ( ACompareTo = nil ) then begin
Result := date_utils.Equals(Data,ZERO_TIME );
Result := ValueEquals(Data,ZERO_TIME );
end else begin
if ACompareTo.InheritsFrom(TTimeRemotable) then
Result := date_utils.Equals(Self.Data,TTimeRemotable(ACompareTo).Data)
Result := ValueEquals(Self.Data,TTimeRemotable(ACompareTo).Data)
else
Result := inherited Equal(ACompareTo);
end;
@ -7021,7 +6876,7 @@ begin
Result := xsd_StrToTime(ABuffer);
end;
class function TTimeRemotable.ToString(const AValue: TTimeRec): string;
class function TTimeRemotable.ToStr(const AValue: TTimeRec): string;
begin
Result := xsd_TimeToStr(AValue);
end;

182
wst/trunk/date_utils.pas
View File

@ -14,7 +14,7 @@ unit date_utils;
interface
uses
SysUtils;
SysUtils, wst_types;
type
@ -33,6 +33,17 @@ type
MinuteOffset : Shortint;
end;
TDurationRec = packed record
Year : PtrUInt;
Month : PtrUInt;
Day : PtrUInt;
Hour : PtrUInt;
Minute : PtrUInt;
Second : PtrUInt;
FractionalSecond : PtrUInt;
Negative : Boolean;
end;
const
ZERO_DATE : TDateTimeRec = ( Date : 0; HourOffset : 0; MinuteOffset : 0; );
ZERO_TIME : TTimeRec = (
@ -43,6 +54,16 @@ const
HourOffset : 0;
MinuteOffset : 0;
);
ZERO_DURATION : TDurationRec = (
Year : 0;
Month : 0;
Day : 0;
Hour : 0;
Minute : 0;
Second : 0;
FractionalSecond : 0;
Negative : False;
);
function xsd_TryStrToDate(const AStr : string; out ADate : TDateTimeRec) : Boolean;
function xsd_StrToDate(const AStr : string) : TDateTimeRec; {$IFDEF USE_INLINE}inline;{$ENDIF}
@ -70,18 +91,26 @@ const
function DateTimeToTimeRec(const ADateTime : TDateTime) : TTimeRec; {$IFDEF USE_INLINE}inline;{$ENDIF}
function TimeRecToDateTime(const ATime : TTimeRec) : TDateTime; {$IFDEF USE_INLINE}inline;{$ENDIF}
function xsd_TryStrToDuration(
const ABuffer : string;
out AResult : TDurationRec
) : Boolean;
function xsd_StrToDuration(const ABuffer : string) : TDurationRec;
function xsd_DurationToStr(const AValue : TDurationRec) : string;
function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;{$IFDEF USE_INLINE}inline;{$ENDIF}
function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;{$IFDEF USE_INLINE}inline;{$ENDIF}
function NormalizeToUTC(const ADate : TDateTimeRec) : TDateTime; overload;
function NormalizeToUTC(const ATime : TTimeRec) : TTimeRec; overload;
function Equals(const AA,AB: TDateTimeRec) : Boolean; overload;
function Equals(const AA,AB: TTimeRec) : Boolean; overload;
function ValueEquals(const AA,AB: TDateTimeRec) : Boolean; overload;
function ValueEquals(const AA,AB: TTimeRec) : Boolean; overload;
function ValueEquals(const AA,AB: TDurationRec) : Boolean; overload;
resourcestring
SERR_InvalidDate = '"%s" is not a valid date.';
SERR_InvalidTime = '"%s" is not a valid time.';
SERR_InvalidDuration = '"%s" is not a valid duration.';
implementation
@ -126,7 +155,7 @@ begin
end;
{$HINTS OFF}
function Equals(const AA,AB: TDateTimeRec) : Boolean;
function ValueEquals(const AA,AB: TDateTimeRec) : Boolean;
var
e, a : TDateTime;
e_y, e_m, e_d, e_h, e_mn, e_ss, e_ms : Word;
@ -141,7 +170,7 @@ begin
end;
{$HINTS ON}
function Equals(const AA,AB: TTimeRec) : Boolean;
function ValueEquals(const AA,AB: TTimeRec) : Boolean;
var
a, b : TTimeRec;
begin
@ -523,4 +552,147 @@ begin
Result := EncodeTime(ATime.Hour,ATime.Minute,ATime.Second,ATime.MilliSecond);
end;
type TDatePart = ( dpNone, dpYear, dpMonth, dpDay, dpHour, dpMinute, dpSecond, dpFractionalSecond );
function xsd_TryStrToDuration(
const ABuffer : string;
out AResult : TDurationRec
) : Boolean;
var
pc : PChar;
locIntBuffer : array[dpYear..dpFractionalSecond] of PtrUInt;
i, bufferLength, lastPos : PtrInt;
localBuffer : string;
part, oldPart : TDatePart;
inTimePart : Boolean;
isNeg : Boolean;
begin
Result := False;
bufferLength := Length(ABuffer);
if ( bufferLength < 3 ) then
Exit;
pc := PChar(ABuffer);
i := 1;
isNeg := False;
if ( pc^ = '-' ) then begin
Inc(pc); Inc(i);
isNeg := True;
end;
if ( pc^ <> 'P' ) then
Exit;
Inc(pc); Inc(i); //eat 'P'
FillChar(locIntBuffer,SizeOf(locIntBuffer),#0);
part := dpNone;
inTimePart := False;
if ( pc^ = 'T' ) then begin
inTimePart := True;
Inc(pc); Inc(i);
end;
repeat
lastPos := i;
while ( i < bufferLength ) and ( pc^ in ['0'..'9'] ) do begin
Inc(pc); Inc(i);
end;
if ( ( lastPos = i ) and ( pc^ <> 'T' ) ) then
Exit;
localBuffer := Copy(ABuffer,lastPos,( i - lastPos ));
oldPart := part;
case pc^ of
'Y' : part := dpYear;
'M' :
begin
if inTimePart then
part := dpMinute
else
part := dpMonth;
end;
'D' : part := dpDay;
'H' : part := dpHour;
'S', '.' :
begin
if ( part < dpSecond ) then
part := dpSecond
else
part := dpFractionalSecond;
end;
'T' :
begin
inTimePart := True;
oldPart := dpNone;
part := dpNone;
end;
else
Exit;
end;
if inTimePart and ( part in [dpYear..dpDay] ) then
Exit;
if ( part > dpNone ) then begin
if ( part < oldPart ) then
Exit;
locIntBuffer[part] := StrToInt(localBuffer);
end;
Inc(pc); Inc(i);
until ( i >= bufferLength );
if ( i = bufferLength ) then
Exit;
AResult.Negative := isNeg;
AResult.Year := locIntBuffer[dpYear];
AResult.Month := locIntBuffer[dpMonth];
AResult.Day := locIntBuffer[dpDay];
AResult.Hour := locIntBuffer[dpHour];
AResult.Minute := locIntBuffer[dpMinute];
AResult.Second := locIntBuffer[dpSecond];
AResult.FractionalSecond := locIntBuffer[dpFractionalSecond];
Result := True;
end;
function xsd_StrToDuration(const ABuffer : string) : TDurationRec;
begin
if not xsd_TryStrToDuration(ABuffer,Result) then
raise EConvertError.CreateFmt(SERR_InvalidDuration,[ABuffer]);
end;
function xsd_DurationToStr(const AValue : TDurationRec) : string;
var
strTime, strDate : string;
begin
if ( AValue.FractionalSecond > 0 ) then begin
strTime := IntToStr(AValue.Second) + '.' + IntToStr(AValue.FractionalSecond) + 'S';
end else begin
if ( AValue.Second > 0 ) then
strTime := IntToStr(AValue.Second) + 'S';
end;
if ( AValue.Minute > 0 ) then
strTime := IntToStr(AValue.Minute) + 'M' + strTime;
if ( AValue.Hour > 0 ) then
strTime := IntToStr(AValue.Hour) + 'H' + strTime;
if ( AValue.Day > 0 ) then
strDate := IntToStr(AValue.Day) + 'D';
if ( AValue.Month > 0 ) then
strDate := IntToStr(AValue.Month) + 'M' + strDate;
if ( AValue.Year > 0 ) then
strDate := IntToStr(AValue.Year) + 'Y' + strDate;
if ( strTime <> '' ) then
Result := 'T' + strTime;
Result := strDate + Result;
if ( Result = '' ) then
Result := '0Y';
Result := 'P' + Result;
if AValue.Negative and ( ( strDate <> '' ) or ( strTime <> '' ) ) then
Result := '-' + Result;
end;
function ValueEquals(const AA,AB: TDurationRec) : Boolean;
begin
Result := ( AA.Negative = AB.Negative ) and
( AA.Year = AB.Year ) and
( AA.Month = AB.Month ) and
( AA.Day = AB.Day ) and
( AA.Hour = AB.Hour ) and
( AA.Minute = AB.Minute ) and
( AA.Second = AB.Second ) and
( AA.FractionalSecond = AB.FractionalSecond );
end;
end.

191
wst/trunk/tests/test_suite/test_support.pas
View File

@ -346,7 +346,7 @@ type
procedure CheckEquals(expected, actual: TTimeRec; msg: string = ''); overload;
{$ENDIF WST_DELPHI}
published
procedure ToString();
procedure ToStr();
procedure Parse();
procedure Parse_millisecond();
procedure Parse_offset_1();
@ -2251,36 +2251,34 @@ var
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
d := EncodeDate(1976,10,12) + EncodeTime(23,34,56,0);
CheckEquals(sDATE_1, Copy(TDateRemotable.FormatDate(d),1,Length(sDATE_1)));
CheckEquals(sDATE_1, Copy(TDateRemotable.ToStr(d),1,Length(sDATE_1)));
d := EncodeDate(987,06,12) - EncodeTime(20,34,56,0);
CheckEquals(sDATE_2, Copy(TDateRemotable.FormatDate(d),1,Length(sDATE_2)));
CheckEquals(sDATE_2, Copy(TDateRemotable.ToStr(d),1,Length(sDATE_2)));
end;
procedure TTest_TDateRemotable.ParseDate();
var
s : string;
objd : TDateRemotable;
d : TDateTime;
d : TDateTimeRec;
y,m,dy : Word;
hh,mn,ss, ssss : Word;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
s := '1976-10-12T23:34:56';
d := TDateRemotable.ParseDate(s);
DecodeDate(d,y,m,dy);
d := TDateRemotable.Parse(s);
DecodeDateTime(d.Date,y,m,dy, hh,mn,ss,ssss);
CheckEquals(y,1976,'Year');
CheckEquals(m,10,'Month');
CheckEquals(dy,12,'Day');
DecodeTime(d,hh,mn,ss,ssss);
CheckEquals(hh,23,'Hour');
CheckEquals(mn,34,'Minute');
CheckEquals(ss,56,'Second');
objd := TDateRemotable.Create();
try
objd.AsDate := d;
objd.AsDate := d.Date;
CheckEquals(objd.Year,1976,'Year');
CheckEquals(objd.Month,10,'Month');
CheckEquals(objd.Day,12,'Day');
@ -2352,7 +2350,7 @@ var
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
d := 0;
CheckEquals(sDATE, Copy(TDateRemotable.FormatDate(d),1,Length(sDATE)));
CheckEquals(sDATE, Copy(TDateRemotable.ToStr(d),1,Length(sDATE)));
end;
procedure TTest_TDateRemotable.AsDate();
@ -2558,9 +2556,9 @@ var
begin
x := TDurationRemotable.Create();
try
CheckEquals('P0Y', x.AsString());
CheckEquals('P0Y', x.AsString);
x.Negative := True;
CheckEquals('P0Y', x.AsString());
CheckEquals('P0Y', x.AsString);
finally
x.Free();
end;
@ -2578,11 +2576,11 @@ begin
x.Hour := 4;
x.Minute := 5;
x.Second := 6;
CheckEquals('P1Y2M3DT4H5M6S',x.AsString());
CheckEquals('P1Y2M3DT4H5M6S',x.AsString);
x.FractionalSecond := 7;
CheckEquals('P1Y2M3DT4H5M6.7S',x.AsString());
CheckEquals('P1Y2M3DT4H5M6.7S',x.AsString);
x.Negative := True;
CheckEquals('-P1Y2M3DT4H5M6.7S',x.AsString());
CheckEquals('-P1Y2M3DT4H5M6.7S',x.AsString);
finally
x.Free();
end;
@ -2595,41 +2593,41 @@ begin
x := TDurationRemotable.Create();
try
x.Year := 1;
CheckEquals('P1Y', x.AsString());
CheckEquals('P1Y', x.AsString);
x.Month := 2;
CheckEquals('P1Y2M', x.AsString());
CheckEquals('P1Y2M', x.AsString);
x.Day := 3;
CheckEquals('P1Y2M3D', x.AsString());
CheckEquals('P1Y2M3D', x.AsString);
x.Negative := True;
CheckEquals('-P1Y2M3D', x.AsString());
CheckEquals('-P1Y2M3D', x.AsString);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Month := 12;
CheckEquals('P12M',x.AsString());
CheckEquals('P12M',x.AsString);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Day := 34;
CheckEquals('P34D',x.AsString());
CheckEquals('P34D',x.AsString);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Month := 12;
x.Day := 3;
CheckEquals('P12M3D',x.AsString());
CheckEquals('P12M3D',x.AsString);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Year := 2;
x.Month := 34;
CheckEquals('P2Y34M',x.AsString());
CheckEquals('P2Y34M',x.AsString);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Year := 12;
x.Day := 56;
CheckEquals('P12Y56D',x.AsString());
CheckEquals('P12Y56D',x.AsString);
finally
x.Free();
end;
@ -2642,43 +2640,43 @@ begin
x := TDurationRemotable.Create();
try
x.Hour := 1;
CheckEquals('PT1H', x.AsString());
CheckEquals('PT1H', x.AsString);
x.Minute := 2;
CheckEquals('PT1H2M', x.AsString());
CheckEquals('PT1H2M', x.AsString);
x.Second := 3;
CheckEquals('PT1H2M3S', x.AsString());
CheckEquals('PT1H2M3S', x.AsString);
x.FractionalSecond := 4;
CheckEquals('PT1H2M3.4S', x.AsString());
CheckEquals('PT1H2M3.4S', x.AsString);
x.Negative := True;
CheckEquals('-PT1H2M3.4S', x.AsString());
CheckEquals('-PT1H2M3.4S', x.AsString);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Minute := 12;
CheckEquals('PT12M',x.AsString());
CheckEquals('PT12M',x.AsString);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Second := 34;
CheckEquals('PT34S',x.AsString());
CheckEquals('PT34S',x.AsString);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Minute := 12;
x.Second := 3;
CheckEquals('PT12M3S',x.AsString());
CheckEquals('PT12M3S',x.AsString);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Hour := 2;
x.Minute := 34;
CheckEquals('PT2H34M',x.AsString());
CheckEquals('PT2H34M',x.AsString);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Hour := 12;
x.Second := 56;
CheckEquals('PT12H56S',x.AsString());
CheckEquals('PT12H56S',x.AsString);
finally
x.Free();
end;
@ -2686,11 +2684,9 @@ end;
procedure TTest_TDurationRemotable.Parse_non_empty();
var
x : TDurationRemotable;
x : TDurationRec;
begin
x := TDurationRemotable.Create();
try
x.Parse('P1Y2M3DT4H5M6S');
x := TDurationRemotable.Parse('P1Y2M3DT4H5M6S');
CheckEquals(False,x.Negative);
CheckEquals(1,x.Year);
CheckEquals(2,x.Month);
@ -2699,10 +2695,8 @@ begin
CheckEquals(5,x.Minute);
CheckEquals(6,x.Second);
CheckEquals(0,x.FractionalSecond);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Parse('-P1Y2M3DT4H5M6S');
x := TDurationRemotable.Parse('-P1Y2M3DT4H5M6S');
CheckEquals(True,x.Negative);
CheckEquals(1,x.Year);
CheckEquals(2,x.Month);
@ -2711,10 +2705,8 @@ begin
CheckEquals(5,x.Minute);
CheckEquals(6,x.Second);
CheckEquals(0,x.FractionalSecond);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Parse('P1Y2M3DT4H5M6.7S');
x := TDurationRemotable.Parse('P1Y2M3DT4H5M6.7S');
CheckEquals(False,x.Negative);
CheckEquals(1,x.Year);
CheckEquals(2,x.Month);
@ -2724,8 +2716,7 @@ begin
CheckEquals(6,x.Second);
CheckEquals(7,x.FractionalSecond);
x := TDurationRemotable.Create();
x.Parse('-P1Y2M3DT4H5M6.7S');
x := TDurationRemotable.Parse('-P1Y2M3DT4H5M6.7S');
CheckEquals(True,x.Negative);
CheckEquals(1,x.Year);
CheckEquals(2,x.Month);
@ -2734,19 +2725,13 @@ begin
CheckEquals(5,x.Minute);
CheckEquals(6,x.Second);
CheckEquals(7,x.FractionalSecond);
FreeAndNil(x);
finally
x.Free();
end;
end;
procedure TTest_TDurationRemotable.Parse_time_only();
var
x : TDurationRemotable;
x : TDurationRec;
begin
x := TDurationRemotable.Create();
try
x.Parse('PT1H2M3.4S');
x := TDurationRemotable.Parse('PT1H2M3.4S');
CheckEquals(False,x.Negative);
CheckEquals(0,x.Year);
CheckEquals(0,x.Month);
@ -2755,10 +2740,8 @@ begin
CheckEquals(2,x.Minute);
CheckEquals(3,x.Second);
CheckEquals(4,x.FractionalSecond);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Parse('-PT1H2M3.4S');
x := TDurationRemotable.Parse('-PT1H2M3.4S');
CheckEquals(True,x.Negative);
CheckEquals(0,x.Year);
CheckEquals(0,x.Month);
@ -2767,10 +2750,8 @@ begin
CheckEquals(2,x.Minute);
CheckEquals(3,x.Second);
CheckEquals(4,x.FractionalSecond);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Parse('PT1H');
x := TDurationRemotable.Parse('PT1H');
CheckEquals(False,x.Negative);
CheckEquals(0,x.Year);
CheckEquals(0,x.Month);
@ -2779,10 +2760,8 @@ begin
CheckEquals(0,x.Minute);
CheckEquals(0,x.Second);
CheckEquals(0,x.FractionalSecond);
FreeAndNil(x);
x := TDurationRemotable.Create();
x.Parse('PT1S');
x := TDurationRemotable.Parse('PT1S');
CheckEquals(False,x.Negative);
CheckEquals(0,x.Year);
CheckEquals(0,x.Month);
@ -2791,27 +2770,13 @@ begin
CheckEquals(0,x.Minute);
CheckEquals(1,x.Second);
CheckEquals(0,x.FractionalSecond);
FreeAndNil(x);
finally
x.Free();
end;
end;
procedure TTest_TDurationRemotable.Parse_zero();
var
x : TDurationRemotable;
x : TDurationRec;
begin
x := TDurationRemotable.Create();
try
x.Negative := True;
x.Year := 1;
x.Month := 2;
x.Day := 3;
x.Hour := 4;
x.Minute := 5;
x.Second := 6;
x.FractionalSecond := 7;
x.Parse('P0Y');
x := TDurationRemotable.Parse('P0Y');
CheckEquals(False,x.Negative);
CheckEquals(0,x.Year);
CheckEquals(0,x.Month);
@ -2820,18 +2785,13 @@ begin
CheckEquals(0,x.Minute);
CheckEquals(0,x.Second);
CheckEquals(0,x.FractionalSecond);
finally
x.Free();
end;
end;
procedure TTest_TDurationRemotable.parse_negative();
var
x : TDurationRemotable;
x : TDurationRec;
begin
x := TDurationRemotable.Create();
try
x.Parse('-P3YT4S');
x := TDurationRemotable.Parse('-P3YT4S');
CheckEquals(True,x.Negative);
CheckEquals(3,x.Year);
CheckEquals(0,x.Month);
@ -2840,135 +2800,96 @@ begin
CheckEquals(0,x.Minute);
CheckEquals(4,x.Second);
CheckEquals(0,x.FractionalSecond);
finally
x.Free();
end;
end;
procedure TTest_TDurationRemotable.parse_invalid_1();
const S_EXPR = 'P-1347M';
var
x : TDurationRemotable;
ok : Boolean;
begin
x := TDurationRemotable.Create();
try
ok := False;
try
x.Parse(S_EXPR);
TDurationRemotable.Parse(S_EXPR);
except
on e : EConvertError do
ok := True;
end;
Check(ok, Format('Must fail with : "%s"',[S_EXPR]));
finally
x.Free();
end;
end;
procedure TTest_TDurationRemotable.parse_invalid_2();
const S_EXPR = 'P1Y2MT';
var
x : TDurationRemotable;
ok : Boolean;
begin
x := TDurationRemotable.Create();
try
ok := False;
try
x.Parse(S_EXPR);
TDurationRemotable.Parse(S_EXPR);
except
on e : EConvertError do
ok := True;
end;
Check(ok, Format('Must fail with : "%s"',[S_EXPR]));
finally
x.Free();
end;
end;
procedure TTest_TDurationRemotable.parse_invalid_3();
const S_EXPR = 'XOJDQJKJ';
var
x : TDurationRemotable;
ok : Boolean;
begin
x := TDurationRemotable.Create();
try
ok := False;
try
x.Parse(S_EXPR);
TDurationRemotable.Parse(S_EXPR);
except
on e : EConvertError do
ok := True;
end;
Check(ok, Format('Must fail with : "%s"',[S_EXPR]));
finally
x.Free();
end;
end;
procedure TTest_TDurationRemotable.parse_invalid_4();
const S_EXPR = 'P';
var
x : TDurationRemotable;
ok : Boolean;
begin
x := TDurationRemotable.Create();
try
ok := False;
try
x.Parse(S_EXPR);
TDurationRemotable.Parse(S_EXPR);
except
on e : EConvertError do
ok := True;
end;
Check(ok, Format('Must fail with : "%s"',[S_EXPR]));
finally
x.Free();
end;
end;
procedure TTest_TDurationRemotable.parse_invalid_5();
const S_EXPR = 'P45DH';
var
x : TDurationRemotable;
ok : Boolean;
begin
x := TDurationRemotable.Create();
try
ok := False;
try
x.Parse(S_EXPR);
TDurationRemotable.Parse(S_EXPR);
except
on e : EConvertError do
ok := True;
end;
Check(ok, Format('Must fail with : "%s"',[S_EXPR]));
finally
x.Free();
end;
end;
procedure TTest_TDurationRemotable.parse_empty();
const S_EXPR = '';
var
x : TDurationRemotable;
ok : Boolean;
begin
x := TDurationRemotable.Create();
try
ok := False;
try
x.Parse(S_EXPR);
TDurationRemotable.Parse(S_EXPR);
except
on e : EConvertError do
ok := True;
end;
Check(ok, Format('Must fail with : "%s"',[S_EXPR]));
finally
x.Free();
end;
end;
{ TTest_TTimeRemotable }
@ -2996,7 +2917,7 @@ begin
end;
{$ENDIF FPC}
procedure TTest_TTimeRemotable.ToString();
procedure TTest_TTimeRemotable.ToStr();
const
sVALUE_1 = '01:23:45.678';
sVALUE_2 = '12:34:56';
@ -3006,13 +2927,13 @@ var
begin
//hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
d := xsd_EncodeTime(01,23,45,678);
CheckEquals(sVALUE_1, Copy(TTimeRemotable.ToString(d),1,Length(sVALUE_1)));
CheckEquals(sVALUE_1, Copy(TTimeRemotable.ToStr(d),1,Length(sVALUE_1)));
d := xsd_EncodeTime(12,34,56,0);
CheckEquals(sVALUE_2, Copy(TTimeRemotable.ToString(d),1,Length(sVALUE_2)));
CheckEquals(sVALUE_2, Copy(TTimeRemotable.ToStr(d),1,Length(sVALUE_2)));
d := xsd_EncodeTime(20,34,56,0);
CheckEquals(sVALUE_3, Copy(TTimeRemotable.ToString(d),1,Length(sVALUE_3)));
CheckEquals(sVALUE_3, Copy(TTimeRemotable.ToStr(d),1,Length(sVALUE_3)));
end;
procedure TTest_TTimeRemotable.Parse();

4
wst/trunk/tests/test_suite/testformatter_unit.pas
View File

@ -3006,7 +3006,7 @@ begin
CheckEquals(Ord(teFour),Ord(a.ObjProp.Val_Enum));
CheckEquals('456',a.ObjProp.Val_String);
CheckEquals(WideString('wide456'),a.ObjProp.Val_WideString);
CheckEquals(TDateRemotable.FormatDate(DATE_VALUE),TDateRemotable.FormatDate(a.ObjProp.Val_Date.AsDate));
CheckEquals(TDateRemotable.ToStr(DATE_VALUE),TDateRemotable.ToStr(a.ObjProp.Val_Date.AsDate));
CheckEquals(TIME_VALUE,a.ObjProp.Val_Time.AsString);
{$IFDEF WST_UNICODESTRING}
CheckEquals('unicode456',a.ObjProp.Val_UnicodeString);
@ -4820,7 +4820,7 @@ begin
CheckEquals(Ord(teFour),Ord(a.ObjProp.Val_Enum));
CheckEquals('456',a.ObjProp.Val_String);
CheckEquals(WideString('wide456'),a.ObjProp.Val_WideString);
CheckEquals(TDateRemotable.FormatDate(DATE_VALUE),TDateRemotable.FormatDate(a.ObjProp.Val_Date.AsDate));
CheckEquals(TDateRemotable.ToStr(DATE_VALUE),TDateRemotable.ToStr(a.ObjProp.Val_Date.AsDate));
{$IFDEF WST_UNICODESTRING}
CheckEquals('unicode456',a.ObjProp.Val_UnicodeString);
{$ENDIF WST_UNICODESTRING}