t_id
88
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
tr_id | run | tr_ok | tr_skip | tr_result |
---|---|---|---|---|
522887165 | 947769 | True | False | Successfully run |
Record count: 1
Program ansitest; {$ifdef cpu68k} {$define COMP_IS_INT64} {$endif cpu68k} {$ifndef fpc} Function Memavail : Longint; begin Result:=0; end; {$endif} { ------------------------------------------------------------------- General stuff ------------------------------------------------------------------- } Procedure DoMem (Var StartMem : Longint); begin Writeln ('Lost ',StartMem-Memavail,' Bytes.'); StartMem:=MemAvail; end; Procedure DoRef (P : Pointer); Type PLongint = ^Longint; begin If P=Nil then Writeln ('(Ref : Empty string)') else {$ifdef fpc} Writeln (' (Ref: ',Plongint(Longint(P)-4)^,',Len: ',PLongint(Longint(P)-8)^,')'); {$else} Writeln (' (Ref: ',Plongint(Longint(P)-8)^,',Len: ',PLongint(Longint(P)-4)^,')'); {$endif} end; { ------------------------------------------------------------------- Initialize/Finalize test ------------------------------------------------------------------- } Procedure TestInitFinal; Type ARec = record FirstName, LastName : AnsiString; end; AnArray = Array [1..10] of AnsiString; Var S : AnsiString; AR : Arec; AAR : AnArray; I : longint; Begin S:='This is an ansistring!'; If Pointer(AR.FirstNAme)<>Nil then Writeln ('AR.FirstName not OK'); If Pointer(AR.LastName)<>Nil then Writeln ('AR.LastName not OK'); for I:=1 to 10 do If Pointer(AAR[I])<>Nil then Writeln ('Array (',I,') NOT ok'); AR.FirstName:='Napoleon'; AR.LastName:='Bonaparte'; For I:=1 to 10 do AAR[I]:='Yet another AnsiString'; Writeln ('S : ',S); Writeln (AR.FirstName, ' ', AR.LastName); For I:=1 to 10 do Writeln (I:2,' : ',AAR[i]); end; { ------------------------------------------------------------------- Parameter passing test ------------------------------------------------------------------- } Procedure TestVarParam (Var Sv : AnsiString); Var LS : AnsiString; begin Write ('TestVarParam : Got S="',Sv,'"'); DoRef(Pointer(Sv)); Sv:='This is a var parameter ansistring'; Write ('S Changed to : ',Sv); DoRef (Pointer(Sv)); Ls:=Sv; Write ('Assigned to local var: "',ls,'"'); DoRef (Pointer(Sv)); end; Procedure TestValParam (S : AnsiString); Var LS : AnsiString; begin Write ('TestValParam : Got S="',S,'"'); S:='This is a value parameter ansistring'; Write ('S Changed to : ',S); DoRef(Pointer(S)); Ls:=S; Write ('Assigned to local var: "',ls,'"'); DoRef(Pointer(S)); end; Procedure TestConstParam (Const Sc : AnsiString); Var LS : AnsiString; begin Write ('TestConstParam : Got S="',Sc,'"'); DoRef(Pointer(Sc)); Ls:=Sc; Write ('Assigned to local var: "',ls,'"'); DoRef(Pointer(Sc)); end; Procedure TestParams; Var S : AnsiString; Mem : Longint; begin Mem:=MemAvail; S :='This is another ansistring'; Writeln ('Calling testvalparam with "',s,'"'); testvalparam (s); DoMem(Mem); Writeln ('Calling testConstparam with "',s,'"'); testconstparam (s); DoMem(Mem); Writeln ('Calling testvarparam with "',s,'"'); testvarparam (s); Writeln ('TestVarParam returned with "',S,'"'); DoMem(Mem); end; { ------------------------------------------------------------------- Comparision operators test ------------------------------------------------------------------- } Procedure TestCompare; Const S1 : AnsiString = 'Teststring 1'; S2 : AnsiString = 'Teststring 1'; S3 : AnsiString = 'Teststring 2'; S4 : AnsiString = ''; PC : Pchar = 'Teststring 1'; Var S,T : AnsiString; ss : Shortstring; begin If S1=S2 then writeln ('S1 and S2 are the same'); If S4='' then Writeln ('S4 is empty. OK'); If Not(S4='Non-empty') then writeln ('S4 is not non-empty'); if S3='Teststring 2' then writeln('S3 equals "Teststring 2". OK.'); Write ('S3<>S2 : '); If S2<>S3 Then writeln ('OK') else writeln ('NOT OK'); Write ('S3>S2 : '); If (S3>S2) Then Writeln ('OK') else writeln ('NOT OK'); Write ('S1S3 do begin INc(i); If I=10 then s3:='ABCDEF'; end; Writeln (' Done'); end; Procedure TestStdFunc; Var S,T : AnsiString; SS : ShortString; C : Char; Ca : Cardinal; L : longint; I : Integer; W : Word; B : Byte; R : Real; D : Double; E : Extended; Si : Single; Co : Comp; TempMem:Longint; begin TempMem:=Memavail; S:='ABCDEF'; Write ('S = "',S,'"');Doref(Pointer(S)); T:=Copy(S,1,3); Write ('T : "',T,'"');DoRef(Pointer(T)); T:=Copy(S,3,3); Write ('T : "',T,'"');DoRef(Pointer(T)); T:=Copy(S,3,6); Write ('T : "',T,'"');DoRef(Pointer(T)); Writeln ('Inserting "123" in S at pos 4'); Insert ('123',S,4); Write ('S = "',S,'"');DoRef(Pointer(S)); Writeln ('Deleting 3 characters From S starting Pos 4'); Delete (S,4,3); Write ('S = "',S,'"');Doref(Pointer(S)); Writeln ('Pos ''DE'' in S is : ',Pos('DE',S)); Write ('S = "',S,'"');Doref(Pointer(S)); Writeln ('Setting T to ''DE''.'); T:='DE'; //!! Here something weird is happening ? S is lost ??? Writeln('***'); Writeln ('Pos T in S is : ',Pos(T,S)); Write ('S = "',S,'"');Doref(Pointer(S)); Writeln ('Setting T to ''D''.'); T:='D'; Writeln ('Pos T in S is : ',Pos(T,S)); Write ('S = "',S,'"');Doref(Pointer(S)); Writeln ('Setting T to ''DA''.'); T:='DA'; Writeln ('Pos T in S is : ',Pos(T,S)); Write ('S = "',S,'"');Doref(Pointer(S)); Writeln ('SS:=''DE'''); Writeln('***'); SS:='DE'; Writeln ('Pos SS in S is : ',Pos(SS,S)); Write ('S = "',S,'"');Doref(Pointer(S)); Writeln ('C:=''D'''); C:='D'; Writeln ('Pos C in S is : ',Pos(C,S)); Write ('S = "',S,'"');Doref(Pointer(S)); Writeln ('Pos ''D'' in S is : ',Pos('D',S)); Write ('S = "',S,'"');Doref(Pointer(S)); Write ('str(Ca,S)= '); ca:=1; str(Ca,S); Writeln (S); Write ('str(L,S)= '); L:=2; str(L,S); Writeln (S); Write ('str(I,S)= '); I:=3; str(I,S); Writeln (S); Write ('str(W,S)= '); W:=4; str(W,S); Writeln (S); Write ('str(R,S)= '); R:=1.0; str(R,S); Writeln (S); Write ('str(D,S)= '); D:=2.0; str(D,S); Writeln (S); Write ('str(E,S)= '); E:=3.0; str(E,S); Writeln (S); Write ('str(Co,S)= '); {$ifdef COMP_IS_INT64} Co:=4; {$else} Co:=4.0; {$endif} str(Co,S); Writeln (S); Write ('str(Si,S)= '); Si:=5.0; str(Si,S); Writeln (S); end; Var GlobalStartMem,StartMem : Longint; begin GlobalStartMem:=MemAvail; StartMem:=MemAvail; Writeln ('Testing Initialize/Finalize.'); TestInitFinal; Write ('End of Initialize/finalize test : ');DoMem(StartMem); Writeln;Writeln ('Testing parameter passing.'); TestParams; Write ('End of Parameter passing test : ');DoMem(StartMem); Writeln;Writeln ('Testing comparision operators'); TestCompare; Write ('End of compare test : ');DoMem(StartMem); Writeln;Writeln ('Testing setlength of AnsiStrings'); TestSetLength; Write ('End of setlength test : ');DoMem(StartMem); Writeln;Writeln ('Testing Adding of AnsiStrings'); TestAdd; Write ('End of adding test : ');DoMem(StartMem); Writeln;Writeln ('Testing Adding of AnsiStrings in expressions'); TestAddExpr; Write ('End of adding in expressions test : ');DoMem(StartMem); Writeln;Writeln ('Testing type conversion.'); TestConversion; Write ('End of typeconversion test : ');DoMem(StartMem); Writeln;Writeln ('Testing indexed access.'); TestIndex; Write ('End of index access test : ');DoMem(StartMem); Writeln;Writeln ('Testing standard functions.'); TestStdfunc; Write ('End of standard functions: ');DoMem(StartMem); Write ('For the whole program ');DoMem(GlobalStartMem); end.