mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 20:08:12 +02:00
344571cb4e
symconst.pas: + extend "thelpertype" by "ht_type" which tells the code in "pdecobj.parse_extended_type" that a type helper declaration has been parsed node.pas: + add a constant which identifies all constant node types ptype.pas: + read_named_type: add a parameter "hadtypetoken" to tell the code whether a "type" token had been parsed before + read_named_type: if an identifier "helper" is parsed we need to check whether "hadtypetoken" is true and the modeswitch "m_class" is set, but the "m_delphi" one is not; in that case we have a "type helper" declaration pgenutil.pas, generate_specialization: * adjust call to read_named_type pdecl.pas, types_dec: * adjust call to read_named_type pdecobj.pas: * parse_extended_type: extend for correct handling of primitive types (includes Delphi compatible handling as well) and reject types that are explicitly not allowed * method_dec: require "static" for class methods in type helpers * method_doc: allow constructors for type helpers as well paramgr.pas, tparamanager: * set_common_funcretloc_info: handle type helper constructors like record constructors * handle_common_ret_in_param: the "self" value of a type helper constructor is also returned in a parameter pexpr.pas: + add a function to postfixoperators which tries to find and apply a type helper for a given type * postfixoperators: try to apply type helpers for ordinal constants * postfixoperators: use the correct string type for string constants * postfixoperators: try to apply type helpers for enum constants * postfixoperators: try to apply type helpers for arrays * postfixoperators: try to apply type helpers for Variant * postfixoperators: try to apply type helpers for pointer types * postfixoperators: try to apply type helpers for other types * factor: check postfixoperators after _REALNUMBER, _CCHAR, _CWCHAR, _TRUE and _FALSE * factor: also check postfixoperators if a _POINT follows a _NIL symdef.pas, tdefawaresymtablestack.addhelpers: * use "generate_objectpascal_helper_key" to generate the key symtable.pas: + add function to generate the key value for the map of extended types using the extended def * adjust "search_last_objectpascal_helper" and "search_objectpascal_helper" to handle primitive types as well * use the new "generate_objectpascal_helper_key" function to generate the key pparautl.pas: * insert_self_and_vmt_para: don't insert the $vmt symbol for record or type helpers (ToDo: check whether class helpers really need the symbol as well) * insert_self_and_vmt_para: pass "self" as var parameter for type helpers as well psub.pas, generate_bodyentry_block: * also allow type helpers for constructor methods ncal.pas, tcallnode.gen_self_tree: * also use a temp variable for type helper constructors ncgcal.pas, tcgcallnode.secondcallparan: * allow Pointers to be passed as address param if it is the Self value of a type helper extending a pointer type * correctly handle the location in case of type helper constructors + add tests git-svn-id: trunk@23580 -
62 lines
1.5 KiB
ObjectPascal
62 lines
1.5 KiB
ObjectPascal
{ this tests that the correct helper is used for constants }
|
|
|
|
program tthlp4;
|
|
|
|
{$mode objfpc}
|
|
{$apptype console}
|
|
|
|
uses
|
|
uthlp;
|
|
|
|
procedure TestResult(aActual, aExpected, aError: LongInt);
|
|
begin
|
|
if aActual <> aExpected then begin
|
|
Writeln('Expected: ', aExpected, ' got: ', aActual, ' error: ', aError);
|
|
Halt(aError);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
ml: MyLongInt;
|
|
begin
|
|
Writeln('Ordinal constants');
|
|
TestResult(2.Test, -1, 1);
|
|
TestResult(-2.Test, -1, 2);
|
|
TestResult(200.Test, 1, 3);
|
|
TestResult(-200.Test, -2, 4);
|
|
TestResult(40000.Test, 2, 5);
|
|
TestResult(-20000.Test, -2, 6);
|
|
TestResult(-40000.Test, -4, 7);
|
|
TestResult(70000.Test, -4, 8);
|
|
TestResult(3000000000.Test, 4, 9);
|
|
TestResult($1ffffffff.Test, -8, 10);
|
|
TestResult($1fffffffffffffff.Test, -8, 11);
|
|
Writeln('Float constants');
|
|
TestResult(1.25.Test, 4, 12);
|
|
{$if sizeof(Extended) = sizeof(Double)}
|
|
TestResult(1.25e10.Test, 8, 14);
|
|
{$else}
|
|
TestResult(1.25e10.Test, 10, 14);
|
|
{$endif}
|
|
Writeln('Boolean constants');
|
|
TestResult(True.Test, 1, 15);
|
|
TestResult(False.Test, 1, 16);
|
|
Writeln('String constants');
|
|
TestResult('ShortString'.Test, 1, 17);
|
|
TestResult('UnicodeString'#1234.Test, 4, 18);
|
|
Writeln('Misc constants');
|
|
TestResult(Nil.Test, 1, 19);
|
|
TestResult(teOne.Test, 1, 20);
|
|
TestResult('a'.Test, - 1, 21);
|
|
TestResult(#1234.Test, - 2, 22);
|
|
{$push}
|
|
{$T-}
|
|
// => Pointer
|
|
TestResult((@ml).Test, 1, 23);
|
|
{$T+}
|
|
// => Pointer as well
|
|
TestResult((@ml).Test, 1, 24);
|
|
{$pop}
|
|
Writeln('OK');
|
|
end.
|