mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 20:39:25 +02:00
Merging of generics branch of Sven Barth
------------------------------------------------------------------------
r19731 | svenbarth | 2011-12-03 11:53:02 +0100 (Sa, 03 Dez 2011) | 2 lines
pexpr.pas, post_comp_expr_gendef:
This is not the result you are looking for: The result of "postfixoperators" is only set to true if either "again" was "true" once or the node was changed to an errornode. So using the result for deciding whether we overwrite the def or not is incorrect. So just call "postfixoperators" and process the returned node accordingly.
------------------------------------------------------------------------
r19723 | svenbarth | 2011-12-02 15:28:23 +0100 (Fr, 02 Dez 2011) | 1 line
Added a few more tests. All except tgeneric65.pp (object inside generic record) and tgeneric68.pp (object inside generic object) are successfully compiled.
------------------------------------------------------------------------
r19722 | svenbarth | 2011-12-02 15:12:42 +0100 (Fr, 02 Dez 2011) | 1 line
Fix a remaining artefact from the overloaded symbols approach (just a comment, but nevertheless a change...)
------------------------------------------------------------------------
r19721 | svenbarth | 2011-12-02 15:11:56 +0100 (Fr, 02 Dez 2011) | 3 lines
ptype.pas, read_named_type, expr_type:
* Adjust a comment.
* Add an additional check for the owning symtable of the dummy symbol and the current_structdef just to be on the save side (it's not needed inside specializations)
------------------------------------------------------------------------
r19720 | svenbarth | 2011-12-02 15:11:06 +0100 (Fr, 02 Dez 2011) | 1 line
Fix the test. It's mode Delphi, but does not compile in Delphi, because "TSomeRecord" and "TSomeRecord<T>" are different identifiers.
------------------------------------------------------------------------
r19719 | svenbarth | 2011-12-02 15:10:06 +0100 (Fr, 02 Dez 2011) | 18 lines
Fix introduced regressions.
pgenutil.pas, generate_specialization:
* If we are parsing the result type of a function or operator that belongs to a generic (parse_generic is true) we need to accept also "_LT" and "_GT" as for this the "block_type" is NOT set to one of "bt_type", "bt_var_type", "bt_const_type" and only there "_LSHARPBRACKET" and "_RSHARPBRACKET" are returned by the scanner. This is part of the fix for webtbs\tw18567.pp.
* In non—Delphi modes if we encounter a specialization of the currently parsed class/record (using "specialization"!) the given "tt" will be an errordef (because the def of the generic's symbol was not yet set to "current_structdef"). To solve this we check in this case whether the calculated generic name is equal to that of the "current_structdef" and simply return that as specialized def. This fixes test\tgeneric11.pp.
* When searching for the generic symbol search if the generic belongs to a class or record then we need to search for it in the class or record. This fixes webtbs\tw16090.pp.
ptype.pas
* parse_nested_types: We now return the generic defs for specializations inside generics instead of an undefined def, so we must also parse nested type usages correctly, so that type checks don't fail (undefined defs circumvent them mostly). This fixes webtbs\tw10247.pp.
* single_type: We need to allow _LT as an indication for a Delphi specialization as return types are parsed with block_type not in "bt_type", "bt_var_type", "bt_const_type". This is also a fix a part of the fix for webtbs\tw18567.pp.
* read_named_type, expr_type:
Fixes for test\tgeneric17.pp and test\tgeneric22.pp:
(a) In non-Delphi modes we might encounter usages of the generic dummy symbol inside the generic class belonging to it. This is basically a specialization, but as the reference from the dummy symbol to the "current_structdef" is not yet established (this is done after "read_named_type" in "types_dec" returns) we need to use other ways to check for the valid use of the dummy symbol (basically we check whether the name of the dummy symbol and the name of the current_structdef without the type count match)
(b) For specializations we can check whether the genericdef of the currently parsed structdef (the specialization) is the same as the typedef of the encountered dummy symbol.
pexpr.pas, factor, factor_read_id:
Fixes for test\tgeneric17.pp and test\tgeneric22.pp:
To allow the mentioned fixes in ptype for the same tests to be usable at all we must not return an "identifier not found" error if we encounter such a valid use of a generic dummy symbol.
------------------------------------------------------------------------
r19718 | svenbarth | 2011-12-02 15:08:46 +0100 (Fr, 02 Dez 2011) | 3 lines
generate_specialization:
* Remove some unused variables
* Fix a comment
------------------------------------------------------------------------
r19685 | svenbarth | 2011-11-25 16:25:10 +0100 (Fr, 25 Nov 2011) | 1 line
Incorporate the changes from trunk into "postfixoperators" and "handle_factor_typenode". The latter needed to be extended by a parameter "typeonly" which is "false" in almost all calls except the one inside "factor_read_id" where the "typeonly" parameter of "factor" is used.
------------------------------------------------------------------------
r19676 | svenbarth | 2011-11-24 17:48:47 +0100 (Do, 24 Nov 2011) | 4 lines
Rebase to revision 19673
pexpr.pas: Changes in postfixoperators and the base of handle_factor_typenode not yet incorporated (the code from trunk was simply commented for now)
------------------------------------------------------------------------
r19675 | svenbarth | 2011-11-24 15:42:42 +0100 (Do, 24 Nov 2011) | 11 lines
Somehow the changes regarding tf_methods_specialized weren't commited, thus here they are again:
* symconst.pas: remove tf_methods_specialized
* psub.pas: remove check for/inclusion of tf_methods_specialized as this isn't needed anymore since the generic is specialized in a temporary symtable
pgenutil.pas: remove merge artifacts
pdecl.pas: fix compilation ("s" was duplicate)
pexpr.pas:
* fix calling of generate_specialization
* disable the goto in sub_expr for now; this will be enabled again once right hand sides work as well
------------------------------------------------------------------------
r19674 | svenbarth | 2011-11-24 11:19:57 +0100 (Do, 24 Nov 2011) | 3 lines
Rebase to revision 19078 (directly before the merge of cpstrnew)
The changes regarding pretty names for generics and token buffer endianess were integrated into my changes. Not every call to generate_specialization is fixed though, so compilation will fail.
------------------------------------------------------------------------
r19671 | svenbarth | 2011-11-23 18:25:09 +0100 (Mi, 23 Nov 2011) | 79 lines
Merge branch 'unique-syms'
Conflicts:
compiler/pdecl.pas
compiler/pexpr.pas
compiler/pgenutil.pas
compiler/ptype.pas
The original log messages as git was a bit forgetting here :( (newest at the top):
?commit 7ef252de8023494ee6d39910e289f9e31658d47b
Author: Sven Barth <pascaldragon@minerva>
Date: Mon Nov 21 17:13:36 2011 +0100
Fix the compilation of inline specializations of which the generic is derived from another generic.
pgenutil.pas, generate_specialization:
* Set the "block_type" to "bt_type" when parsing the type parameters, so that the nodes are returned as "ttypenode" instead of e.g. "tloadvmtaddrnode" in case of classes outside of type sections.
* Set the "block_type" to "bt_type" before calling "read_name_type", so that no unexpected sideeffects happen, because types like classes normally only are declared inside type sections (e.g. for the case a generic class is derived from another generic class a classrefdef for the specialized parent class will be created inside the derived specialized class if the block type is not a type one).
commit 1041a8f7a3a41f4fdf2975ce40055c698281ce71
Author: Sven Barth <pascaldragon@minerva>
Date: Fri Nov 18 19:03:50 2011 +0100
Improve inline specializations a bit, so now expressions like "TSomeGeneric<TSomeType>.SomeClassProc OP SomeNonGeneric" is possible. Using another class function of a generic as the right side is not yet working (that still needs some thinking).
To achive this the generalization code must basically continue directly after the "factor" call, so that the operator and the right side are correctly parsed when walking up the call stack. This is done by jumping from the end of the specialization code in the "<"-case to the start of "sub_expr". The freshly generated node (in the above example a callnode) will be passed down the callstack through a new parameter "factornode". If that is set (currently only in the case of a specialization on the left side) "factor" won't be called and the right side will be parsed with the "factornode" as the left side. If it is not set (which is the case for all other calls to "sub_expr" in the unit) then the usual call to "factor" will be done and the result will be used as the left side.
commit a01ccd265f8d6cc5a2f3e88e23afbcd3d5960afb
Author: Sven Barth <pascaldragon@minerva>
Date: Fri Nov 18 18:37:04 2011 +0100
Fix compilation of ppudump.
symconst.pas:
* Remove sto_has_generic, which was the last remainer of my "overloaded type symbols" approach.
* Remove df_methods_specialized, as it isn't needed anymore with the recent "temporary symtable" solution.
psub.pas, specialize_objectdefs, process_abstractrecorddef:
Remove the checks for/inclusion of df_methods_specialized.
utils/ppudump.pp:
Add "sp_generic_dummy" to the symbol options.
commit d16deac060e65d4b53e8fe9c27fe7e1f6d00a416
Author: Sven Barth <pascaldragon@minerva>
Date: Wed Nov 16 16:34:51 2011 +0100
Fix compilation of "gset.pp" from fcl-stl.
nld.pas:
Extend ttypenode by a reference to the type symbol. Normally this is simply the typesym of the given def, but for specializations in type sections of generics this is not the case, because generate_specialization will return a reference to the generic definition and not the new one (thus the symbol will be wrong).
ppu.pas:
Increase PPU version because of the extension of ttypenode.
pexpr.pas:
* handle_factor_typenode: Extend the function by a "sym" parameter which will normally be "nil". In that case it is set to the def's typesym. The "typesym" field of the created type node is then set to this sym.
* For now pass nearly always "nil" for the above mentioned sym except inside factor_read_id when we've encountered a typesym.
ptype.pas, read_named_type, expr_type:
Exchange the "is_owned_by" check with a "sym_is_owned_by" check so that we can correctly detect that we are using a specialized type declaration inside a generic (once nested generic are allowed this condition needs to be checked).
commit 23668d2fc9070afc26b4288ed0db9a8eaf6f40e6
Author: Sven Barth <pascaldragon@minerva>
Date: Wed Nov 16 07:51:12 2011 +0100
psub.pas:
* tcgprocinfo.parse_body: Methods of generic classes need to set "parse_generic" as well, so that variables for "stacked generics" (generic array => generic record) inside the method body are handled correctly.
* specialize_objectdefs: Don't try to generate method bodies for abstract methods.
pdecvar.pas, read_property_dec:
Allow specializations for the return types of properties (should they be allowed for index types as well?).
symtable.pas:
Add a new class "tspecializesymtable" which is basically a globalsymtable but is always assuming to be the current unit. This symtable is used in "generate_specializations" (see below) and is needed to allow visibilty checks for "private", etc. to succeed.
pgenutil.pas, generate_specializations:
Instead of hackily pushing a symtable that may contain conflicting symbols onto the symtable stack for the specialization, a temporary global symtable using the above mentioned "tspecializesymtable" is created and pushed. After the specialization is done all symbols and defs that were added to the temporary symtable are moved to their final symtable (either the global- or localsymtable of the unit, depending on the current position of compilation). This way symbols are correctly added to a top level symtable, but without potential side effects like resolving the wrong symbol.
------------------------------------------------------------------------
r19435 | svenbarth | 2011-10-09 18:16:19 +0200 (So, 09 Okt 2011) | 1 line
Set "current_structdef", "current_genericdef" and "current_specializedef" to values that were valid during the declaration of the generic when specializing it ("current_genericdef" and "current_specializedef" might need to still be corrected though)
------------------------------------------------------------------------
r19434 | svenbarth | 2011-10-09 18:15:26 +0200 (So, 09 Okt 2011) | 2 lines
Arrays and procvars inside a generic declaration are not declared as generic/specialization anymore (this partly reverts a previous commit). This reduces the problematic cases in the check whether a found def was specialized inside the class (the changed check in read_named_type.expr_type).
It's still not an ideal solution as the usage of generic classes/records (without specialization!) that are declared inside the current parsed class/record will compromise this check again.
------------------------------------------------------------------------
r19433 | svenbarth | 2011-10-09 18:14:33 +0200 (So, 09 Okt 2011) | 1 line
Extend the test with a usage of "TTestInteger" and correct the comments a bit.
------------------------------------------------------------------------
r19432 | svenbarth | 2011-10-09 18:13:30 +0200 (So, 09 Okt 2011) | 9 lines
We need to flag specializations of record-/objectdef once we have generated their methods otherwise an interesting situation might occur:
The classes in "fgl.pas" implement an enumerator in the generic class "TFPGListEnumerator" and "specialize" that inside themselves. If we now specialize one of the generic classes (e.g. "TFPGList") the "TFPGListEnumerator" is really specialized as well. That means a def is added to the global symtable (the local one in case of a program or library file). If we now use the enumerator class in the same file (e.g. by using a "for ... in", which has a temporary variable of that type) then the methods of the enumerator are specialized again (the def itself is not). To avoid this (and time consuming searches for existing method specializations) we flag the specialized def as "done" once we're finished.
symconst.pas
* add a new flag "df_methods_specialized" to the "tdefoption" enumeration
psub.pas, process_abstractrecorddef
* check the def for the "df_methods_specialized" flag and continue only if that is not set
* set the "df_methods_specialized" flag before leaving the function
------------------------------------------------------------------------
r19431 | svenbarth | 2011-10-09 18:12:25 +0200 (So, 09 Okt 2011) | 1 line
This check was commited by accident; it was a remain from an experimental solution to the "fix compilation of fgl"-problem.
------------------------------------------------------------------------
r19430 | svenbarth | 2011-10-09 18:11:31 +0200 (So, 09 Okt 2011) | 19 lines
Fix compilation of unit "fgl.pp" and of test "tests/test/tgeneric29.pp".
symtable.pas:
* reduce the "childdef" parameter of "is_owned_by" from "tabstractrecorddef" to "tdef", so that more primitive defs can be checked as well
* add a new function "sym_is_owned_by" which is similar to "is_owned_by", but takes a symbol and a symtable as parameter; the owner chain of the symtable is checked until a non-object- and non-record-symtable is reached
ptype.pas:
* extend "id_type", so that the symbol and the symtable that belongs to the returned def is returned as well
* this is needed to check inside "single_type" whether a def that is a generic was specialized inside another generic, because in that case the genericdef is returned by "generate_specialization" and not a new specialized def, but the corresponding type symbol (which is different from "hdef.typesym") belongs to the class itself; I need to admit that this solution isn't very clean and one could try to circumvent some of the checks, so I need to find a better detection for such a case (concrete example: the enumerator specialization inside the classes of "fgl.pas")
* in "read_named_type.expr_type" the check for "df_generic" is extended analogous to the previous change, but instead of relying on the symbol it uses the def. This is needed so that types like method pointers that are defined inside the current generic are not disallowed as they contain the "df_generic" flag as well; like the previous change this change isn't clean either and maybe it's better to remove the inclusion of the "df_generic" flag from everything except records and "objects" inside records/"objects" again. Such a solution will "only" reduce the problem to records and "objects" though...
pgenutil.pas:
* only add a new undefined def if we're not parsing the parent class or interfaces ("parse_class_parent" is true), otherwise the InternalError regarding the "equal count of defs" will trigger
* there are now two cases where we need to return a generic def instead of a undefined one when we're parsing a generic:
a) we have the previously mentioned case that "parse_class_parent" is true
b) an undefined def was added, but we need to return a generic def, so that checks can be passed
* use the correct variable when building the generic name, otherwise we get errors like "identifier '$1' not found"
* don't push the symtable if we're currently parsing the list of interfaces or the parent class, because then e.g. a generic interface will be included in the symtable of the implementing class which isn't what we want; the current solution is not clean though, so this needs to be investigated more
* Note: In the current state of "generate_specialization" the function could be simplyfied a bit more; this will be done when the implementation is satisfactory enough
------------------------------------------------------------------------
r19429 | svenbarth | 2011-10-09 18:10:28 +0200 (So, 09 Okt 2011) | 20 lines
Allow generics to be overloaded by variables.
* symconst.pas:
add an entry for the generic dummy symbol to the symbol options enumeration
* pgenutil.pas:
- extend "generate_specialization" by the possibility to pass a symbol name instead of a def
- if "symname" is given that is used; otherwise "genericdef" or "tt" is used
* pexpr.pas:
- in case of "<" we are trying to receive a generic dummy symbol from the left node (new function "getgenericsym")
- it's name is then passed to "generate_specialization" which in turn fills genericdef
- adjust call to "generate_specialization"
* pdecl.pas:
- we can now check for "sp_generic_dummy instead of "not sp_generic_para" to check whether we've found the dummy symbol of a previous generic declaration
- if a new dummy symbol is created we need to include "sp_generic_dummy"
- if we've found a non-generic symbol with the same name we need to include the "sp_generic_dummy" flag as well
* symtable.pas
- add a new function "searchsym_with_symoption" that more or less works the same as "searchsym", but only returns successfully if the found symbol contains the given flag
- "searchsym_with_symoption" and "searchsym" are based on the same function "maybe_searchsym_with_symoption" which is the extended implementation of "searchsym" (note: object symtables are not yet searched if a symoption is to be looked for)
- add a function "handle_generic_dummysym" which can be used to hide the undefineddef symbol in a symtable
- correctly handle generic dummy symbols in case of variables in "tstaticsymtable.checkduplicate"
------------------------------------------------------------------------
r19428 | svenbarth | 2011-10-09 18:09:09 +0200 (So, 09 Okt 2011) | 3 lines
types_dec:
- fix a comment
- the created undefineddef must not be freed, as the count of the list the def is contained in, is used to find other defs again
------------------------------------------------------------------------
r19427 | svenbarth | 2011-10-09 18:08:15 +0200 (So, 09 Okt 2011) | 14 lines
Corrected the handling of hint directives.
pgenutils.pas/generate_specialization:
- parse hint directives of the generic if they are recorded
- output hint messages of the generic after the ">" is successfully parsed
pexpr.pas:
- factor: don't display hints of a potential generic type if the next token is a "<"
- sub_expr:
* added two inline methods which
a) checks whether a node is a typenode or a loadvmtaddrnode with a typenode
b) returns the typedef of such a node
* check hint directives for the first parsed type argument of a specialization
* in the case of parsing a non-generic type the hints of the left and right node of the resulting "<" node need to be checked (the right ones only if another "<" is following)
------------------------------------------------------------------------
r19426 | svenbarth | 2011-10-09 18:07:22 +0200 (So, 09 Okt 2011) | 5 lines
generate_specialization needs to return the correct generic def if the parent classes are parsed, so that that the usage of generic interfaces is allowed.
This fixes the compilation of test tests\test\tgeneric29.pp and the reminder in pdecobj.pas is not needed anymore.
Note: Perhaps this behavior should be enabled in general if "parse_generic" is true (and not only if parse_parent_class if true as well).
------------------------------------------------------------------------
r19425 | svenbarth | 2011-10-09 18:06:31 +0200 (So, 09 Okt 2011) | 1 line
Added two reminders for me
------------------------------------------------------------------------
r19424 | svenbarth | 2011-10-09 18:05:31 +0200 (So, 09 Okt 2011) | 32 lines
Switching from overloaded type symbol to unique symbol per generic.
Reasons for the "unique symbol" approach:
- no special search operations for cross unit search needed (which is supported by Delphi) => less performance impact
- no special care needed to really find the correct generic => less increase of parser complexity
Currently all generic tests except tgeneric29.pp compile and inline specializations work as well.
The changes in detail:
* pdecl.pas/types_dec:
- The variables used to hold the final name of the symbol are now prefixed with "gen". In case of non-generics the prefixed ones are equal to the non-prefixed ones (e.g. orgtypename=genorgtypename). In case of a generic symbol the "gen"-variants contain the type parameter count suffix (e.g. '$1' in case of 'TTest<T>') as well.
- The unmodified pattern is used to insert and detect a dummy symbol with that name, so that type declarations and - more important - inline specializations can find that symbol.
- In non-Delphi modes this symbol is also used to detect whether we have a type redefinition which is not allowed currently; its typedef points to the generic def.
- In mode Delphi the def of that dummy symbol (which contains an undefineddef) is modified when a corresponding non-generic type is parsed, so that it contains the def of the real type.
* pdecsub.pas/parse_proc_head
- consume_generic_type_parameter now only parses the type parameters and picks the generic with the correct amount of parameters. The verification of the order and names of the parameters needs to be added again.
- it also does not use "def" anymore, but it sets "srsym"
- in parse_proc_head the symbol (srsym) is only searched if the symbol isn't assigned already; in case of a generic in mode FPC it will find the dummy symbol that points to the generic def
* pexpr.pas
- in factor_read_id there are three cases to handle:
+ the symbol is not assigned => error
+ a possible generic symbol (either an undefined def or the non-generic variant) => no error and no hints
+ a non-generic symbol => hints
Point 1 is handled correctly, point 2 and 3 aren't currently and also they might be needed to be moved somewhere else
- sub_expr:
+ a node can be a tloadvmtaddrnode as well if the non-generic variant of a generic symbol is a class
+ we can only check afterwards whether the specialization was successful
* pgenutil.pas/generate_specialization
using the count of the parsed types the correct symbol can be found easily
------------------------------------------------------------------------
r18005 | svenbarth | 2011-07-16 18:19:33 +0200 (Sa, 16 Jul 2011) | 1 line
Rebase to revision 18000
------------------------------------------------------------------------
r18004 | svenbarth | 2011-07-16 16:13:56 +0200 (Sa, 16 Jul 2011) | 1 line
pexpr.pas, sub_expr: Added support for "as" and "is" operators if the right hand side is an inline specialization (currently detected by the next token being a "<"). This could potentially introduce some problems if the right hand side isn't a specialization but a "<" comparison together with some overloaded operators (I still need to find a case for such a problem)...
------------------------------------------------------------------------
r18003 | svenbarth | 2011-07-16 16:13:11 +0200 (Sa, 16 Jul 2011) | 5 lines
factor_read_id:
don't accept the generic dummy symbol if the next token isn't a "<"
sub_expr:
generate an error if we had a normal "<" comparison containing the dummy symbol on the left side instead of a specialization
------------------------------------------------------------------------
r18002 | svenbarth | 2011-07-16 16:12:25 +0200 (Sa, 16 Jul 2011) | 17 lines
Implement support for nested non-generic types inside generic types. This is mostly for records, classes and objects ("structures") as those didn't work at all, but the others (arrays, procvars) weren't done cleanly either.
pobjdec.pas (object_dec) / ptype.pas (record_dec, array_dec, procvar_dec):
- enable "parse_generic" if a nested type is parsed and we're already inside a generic (this prevents code to be generated for the nested type's methods)
- set the "df_specialization" flag so that the code for generating the methods (and thus resolving the forwards declarations) is called for this symbol
pexpr.pas:
add "post_comp_expr_gendef" which basically calls "handle_factor_typenode" and "postfixoperators" as those aren't exported from the unit themselves
ptype.pas, read_named_type.expr_type:
- use "post_comp_expr_gendef" to parse the use of nested types (e.g. "var t: TTest<T>.TTestSub")
psub.pas, specialize_objectdefs:
implement the generation of the method bodies for nested structures (resolves the forward declarations)
pdecl.pas, types_dec:
when we encounter a nested structure inside a specialization of a structure, we need to find the corresponding generic definition so that the generic can be correctly parsed later on.
------------------------------------------------------------------------
r18001 | svenbarth | 2011-07-16 16:11:31 +0200 (Sa, 16 Jul 2011) | 1 line
Finally fixed the handling of hint directives and added a comment explaining the situation in the context of generics.
------------------------------------------------------------------------
r17999 | svenbarth | 2011-07-16 16:10:34 +0200 (Sa, 16 Jul 2011) | 2 lines
* Reordered the conditions for the inline spezialization as the "isgeneric" boolean is not needed
* As "handle_factor_typenode" is now available the classrefdef wrapper is not needed anymore
------------------------------------------------------------------------
r17998 | svenbarth | 2011-07-16 16:09:38 +0200 (Sa, 16 Jul 2011) | 1 line
Removed the remaining traces of the type overloads and increased PPU version to differ from trunk.
------------------------------------------------------------------------
r17997 | svenbarth | 2011-07-16 16:08:49 +0200 (Sa, 16 Jul 2011) | 1 line
Integrated the changes from trunks's postfixoperators into my own and removed the local version again.
------------------------------------------------------------------------
r17996 | svenbarth | 2011-07-16 16:08:03 +0200 (Sa, 16 Jul 2011) | 5 lines
generate_specialization needs to return the correct generic def if the parent classes are parsed, so that that the usage of generic interfaces is allowed.
This fixes the compilation of test tests\test\tgeneric29.pp and the reminder in pdecobj.pas is not needed anymore.
Note: Perhaps this behavior should be enabled in general if "parse_generic" is true (and not only if parse_parent_class if true as well).
------------------------------------------------------------------------
r17995 | svenbarth | 2011-07-16 16:07:20 +0200 (Sa, 16 Jul 2011) | 1 line
Added two reminders for me
------------------------------------------------------------------------
r17547 | svenbarth | 2011-05-23 22:52:51 +0200 (Mo, 23 Mai 2011) | 1 line
Rebase to revision 17533
------------------------------------------------------------------------
r17542 | svenbarth | 2011-05-23 21:47:09 +0200 (Mo, 23 Mai 2011) | 4 lines
Added some tests for:
- multiple symbols with a similar name
- hint directives
- inline specializations
------------------------------------------------------------------------
r17541 | svenbarth | 2011-05-23 21:19:12 +0200 (Mo, 23 Mai 2011) | 3 lines
Allow typecasts to inline specializations as well.
For this the code which handles this inside factor_read_id had to be moved to local unit scope and is named handle_factor_typenode.
------------------------------------------------------------------------
r17540 | svenbarth | 2011-05-23 21:17:53 +0200 (Mo, 23 Mai 2011) | 1 line
Remove the (now) non-functional check for inline specialization.
------------------------------------------------------------------------
r17539 | svenbarth | 2011-05-23 21:16:39 +0200 (Mo, 23 Mai 2011) | 14 lines
Corrected the handling of hint directives.
pgenutils.pas/generate_specialization:
- parse hint directives of the generic if they are recorded
- output hint messages of the generic after the ">" is successfully parsed
pexpr.pas:
- factor: don't display hints of a potential generic type if the next token is a "<"
- sub_expr:
* added two inline methods which
a) checks whether a node is a typenode or a loadvmtaddrnode with a typenode
b) returns the typedef of such a node
* check hint directives for the first parsed type argument of a specialization
* in the case of parsing a non-generic type the hints of the left and right node of the resulting "<" node need to be checked (the right ones only if another "<" is following)
------------------------------------------------------------------------
r17538 | svenbarth | 2011-05-23 21:15:36 +0200 (Mo, 23 Mai 2011) | 5 lines
generate_specialization needs to return the correct generic def if the parent classes are parsed, so that that the usage of generic interfaces is allowed.
This fixes the compilation of test tests\test\tgeneric29.pp and the reminder in pdecobj.pas is not needed anymore.
Note: Perhaps this behavior should be enabled in general if "parse_generic" is true (and not only if parse_parent_class if true as well).
------------------------------------------------------------------------
r17537 | svenbarth | 2011-05-23 21:14:33 +0200 (Mo, 23 Mai 2011) | 1 line
Added two reminders for me
------------------------------------------------------------------------
r17536 | svenbarth | 2011-05-23 21:13:51 +0200 (Mo, 23 Mai 2011) | 1 line
This test does not need to be run
------------------------------------------------------------------------
r17535 | svenbarth | 2011-05-23 21:12:50 +0200 (Mo, 23 Mai 2011) | 32 lines
Switching from overloaded type symbol to unique symbol per generic.
Reasons for the "unique symbol" approach:
- no special search operations for cross unit search needed (which is supported by Delphi) => less performance impact
- no special care needed to really find the correct generic => less increase of parser complexity
Currently all generic tests except tgeneric29.pp compile and inline specializations work as well.
The changes in detail:
* pdecl.pas/types_dec:
- The variables used to hold the final name of the symbol are now prefixed with "gen". In case of non-generics the prefixed ones are equal to the non-prefixed ones (e.g. orgtypename=genorgtypename). In case of a generic symbol the "gen"-variants contain the type parameter count suffix (e.g. '$1' in case of 'TTest<T>') as well.
- The unmodified pattern is used to insert and detect a dummy symbol with that name, so that type declarations and - more important - inline specializations can find that symbol.
- In non-Delphi modes this symbol is also used to detect whether we have a type redefinition which is not allowed currently; its typedef points to the generic def.
- In mode Delphi the def of that dummy symbol (which contains an undefineddef) is modified when a corresponding non-generic type is parsed, so that it contains the def of the real type.
* pdecsub.pas/parse_proc_head
- consume_generic_type_parameter now only parses the type parameters and picks the generic with the correct amount of parameters. The verification of the order and names of the parameters needs to be added again.
- it also does not use "def" anymore, but it sets "srsym"
- in parse_proc_head the symbol (srsym) is only searched if the symbol isn't assigned already; in case of a generic in mode FPC it will find the dummy symbol that points to the generic def
* pexpr.pas
- in factor_read_id there are three cases to handle:
+ the symbol is not assigned => error
+ a possible generic symbol (either an undefined def or the non-generic variant) => no error and no hints
+ a non-generic symbol => hints
Point 1 is handled correctly, point 2 and 3 aren't currently and also they might be needed to be moved somewhere else
- sub_expr:
+ a node can be a tloadvmtaddrnode as well if the non-generic variant of a generic symbol is a class
+ we can only check afterwards whether the specialization was successful
* pgenutil.pas/generate_specialization
using the count of the parsed types the correct symbol can be found easily
------------------------------------------------------------------------
r17534 | svenbarth | 2011-05-23 21:11:50 +0200 (Mo, 23 Mai 2011) | 1 line
This fixes an access violation when compiling tests\test\tgeneric30.pp
------------------------------------------------------------------------
r17405 | svenbarth | 2011-05-04 12:43:13 +0200 (Mi, 04 Mai 2011) | 11 lines
*pexpr.pas:
- moved "postfixoperators" from local declaration of "factor" to implementation declarations of the unit, so it can be used in "sub_expr"
- for this a parameter "getaddr:boolean" needed to be added, because it used the parameter that was defined by "factor"
=> adjustments inside "factor" for calls to "postfixoperators"
- extended the "_LT" ("<") case of "sub_expr" with handling of inline generic specializations. If a potential generic is detected (Delphi mode, left and right node are type nodes, next token is ">" or ",") it is tried to parse the generic declaration and generate a specialization. If this succeeds, potential postfix operators are parsed and a node <> caddnode is returned.
*pgenutil.pas:
"generate_specialization" was extended so that the first type identifer can already have been parsed (which is the case in inline specializations)
*ptype.pas
adjustments because of the extension of "generate_specialization"
------------------------------------------------------------------------
r17404 | svenbarth | 2011-05-04 12:40:07 +0200 (Mi, 04 Mai 2011) | 1 line
Moved "parse_generic_parameters" and "insert_generic_parameter_types" from "pdecl.pas" to "pgenutil.pas"
------------------------------------------------------------------------
r17403 | svenbarth | 2011-05-04 12:35:23 +0200 (Mi, 04 Mai 2011) | 1 line
Moved "generate_specialization" from "ptype.pas" to "pgenutil.pas"
------------------------------------------------------------------------
r17397 | svenbarth | 2011-05-02 22:22:41 +0200 (Mo, 02 Mai 2011) | 3 lines
Added a file which will hold the various functions related to generic parsing. The header copyright notice and the info comment might not yet be final.
Note: I've added this mostly empty, because I used SVN instead of GIT SVN, as I don't know whether it would handle the properties for this new file correctly.
------------------------------------------------------------------------
r17396 | svenbarth | 2011-05-02 21:47:53 +0200 (Mo, 02 Mai 2011) | 6 lines
consume_generic_type_parameter now parses the available parameters first before deciding which generic def is the correct one (this is stored in the "def" variable of the parent frame). The count of the parameters and the order is checked.
parse_proc_head itself uses the correct def (the def found by consume_generic_type_parameter in mode Delphi and the first generic def of the symbol in the other modes) which is available in the "def" variable.
Status of generics:
Non-Delphi generics now work as before and declarations of Delphi generics work as well. Inline specialisations don't work currently.
------------------------------------------------------------------------
r17395 | svenbarth | 2011-05-02 21:46:41 +0200 (Mo, 02 Mai 2011) | 1 line
Added two TODOs for places that I'll need to adjust for inline specializations.
------------------------------------------------------------------------
r17394 | svenbarth | 2011-05-02 21:45:34 +0200 (Mo, 02 Mai 2011) | 12 lines
* ptype.pas:
"generate_specialization" now parses the generic parameters without verifying them. The verification is done after their count is known and thus the correct generic def can be determined.
Note: It does currently only work with the first found symbol, the extended lookup needs to be implemented yet (including the unit name works though)
* pexpr.pas:
In "factor_read_id" an "identifer not found" error is generated if the undefined non-generic def is used (e.g. as a type for a variable)
Note: This check needs to be adjusted for the case "typeonly=false".
Status of generics:
Specializations can now be parsed, but declarations containing methods are still broken, because the correct def is not yet resolved (not even talking about inline specializations yet ;) )
------------------------------------------------------------------------
r17393 | svenbarth | 2011-05-02 21:44:14 +0200 (Mo, 02 Mai 2011) | 9 lines
*type symbol overloads are only allowed in mode Delphi
*a check for overloads with the same count of arguments is not yet in place
*in non-Delphi modes overloads need to be checked for non-generics as well, e.g. "TTest<T>" is already defined and now a "TTest" is declared
*when a generic is encountered and the symbol does not yet exist, a new symbol with an undefineddef is added and the generic def is added as an overload; if the symbol already exists, the generic is just added
*if a non-generic is parsed and the symbol is already defined (but the typedef is still an undefineddef) then the typedef is updated
*the symtable tree (up to the unit symtable (global or local)) gets the "sto_has_generic" flag which will be used when searching generics with the same name, but different parameter counts in different units
State of generics:
broken, because the generic defs are not yet searched/found
------------------------------------------------------------------------
r17392 | svenbarth | 2011-05-02 21:42:40 +0200 (Mo, 02 Mai 2011) | 1 line
Extend ttypesym by a list that will contain all generic "overloads" of this symbol.
------------------------------------------------------------------------
r17341 | svenbarth | 2011-04-18 23:15:52 +0200 (Mo, 18 Apr 2011) | 1 line
Rebase to revision 17340
------------------------------------------------------------------------
r17316 | svenbarth | 2011-04-14 09:11:07 +0200 (Do, 14 Apr 2011) | 1 line
Created a branch for working on various aspects of generics
------------------------------------------------------------------------
git-svn-id: trunk@19763 -
This commit is contained in:
florian
commit
20b1e3af78
36
.gitattributes
vendored
36
.gitattributes
vendored
@ -361,6 +361,7 @@ compiler/pdecsub.pas svneol=native#text/plain
|
||||
compiler/pdecvar.pas svneol=native#text/plain
|
||||
compiler/pexports.pas svneol=native#text/plain
|
||||
compiler/pexpr.pas svneol=native#text/plain
|
||||
compiler/pgenutil.pas svneol=native#text/pascal
|
||||
compiler/pinline.pas svneol=native#text/plain
|
||||
compiler/pmodules.pas svneol=native#text/plain
|
||||
compiler/powerpc/agppcmpw.pas svneol=native#text/plain
|
||||
@ -10103,9 +10104,42 @@ tests/test/tgeneric32.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric33.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric34.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric35.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric36.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric37.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric38.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric39.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric4.pp svneol=native#text/plain
|
||||
tests/test/tgeneric40.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric41.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric42.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric43.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric44.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric45.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric46.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric47.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric48.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric49.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric5.pp svneol=native#text/plain
|
||||
tests/test/tgeneric50.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric51.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric52.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric53.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric54.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric55.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric56.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric57.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric58.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric59.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric6.pp svneol=native#text/plain
|
||||
tests/test/tgeneric60.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric61.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric62.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric63.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric64.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric65.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric66.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric67.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric68.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric7.pp svneol=native#text/plain
|
||||
tests/test/tgeneric8.pp svneol=native#text/plain
|
||||
tests/test/tgeneric9.pp svneol=native#text/plain
|
||||
@ -10602,6 +10636,8 @@ tests/test/ugeneric10.pp svneol=native#text/plain
|
||||
tests/test/ugeneric14.pp svneol=native#text/plain
|
||||
tests/test/ugeneric3.pp svneol=native#text/plain
|
||||
tests/test/ugeneric4.pp svneol=native#text/plain
|
||||
tests/test/ugeneric59a.pp svneol=native#text/pascal
|
||||
tests/test/ugeneric59b.pp svneol=native#text/pascal
|
||||
tests/test/ugeneric7.pp svneol=native#text/plain
|
||||
tests/test/uhintdir.pp svneol=native#text/plain
|
||||
tests/test/uhlp3.pp svneol=native#text/pascal
|
||||
|
||||
@ -115,6 +115,8 @@ interface
|
||||
helperallowed : boolean;
|
||||
typedef : tdef;
|
||||
typedefderef : tderef;
|
||||
typesym : tsym;
|
||||
typesymderef : tderef;
|
||||
constructor create(def:tdef);virtual;
|
||||
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
||||
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
||||
@ -1066,6 +1068,7 @@ implementation
|
||||
begin
|
||||
inherited create(typen);
|
||||
typedef:=def;
|
||||
typesym:=def.typesym;
|
||||
allowed:=false;
|
||||
helperallowed:=false;
|
||||
end;
|
||||
@ -1075,6 +1078,7 @@ implementation
|
||||
begin
|
||||
inherited ppuload(t,ppufile);
|
||||
ppufile.getderef(typedefderef);
|
||||
ppufile.getderef(typesymderef);
|
||||
allowed:=boolean(ppufile.getbyte);
|
||||
helperallowed:=boolean(ppufile.getbyte);
|
||||
end;
|
||||
@ -1084,6 +1088,7 @@ implementation
|
||||
begin
|
||||
inherited ppuwrite(ppufile);
|
||||
ppufile.putderef(typedefderef);
|
||||
ppufile.putderef(typesymderef);
|
||||
ppufile.putbyte(byte(allowed));
|
||||
ppufile.putbyte(byte(helperallowed));
|
||||
end;
|
||||
@ -1093,6 +1098,7 @@ implementation
|
||||
begin
|
||||
inherited buildderefimpl;
|
||||
typedefderef.build(typedef);
|
||||
typesymderef.build(typesym);
|
||||
end;
|
||||
|
||||
|
||||
@ -1100,6 +1106,7 @@ implementation
|
||||
begin
|
||||
inherited derefimpl;
|
||||
typedef:=tdef(typedefderef.resolve);
|
||||
typesym:=tsym(typesymderef.resolve);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -47,10 +47,6 @@ interface
|
||||
procedure property_dec(is_classpropery: boolean);
|
||||
procedure resourcestring_dec;
|
||||
|
||||
{ generics support }
|
||||
function parse_generic_parameters:TFPObjectList;
|
||||
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -70,7 +66,7 @@ implementation
|
||||
ncgutil,
|
||||
{ parser }
|
||||
scanner,
|
||||
pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,
|
||||
pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,pgenutil,
|
||||
{ cpu-information }
|
||||
cpuinfo
|
||||
;
|
||||
@ -336,51 +332,6 @@ implementation
|
||||
consume(_SEMICOLON);
|
||||
end;
|
||||
|
||||
function parse_generic_parameters:TFPObjectList;
|
||||
var
|
||||
generictype : ttypesym;
|
||||
begin
|
||||
result:=TFPObjectList.Create(false);
|
||||
repeat
|
||||
if token=_ID then
|
||||
begin
|
||||
generictype:=ttypesym.create(orgpattern,cundefinedtype);
|
||||
include(generictype.symoptions,sp_generic_para);
|
||||
result.add(generictype);
|
||||
end;
|
||||
consume(_ID);
|
||||
until not try_to_consume(_COMMA) ;
|
||||
end;
|
||||
|
||||
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
|
||||
var
|
||||
i: longint;
|
||||
generictype: ttypesym;
|
||||
st: tsymtable;
|
||||
begin
|
||||
def.genericdef:=genericdef;
|
||||
if not assigned(genericlist) then
|
||||
exit;
|
||||
|
||||
case def.typ of
|
||||
recorddef,objectdef: st:=tabstractrecorddef(def).symtable;
|
||||
arraydef: st:=tarraydef(def).symtable;
|
||||
procvardef,procdef: st:=tabstractprocdef(def).parast;
|
||||
else
|
||||
internalerror(201101020);
|
||||
end;
|
||||
|
||||
for i:=0 to genericlist.count-1 do
|
||||
begin
|
||||
generictype:=ttypesym(genericlist[i]);
|
||||
if generictype.typedef.typ=undefineddef then
|
||||
include(def.defoptions,df_generic)
|
||||
else
|
||||
include(def.defoptions,df_specialization);
|
||||
st.insert(generictype);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure types_dec(in_structure: boolean);
|
||||
|
||||
procedure finalize_objc_class_or_protocol_external_status(od: tobjectdef);
|
||||
@ -394,7 +345,8 @@ implementation
|
||||
end;
|
||||
|
||||
var
|
||||
typename,orgtypename : TIDString;
|
||||
typename,orgtypename,
|
||||
gentypename,genorgtypename : TIDString;
|
||||
newtype : ttypesym;
|
||||
sym : tsym;
|
||||
hdef : tdef;
|
||||
@ -409,6 +361,8 @@ implementation
|
||||
generictokenbuf : tdynamicarray;
|
||||
vmtbuilder : TVMTBuilder;
|
||||
p:tnode;
|
||||
gendef : tstoreddef;
|
||||
s : shortstring;
|
||||
begin
|
||||
old_block_type:=block_type;
|
||||
{ save unit container of forward declarations -
|
||||
@ -442,8 +396,18 @@ implementation
|
||||
consume(_LSHARPBRACKET);
|
||||
generictypelist:=parse_generic_parameters;
|
||||
consume(_RSHARPBRACKET);
|
||||
|
||||
str(generictypelist.Count,s);
|
||||
gentypename:=typename+'$'+s;
|
||||
genorgtypename:=orgtypename+'$'+s;
|
||||
end
|
||||
else
|
||||
begin
|
||||
gentypename:=typename;
|
||||
genorgtypename:=orgtypename;
|
||||
end;
|
||||
|
||||
|
||||
consume(_EQ);
|
||||
|
||||
{ support 'ttype=type word' syntax }
|
||||
@ -465,12 +429,18 @@ implementation
|
||||
{ is the type already defined? -- must be in the current symtable,
|
||||
not in a nested symtable or one higher up the stack -> don't
|
||||
use searchsym & frinds! }
|
||||
sym:=tsym(symtablestack.top.find(typename));
|
||||
sym:=tsym(symtablestack.top.find(gentypename));
|
||||
newtype:=nil;
|
||||
{ found a symbol with this name? }
|
||||
if assigned(sym) then
|
||||
begin
|
||||
if (sym.typ=typesym) then
|
||||
if (sym.typ=typesym) and
|
||||
{ this should not be a symbol that was created by a generic
|
||||
that was declared earlier }
|
||||
not (
|
||||
(ttypesym(sym).typedef.typ=undefineddef) and
|
||||
(sp_generic_dummy in sym.symoptions)
|
||||
) then
|
||||
begin
|
||||
if ((token=_CLASS) or
|
||||
(token=_INTERFACE) or
|
||||
@ -502,12 +472,12 @@ implementation
|
||||
end;
|
||||
consume(token);
|
||||
{ we can ignore the result, the definition is modified }
|
||||
object_dec(objecttype,orgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef),ht_none);
|
||||
object_dec(objecttype,genorgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef),ht_none);
|
||||
newtype:=ttypesym(sym);
|
||||
hdef:=newtype.typedef;
|
||||
end
|
||||
else
|
||||
message1(parser_h_type_redef,orgtypename);
|
||||
message1(parser_h_type_redef,genorgtypename);
|
||||
end;
|
||||
end;
|
||||
{ no old type reused ? Then insert this new type }
|
||||
@ -517,14 +487,73 @@ implementation
|
||||
referencing the type before it's really set it
|
||||
will give an error (PFV) }
|
||||
hdef:=generrordef;
|
||||
gendef:=nil;
|
||||
storetokenpos:=current_tokenpos;
|
||||
newtype:=ttypesym.create(orgtypename,hdef);
|
||||
newtype.visibility:=symtablestack.top.currentvisibility;
|
||||
symtablestack.top.insert(newtype);
|
||||
if isgeneric then
|
||||
begin
|
||||
{ for generics we need to check whether a non-generic type
|
||||
already exists and if not we need to insert a symbol with
|
||||
the non-generic name (available in (org)typename) that is a
|
||||
undefineddef, so that inline specializations can be used }
|
||||
sym:=tsym(symtablestack.top.Find(typename));
|
||||
if not assigned(sym) then
|
||||
begin
|
||||
sym:=ttypesym.create(orgtypename,tundefineddef.create);
|
||||
Include(sym.symoptions,sp_generic_dummy);
|
||||
ttypesym(sym).typedef.typesym:=sym;
|
||||
sym.visibility:=symtablestack.top.currentvisibility;
|
||||
symtablestack.top.insert(sym);
|
||||
ttypesym(sym).typedef.owner:=sym.owner;
|
||||
end
|
||||
else
|
||||
{ this is not allowed in non-Delphi modes }
|
||||
if not (m_delphi in current_settings.modeswitches) then
|
||||
Message1(sym_e_duplicate_id,genorgtypename)
|
||||
else
|
||||
{ we need to find this symbol even if it's a variable or
|
||||
something else when doing an inline specialization }
|
||||
Include(sym.symoptions,sp_generic_dummy);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if assigned(sym) and (sym.typ=typesym) and
|
||||
(ttypesym(sym).typedef.typ=undefineddef) and
|
||||
(sp_generic_dummy in sym.symoptions) then
|
||||
begin
|
||||
{ this is a symbol that was added by an earlier generic
|
||||
declaration, reuse it }
|
||||
newtype:=ttypesym(sym);
|
||||
newtype.typedef:=hdef;
|
||||
sym:=nil;
|
||||
end;
|
||||
|
||||
{ check whether this is a declaration of a type inside a
|
||||
specialization }
|
||||
if assigned(current_structdef) and
|
||||
(df_specialization in current_structdef.defoptions) then
|
||||
begin
|
||||
if not assigned(current_structdef.genericdef) or
|
||||
not (current_structdef.genericdef.typ in [recorddef,objectdef]) then
|
||||
internalerror(2011052301);
|
||||
sym:=tsym(tabstractrecorddef(current_structdef.genericdef).symtable.Find(gentypename));
|
||||
if not assigned(sym) or not (sym.typ=typesym) then
|
||||
internalerror(2011052302);
|
||||
{ use the corresponding type in the generic's symtable as
|
||||
genericdef for the specialized type }
|
||||
gendef:=tstoreddef(ttypesym(sym).typedef);
|
||||
end;
|
||||
end;
|
||||
{ insert a new type if we don't reuse an existing symbol }
|
||||
if not assigned(newtype) then
|
||||
begin
|
||||
newtype:=ttypesym.create(genorgtypename,hdef);
|
||||
newtype.visibility:=symtablestack.top.currentvisibility;
|
||||
symtablestack.top.insert(newtype);
|
||||
end;
|
||||
current_tokenpos:=defpos;
|
||||
current_tokenpos:=storetokenpos;
|
||||
{ read the type definition }
|
||||
read_named_type(hdef,orgtypename,nil,generictypelist,false);
|
||||
read_named_type(hdef,genorgtypename,gendef,generictypelist,false);
|
||||
{ update the definition of the type }
|
||||
if assigned(hdef) then
|
||||
begin
|
||||
@ -565,8 +594,8 @@ implementation
|
||||
begin
|
||||
stringdispose(objname);
|
||||
stringdispose(objrealname);
|
||||
objrealname:=stringdup(orgtypename);
|
||||
objname:=stringdup(upper(orgtypename));
|
||||
objrealname:=stringdup(genorgtypename);
|
||||
objname:=stringdup(upper(genorgtypename));
|
||||
end;
|
||||
|
||||
include(hdef.defoptions,df_unique);
|
||||
@ -577,10 +606,19 @@ implementation
|
||||
if not assigned(hdef.typesym) then
|
||||
hdef.typesym:=newtype;
|
||||
end;
|
||||
{ in non-Delphi modes we need a reference to the generic def
|
||||
without the generic suffix, so it can be found easily when
|
||||
parsing method implementations }
|
||||
if isgeneric and assigned(sym) and
|
||||
not (m_delphi in current_settings.modeswitches) and
|
||||
(ttypesym(sym).typedef.typ=undefineddef) then
|
||||
{ don't free the undefineddef as the defids rely on the count
|
||||
of the defs in the def list of the module}
|
||||
ttypesym(sym).typedef:=hdef;
|
||||
newtype.typedef:=hdef;
|
||||
{ KAZ: handle TGUID declaration in system unit }
|
||||
if (cs_compilesystem in current_settings.moduleswitches) and not assigned(rec_tguid) and
|
||||
(typename='TGUID') and { name: TGUID and size=16 bytes that is 128 bits }
|
||||
(gentypename='TGUID') and { name: TGUID and size=16 bytes that is 128 bits }
|
||||
assigned(hdef) and (hdef.typ=recorddef) and (hdef.size=16) then
|
||||
rec_tguid:=trecorddef(hdef);
|
||||
end;
|
||||
|
||||
@ -46,7 +46,7 @@ implementation
|
||||
symbase,symsym,symtable,
|
||||
node,nld,nmem,ncon,ncnv,ncal,
|
||||
fmodule,scanner,
|
||||
pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,ppu
|
||||
pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,pgenutil,ppu
|
||||
;
|
||||
|
||||
const
|
||||
@ -1148,6 +1148,11 @@ implementation
|
||||
else if assigned(genericlist) then
|
||||
current_genericdef:=current_structdef;
|
||||
|
||||
{ nested types of specializations are specializations as well }
|
||||
if assigned(old_current_structdef) and
|
||||
(df_specialization in old_current_structdef.defoptions) then
|
||||
include(current_structdef.defoptions,df_specialization);
|
||||
|
||||
{ set published flag in $M+ mode, it can also be inherited and will
|
||||
be added when the parent class set with tobjectdef.set_parent (PFV) }
|
||||
if (cs_generate_rtti in current_settings.localswitches) and
|
||||
@ -1188,6 +1193,10 @@ implementation
|
||||
|
||||
symtablestack.push(current_structdef.symtable);
|
||||
insert_generic_parameter_types(current_structdef,genericdef,genericlist);
|
||||
{ when we are parsing a generic already then this is a generic as
|
||||
well }
|
||||
if old_parse_generic then
|
||||
include(current_structdef.defoptions, df_generic);
|
||||
parse_generic:=(df_generic in current_structdef.defoptions);
|
||||
|
||||
{ parse list of parent classes }
|
||||
|
||||
@ -910,75 +910,61 @@ implementation
|
||||
|
||||
function consume_generic_type_parameter:boolean;
|
||||
var
|
||||
i:integer;
|
||||
ok:boolean;
|
||||
sym:tsym;
|
||||
idx : integer;
|
||||
genparalistdecl : TFPHashList;
|
||||
genname : tidstring;
|
||||
s : shortstring;
|
||||
begin
|
||||
result:=not assigned(astruct)and(m_delphi in current_settings.modeswitches);
|
||||
if result then
|
||||
begin
|
||||
{ a generic type parameter? }
|
||||
srsym:=search_object_name(sp,false);
|
||||
if (srsym.typ=typesym) and
|
||||
(ttypesym(srsym).typedef.typ in [objectdef,recorddef]) then
|
||||
begin
|
||||
astruct:=tabstractrecorddef(ttypesym(srsym).typedef);
|
||||
if (df_generic in astruct.defoptions) and try_to_consume(_LT) then
|
||||
begin
|
||||
ok:=true;
|
||||
i:=0;
|
||||
repeat
|
||||
if ok and (token=_ID) then
|
||||
begin
|
||||
ok:=false;
|
||||
while i<astruct.symtable.SymList.Count-1 do
|
||||
begin
|
||||
sym:=tsym(astruct.symtable.SymList[i]);
|
||||
if sp_generic_para in sym.symoptions then
|
||||
begin
|
||||
ok:=sym.Name=pattern;
|
||||
inc(i);
|
||||
break;
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
if not ok then
|
||||
Message1(type_e_generic_declaration_does_not_match,astruct.RttiName);
|
||||
end;
|
||||
consume(_ID);
|
||||
until not try_to_consume(_COMMA);
|
||||
if ok then
|
||||
while i<astruct.symtable.SymList.Count-1 do
|
||||
begin
|
||||
sym:=tsym(astruct.symtable.SymList[i]);
|
||||
if sp_generic_para in sym.symoptions then
|
||||
begin
|
||||
Message1(type_e_generic_declaration_does_not_match,astruct.RttiName);
|
||||
break;
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
consume(_GT);
|
||||
end
|
||||
else
|
||||
if (df_generic in astruct.defoptions) and (token=_POINT) then
|
||||
begin
|
||||
Message1(type_e_generic_declaration_does_not_match,astruct.RttiName);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ not a method. routine name just accidentally match some structure name }
|
||||
astruct:=nil;
|
||||
if try_to_consume(_LT) then
|
||||
{ parse all parameters first so we can check whether we have
|
||||
the correct generic def available }
|
||||
genparalistdecl:=TFPHashList.Create;
|
||||
if try_to_consume(_LT) then
|
||||
begin
|
||||
{ start with 1, so Find can return Nil (= 0) }
|
||||
idx:=1;
|
||||
repeat
|
||||
if token=_ID then
|
||||
begin
|
||||
Message(type_e_type_parameters_are_not_allowed_here);
|
||||
repeat
|
||||
consume(_ID);
|
||||
until not try_to_consume(_COMMA);
|
||||
consume(_GT);
|
||||
genparalistdecl.Add(pattern, Pointer(PtrInt(idx)));
|
||||
consume(_ID);
|
||||
inc(idx);
|
||||
end
|
||||
else
|
||||
begin
|
||||
message2(scan_f_syn_expected,arraytokeninfo[_ID].str,arraytokeninfo[token].str);
|
||||
if token<>_COMMA then
|
||||
consume(token);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until not try_to_consume(_COMMA);
|
||||
if not try_to_consume(_GT) then
|
||||
consume(_RSHARPBRACKET);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ no generic }
|
||||
srsym:=nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
s:='';
|
||||
str(genparalistdecl.count,s);
|
||||
genname:=sp+'$'+s;
|
||||
|
||||
genparalistdecl.free;
|
||||
|
||||
srsym:=search_object_name(genname,false);
|
||||
|
||||
if not assigned(srsym) then
|
||||
begin
|
||||
{ TODO : print a nicer typename that contains the parsed
|
||||
generic types }
|
||||
Message1(type_e_generic_declaration_does_not_match,genname);
|
||||
srsym:=nil;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1024,13 +1010,14 @@ implementation
|
||||
end;
|
||||
|
||||
{ method ? }
|
||||
srsym:=nil;
|
||||
if (consume_generic_type_parameter or not assigned(astruct)) and
|
||||
(symtablestack.top.symtablelevel=main_program_level) and
|
||||
try_to_consume(_POINT) then
|
||||
begin
|
||||
repeat
|
||||
searchagain:=false;
|
||||
if not assigned(astruct) then
|
||||
if not assigned(astruct) and not assigned(srsym) then
|
||||
srsym:=search_object_name(sp,true);
|
||||
{ consume proc name }
|
||||
procstartfilepos:=current_tokenpos;
|
||||
|
||||
@ -461,7 +461,7 @@ implementation
|
||||
if (token=_COLON) or (paranr>0) or (astruct=nil) then
|
||||
begin
|
||||
consume(_COLON);
|
||||
single_type(p.propdef,[]);
|
||||
single_type(p.propdef,[stoAllowSpecialization]);
|
||||
|
||||
if is_dispinterface(astruct) and not is_automatable(p.propdef) then
|
||||
Message1(type_e_not_automatable,p.propdef.typename);
|
||||
|
||||
1781
compiler/pexpr.pas
1781
compiler/pexpr.pas
File diff suppressed because it is too large
Load Diff
540
compiler/pgenutil.pas
Normal file
540
compiler/pgenutil.pas
Normal file
@ -0,0 +1,540 @@
|
||||
{
|
||||
Copyright (c) 2011
|
||||
|
||||
Contains different functions that are used in the context of
|
||||
parsing generics.
|
||||
|
||||
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; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
****************************************************************************
|
||||
}
|
||||
unit pgenutil;
|
||||
|
||||
{$i fpcdefs.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{ common }
|
||||
cclasses,
|
||||
{ symtable }
|
||||
symtype,symdef;
|
||||
|
||||
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string);
|
||||
function parse_generic_parameters:TFPObjectList;
|
||||
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{ common }
|
||||
cutils,
|
||||
{ global }
|
||||
globals,globtype,tokens,verbose,
|
||||
{ symtable }
|
||||
symconst,symbase,symsym,symtable,
|
||||
{ modules }
|
||||
fmodule,
|
||||
{ pass 1 }
|
||||
htypechk,
|
||||
node,nobj,nmem,
|
||||
{ parser }
|
||||
scanner,
|
||||
pbase,pexpr,pdecsub,ptype;
|
||||
|
||||
|
||||
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string);
|
||||
var
|
||||
st : TSymtable;
|
||||
srsym : tsym;
|
||||
pt2 : tnode;
|
||||
found,
|
||||
first,
|
||||
err : boolean;
|
||||
i,
|
||||
gencount : longint;
|
||||
genericdef : tstoreddef;
|
||||
generictype : ttypesym;
|
||||
genericdeflist : TFPObjectList;
|
||||
generictypelist : TFPObjectList;
|
||||
oldsymtablestack : tsymtablestack;
|
||||
oldextendeddefs : TFPHashObjectList;
|
||||
hmodule : tmodule;
|
||||
pu : tused_unit;
|
||||
prettyname : ansistring;
|
||||
uspecializename,
|
||||
countstr,genname,ugenname,specializename : string;
|
||||
vmtbuilder : TVMTBuilder;
|
||||
specializest : tsymtable;
|
||||
item : tobject;
|
||||
old_current_structdef : tabstractrecorddef;
|
||||
old_current_genericdef,old_current_specializedef : tstoreddef;
|
||||
tempst : tglobalsymtable;
|
||||
old_block_type: tblock_type;
|
||||
begin
|
||||
{ retrieve generic def that we are going to replace }
|
||||
genericdef:=tstoreddef(tt);
|
||||
tt:=nil;
|
||||
|
||||
{ either symname must be given or genericdef needs to be valid }
|
||||
if (symname='') and
|
||||
(not assigned(genericdef) or
|
||||
not assigned(genericdef.typesym) or
|
||||
(genericdef.typesym.typ<>typesym)) then
|
||||
internalerror(2011042701);
|
||||
|
||||
{ Only parse the parameters for recovery or
|
||||
for recording in genericbuf }
|
||||
if parse_generic then
|
||||
begin
|
||||
if not try_to_consume(_LT) then
|
||||
consume(_LSHARPBRACKET);
|
||||
gencount:=0;
|
||||
repeat
|
||||
pt2:=factor(false,true);
|
||||
pt2.free;
|
||||
inc(gencount);
|
||||
until not try_to_consume(_COMMA);
|
||||
if not try_to_consume(_GT) then
|
||||
consume(_RSHARPBRACKET);
|
||||
{ we need to return a def that can later pass some checks like
|
||||
whether it's an interface or not }
|
||||
if parse_generic and (not assigned(tt) or (tt.typ=undefineddef)) then
|
||||
begin
|
||||
if (symname='') and (df_generic in genericdef.defoptions) then
|
||||
{ this happens in non-Delphi modes }
|
||||
tt:=genericdef
|
||||
else
|
||||
begin
|
||||
{ find the corresponding generic symbol so that any checks
|
||||
done on the returned def will be handled correctly }
|
||||
str(gencount,countstr);
|
||||
if symname='' then
|
||||
genname:=ttypesym(genericdef.typesym).realname
|
||||
else
|
||||
genname:=symname;
|
||||
genname:=genname+'$'+countstr;
|
||||
ugenname:=upper(genname);
|
||||
if not searchsym(ugenname,srsym,st) or
|
||||
(srsym.typ<>typesym) then
|
||||
begin
|
||||
identifier_not_found(genname);
|
||||
exit;
|
||||
end;
|
||||
tt:=ttypesym(srsym).typedef;
|
||||
{ this happens in non-Delphi modes if we encounter a
|
||||
specialization of the generic class or record we're
|
||||
currently parsing }
|
||||
if (tt.typ=errordef) and assigned(current_structdef) and
|
||||
(current_structdef.objname^=ugenname) then
|
||||
tt:=current_structdef;
|
||||
end;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if not assigned(parsedtype) and not try_to_consume(_LT) then
|
||||
consume(_LSHARPBRACKET);
|
||||
|
||||
generictypelist:=TFPObjectList.create(false);
|
||||
genericdeflist:=TFPObjectList.Create(false);
|
||||
|
||||
{ Parse type parameters }
|
||||
err:=false;
|
||||
{ set the block type to type, so that the parsed type are returned as
|
||||
ttypenode (e.g. classes are in non type-compatible blocks returned as
|
||||
tloadvmtaddrnode) }
|
||||
old_block_type:=block_type;
|
||||
{ if parsedtype is set, then the first type identifer was already parsed
|
||||
(happens in inline specializations) and thus we only need to parse
|
||||
the remaining types and do as if the first one was already given }
|
||||
first:=not assigned(parsedtype);
|
||||
if assigned(parsedtype) then
|
||||
begin
|
||||
genericdeflist.Add(parsedtype);
|
||||
specializename:='$'+parsedtype.typesym.realname;
|
||||
prettyname:=parsedtype.typesym.prettyname;
|
||||
end
|
||||
else
|
||||
begin
|
||||
specializename:='';
|
||||
prettyname:='';
|
||||
end;
|
||||
while not (token in [_GT,_RSHARPBRACKET]) do
|
||||
begin
|
||||
{ "first" is set to false at the end of the loop! }
|
||||
if not first then
|
||||
consume(_COMMA);
|
||||
block_type:=bt_type;
|
||||
pt2:=factor(false,true);
|
||||
if pt2.nodetype=typen then
|
||||
begin
|
||||
if df_generic in pt2.resultdef.defoptions then
|
||||
Message(parser_e_no_generics_as_params);
|
||||
genericdeflist.Add(pt2.resultdef);
|
||||
if not assigned(pt2.resultdef.typesym) then
|
||||
message(type_e_generics_cannot_reference_itself)
|
||||
else
|
||||
begin
|
||||
specializename:=specializename+'$'+pt2.resultdef.typesym.realname;
|
||||
if first then
|
||||
prettyname:=prettyname+pt2.resultdef.typesym.prettyname
|
||||
else
|
||||
prettyname:=prettyname+','+pt2.resultdef.typesym.prettyname;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Message(type_e_type_id_expected);
|
||||
err:=true;
|
||||
end;
|
||||
pt2.free;
|
||||
first:=false;
|
||||
end;
|
||||
block_type:=old_block_type;
|
||||
|
||||
if err then
|
||||
begin
|
||||
try_to_consume(_RSHARPBRACKET);
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ search a generic with the given count of params }
|
||||
countstr:='';
|
||||
str(genericdeflist.Count,countstr);
|
||||
{ use the name of the symbol as procvars return a user friendly version
|
||||
of the name }
|
||||
if symname='' then
|
||||
genname:=ttypesym(genericdef.typesym).realname
|
||||
else
|
||||
genname:=symname;
|
||||
{ in case of non-Delphi mode the type name could already be a generic
|
||||
def (but maybe the wrong one) }
|
||||
if assigned(genericdef) and (df_generic in genericdef.defoptions) then
|
||||
begin
|
||||
{ remove the type count suffix from the generic's name }
|
||||
for i:=Length(genname) downto 1 do
|
||||
if genname[i]='$' then
|
||||
begin
|
||||
genname:=copy(genname,1,i-1);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
genname:=genname+'$'+countstr;
|
||||
ugenname:=upper(genname);
|
||||
|
||||
if assigned(genericdef) and (genericdef.owner.symtabletype in [objectsymtable,recordsymtable]) then
|
||||
begin
|
||||
if genericdef.owner.symtabletype = objectsymtable then
|
||||
found:=searchsym_in_class(tobjectdef(genericdef.owner.defowner),tobjectdef(genericdef.owner.defowner),ugenname,srsym,st,false)
|
||||
else
|
||||
found:=searchsym_in_record(tabstractrecorddef(genericdef.owner.defowner),ugenname,srsym,st);
|
||||
end
|
||||
else
|
||||
found:=searchsym(ugenname,srsym,st);
|
||||
|
||||
if not found or (srsym.typ<>typesym) then
|
||||
begin
|
||||
identifier_not_found(genname);
|
||||
genericdeflist.Free;
|
||||
generictypelist.Free;
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ we've found the correct def }
|
||||
genericdef:=tstoreddef(ttypesym(srsym).typedef);
|
||||
|
||||
{ build the new type's name }
|
||||
specializename:=genname+specializename;
|
||||
uspecializename:=upper(specializename);
|
||||
prettyname:=genericdef.typesym.prettyname+'<'+prettyname+'>';
|
||||
|
||||
{ select the symtable containing the params }
|
||||
case genericdef.typ of
|
||||
procdef:
|
||||
st:=genericdef.GetSymtable(gs_para);
|
||||
objectdef,
|
||||
recorddef:
|
||||
st:=genericdef.GetSymtable(gs_record);
|
||||
arraydef:
|
||||
st:=tarraydef(genericdef).symtable;
|
||||
procvardef:
|
||||
st:=genericdef.GetSymtable(gs_para);
|
||||
else
|
||||
internalerror(200511182);
|
||||
end;
|
||||
|
||||
{ build the list containing the types for the generic params }
|
||||
gencount:=0;
|
||||
for i:=0 to st.SymList.Count-1 do
|
||||
begin
|
||||
srsym:=tsym(st.SymList[i]);
|
||||
if sp_generic_para in srsym.symoptions then
|
||||
begin
|
||||
if gencount=genericdeflist.Count then
|
||||
internalerror(2011042702);
|
||||
generictype:=ttypesym.create(srsym.realname,tdef(genericdeflist[gencount]));
|
||||
generictypelist.add(generictype);
|
||||
inc(gencount);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ Special case if we are referencing the current defined object }
|
||||
if assigned(current_structdef) and
|
||||
(current_structdef.objname^=uspecializename) then
|
||||
tt:=current_structdef;
|
||||
|
||||
{ decide in which symtable to put the specialization }
|
||||
if current_module.is_unit and current_module.in_interface then
|
||||
specializest:=current_module.globalsymtable
|
||||
else
|
||||
specializest:=current_module.localsymtable;
|
||||
|
||||
{ Can we reuse an already specialized type? }
|
||||
if not assigned(tt) then
|
||||
begin
|
||||
srsym:=tsym(specializest.find(uspecializename));
|
||||
if assigned(srsym) then
|
||||
begin
|
||||
if srsym.typ<>typesym then
|
||||
internalerror(200710171);
|
||||
tt:=ttypesym(srsym).typedef;
|
||||
end;
|
||||
end;
|
||||
|
||||
if not assigned(tt) then
|
||||
begin
|
||||
{ Setup symtablestack at definition time
|
||||
to get types right, however this is not perfect, we should probably record
|
||||
the resolved symbols }
|
||||
oldsymtablestack:=symtablestack;
|
||||
oldextendeddefs:=current_module.extendeddefs;
|
||||
current_module.extendeddefs:=TFPHashObjectList.create(true);
|
||||
symtablestack:=tdefawaresymtablestack.create;
|
||||
if not assigned(genericdef) then
|
||||
internalerror(200705151);
|
||||
hmodule:=find_module_from_symtable(genericdef.owner);
|
||||
if hmodule=nil then
|
||||
internalerror(200705152);
|
||||
pu:=tused_unit(hmodule.used_units.first);
|
||||
while assigned(pu) do
|
||||
begin
|
||||
if not assigned(pu.u.globalsymtable) then
|
||||
internalerror(200705153);
|
||||
symtablestack.push(pu.u.globalsymtable);
|
||||
pu:=tused_unit(pu.next);
|
||||
end;
|
||||
|
||||
if assigned(hmodule.globalsymtable) then
|
||||
symtablestack.push(hmodule.globalsymtable);
|
||||
|
||||
{ push the localsymtable if needed }
|
||||
if (hmodule<>current_module) or not current_module.in_interface then
|
||||
symtablestack.push(current_module.localsymtable);
|
||||
|
||||
{ push a temporary global symtable so that the specialization is
|
||||
added to the correct symtable; this symtable does not contain
|
||||
any other symbols, so that the type resolution can not be
|
||||
influenced by symbols in the current unit }
|
||||
tempst:=tspecializesymtable.create(current_module.modulename^,current_module.moduleid);
|
||||
symtablestack.push(tempst);
|
||||
|
||||
{ Reparse the original type definition }
|
||||
if not err then
|
||||
begin
|
||||
if parse_class_parent then
|
||||
begin
|
||||
old_current_structdef:=current_structdef;
|
||||
old_current_genericdef:=current_genericdef;
|
||||
old_current_specializedef:=current_specializedef;
|
||||
|
||||
if genericdef.owner.symtabletype in [recordsymtable,objectsymtable] then
|
||||
current_structdef:=tabstractrecorddef(genericdef.owner.defowner)
|
||||
else
|
||||
current_structdef:=nil;
|
||||
current_genericdef:=nil;
|
||||
current_specializedef:=nil;
|
||||
end;
|
||||
|
||||
{ First a new typesym so we can reuse this specialization and
|
||||
references to this specialization can be handled }
|
||||
srsym:=ttypesym.create(specializename,generrordef);
|
||||
specializest.insert(srsym);
|
||||
|
||||
{ specializations are declarations as such it is the wisest to
|
||||
declare set the blocktype to "type"; otherwise we'll
|
||||
experience unexpected side effects like the addition of
|
||||
classrefdefs if we have a generic that's derived from another
|
||||
generic }
|
||||
old_block_type:=block_type;
|
||||
block_type:=bt_type;
|
||||
|
||||
if not assigned(genericdef.generictokenbuf) then
|
||||
internalerror(200511171);
|
||||
current_scanner.startreplaytokens(genericdef.generictokenbuf,
|
||||
genericdef.change_endian);
|
||||
read_named_type(tt,specializename,genericdef,generictypelist,false);
|
||||
ttypesym(srsym).typedef:=tt;
|
||||
tt.typesym:=srsym;
|
||||
|
||||
if _prettyname<>'' then
|
||||
ttypesym(tt.typesym).fprettyname:=_prettyname
|
||||
else
|
||||
ttypesym(tt.typesym).fprettyname:=prettyname;
|
||||
|
||||
{ Note regarding hint directives:
|
||||
There is no need to remove the flags for them from the
|
||||
specialized generic symbol, because hint directives that
|
||||
follow the specialization are handled by the code in
|
||||
pdecl.types_dec and added to the type symbol.
|
||||
E.g.: TFoo = TBar<Blubb> deprecated;
|
||||
Here the symbol TBar$1$Blubb will contain the
|
||||
"sp_hint_deprecated" flag while the TFoo symbol won't.}
|
||||
|
||||
case tt.typ of
|
||||
{ Build VMT indexes for classes and read hint directives }
|
||||
objectdef:
|
||||
begin
|
||||
try_consume_hintdirective(srsym.symoptions,srsym.deprecatedmsg);
|
||||
consume(_SEMICOLON);
|
||||
|
||||
vmtbuilder:=TVMTBuilder.Create(tobjectdef(tt));
|
||||
vmtbuilder.generate_vmt;
|
||||
vmtbuilder.free;
|
||||
end;
|
||||
{ handle params, calling convention, etc }
|
||||
procvardef:
|
||||
begin
|
||||
if not check_proc_directive(true) then
|
||||
begin
|
||||
try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
|
||||
consume(_SEMICOLON);
|
||||
end;
|
||||
parse_var_proc_directives(ttypesym(srsym));
|
||||
handle_calling_convention(tprocvardef(tt));
|
||||
if try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg) then
|
||||
consume(_SEMICOLON);
|
||||
end;
|
||||
else
|
||||
{ parse hint directives for records and arrays }
|
||||
begin
|
||||
try_consume_hintdirective(srsym.symoptions,srsym.deprecatedmsg);
|
||||
consume(_SEMICOLON);
|
||||
end;
|
||||
end;
|
||||
{ Consume the semicolon if it is also recorded }
|
||||
try_to_consume(_SEMICOLON);
|
||||
|
||||
block_type:=old_block_type;
|
||||
if parse_class_parent then
|
||||
begin
|
||||
current_structdef:=old_current_structdef;
|
||||
current_genericdef:=old_current_genericdef;
|
||||
current_specializedef:=old_current_specializedef;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ extract all created symbols and defs from the temporary symtable
|
||||
and add them to the specializest }
|
||||
for i:=0 to tempst.SymList.Count-1 do begin
|
||||
item:=tempst.SymList.Items[i];
|
||||
specializest.SymList.Add(tempst.SymList.NameOfIndex(i),item);
|
||||
tsym(item).Owner:=specializest;
|
||||
tempst.SymList.Extract(item);
|
||||
end;
|
||||
|
||||
for i:=0 to tempst.DefList.Count-1 do begin
|
||||
item:=tempst.DefList.Items[i];
|
||||
specializest.DefList.Add(item);
|
||||
tdef(item).owner:=specializest;
|
||||
tempst.DefList.Extract(item);
|
||||
end;
|
||||
|
||||
tempst.free;
|
||||
|
||||
{ Restore symtablestack }
|
||||
current_module.extendeddefs.free;
|
||||
current_module.extendeddefs:=oldextendeddefs;
|
||||
symtablestack.free;
|
||||
symtablestack:=oldsymtablestack;
|
||||
end;
|
||||
|
||||
if not (token in [_GT, _RSHARPBRACKET]) then
|
||||
begin
|
||||
consume(_RSHARPBRACKET);
|
||||
exit;
|
||||
end
|
||||
else
|
||||
consume(token);
|
||||
|
||||
genericdeflist.free;
|
||||
generictypelist.free;
|
||||
if assigned(genericdef) then
|
||||
begin
|
||||
{ check the hints of the found generic symbol }
|
||||
srsym:=genericdef.typesym;
|
||||
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function parse_generic_parameters:TFPObjectList;
|
||||
var
|
||||
generictype : ttypesym;
|
||||
begin
|
||||
result:=TFPObjectList.Create(false);
|
||||
repeat
|
||||
if token=_ID then
|
||||
begin
|
||||
generictype:=ttypesym.create(orgpattern,cundefinedtype);
|
||||
include(generictype.symoptions,sp_generic_para);
|
||||
result.add(generictype);
|
||||
end;
|
||||
consume(_ID);
|
||||
until not try_to_consume(_COMMA) ;
|
||||
end;
|
||||
|
||||
|
||||
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
|
||||
var
|
||||
i: longint;
|
||||
generictype: ttypesym;
|
||||
st: tsymtable;
|
||||
begin
|
||||
def.genericdef:=genericdef;
|
||||
if not assigned(genericlist) then
|
||||
exit;
|
||||
|
||||
case def.typ of
|
||||
recorddef,objectdef: st:=tabstractrecorddef(def).symtable;
|
||||
arraydef: st:=tarraydef(def).symtable;
|
||||
procvardef,procdef: st:=tabstractprocdef(def).parast;
|
||||
else
|
||||
internalerror(201101020);
|
||||
end;
|
||||
|
||||
for i:=0 to genericlist.count-1 do
|
||||
begin
|
||||
generictype:=ttypesym(genericlist[i]);
|
||||
if generictype.typedef.typ=undefineddef then
|
||||
include(def.defoptions,df_generic)
|
||||
else
|
||||
include(def.defoptions,df_specialization);
|
||||
st.insert(generictype);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -43,7 +43,7 @@ type
|
||||
{$endif Test_Double_checksum}
|
||||
|
||||
const
|
||||
CurrentPPUVersion = 140;
|
||||
CurrentPPUVersion = 141;
|
||||
|
||||
{ buffer sizes }
|
||||
maxentrysize = 1024;
|
||||
|
||||
@ -1352,17 +1352,22 @@ implementation
|
||||
old_current_structdef: tabstractrecorddef;
|
||||
old_current_genericdef,
|
||||
old_current_specializedef: tstoreddef;
|
||||
old_parse_generic: boolean;
|
||||
begin
|
||||
old_current_procinfo:=current_procinfo;
|
||||
old_block_type:=block_type;
|
||||
old_current_structdef:=current_structdef;
|
||||
old_current_genericdef:=current_genericdef;
|
||||
old_current_specializedef:=current_specializedef;
|
||||
old_parse_generic:=parse_generic;
|
||||
|
||||
current_procinfo:=self;
|
||||
current_structdef:=procdef.struct;
|
||||
if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
|
||||
current_genericdef:=current_structdef;
|
||||
begin
|
||||
current_genericdef:=current_structdef;
|
||||
parse_generic:=true;
|
||||
end;
|
||||
if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
|
||||
current_specializedef:=current_structdef;
|
||||
|
||||
@ -1474,6 +1479,7 @@ implementation
|
||||
current_genericdef:=old_current_genericdef;
|
||||
current_specializedef:=old_current_specializedef;
|
||||
current_procinfo:=old_current_procinfo;
|
||||
parse_generic:=old_parse_generic;
|
||||
|
||||
{ Restore old state }
|
||||
block_type:=old_block_type;
|
||||
@ -1949,14 +1955,50 @@ implementation
|
||||
|
||||
procedure specialize_objectdefs(p:TObject;arg:pointer);
|
||||
var
|
||||
i : longint;
|
||||
hp : tdef;
|
||||
oldcurrent_filepos : tfileposinfo;
|
||||
oldsymtablestack : tsymtablestack;
|
||||
oldextendeddefs : TFPHashObjectList;
|
||||
pu : tused_unit;
|
||||
hmodule : tmodule;
|
||||
specobj : tabstractrecorddef;
|
||||
|
||||
procedure process_abstractrecorddef(def:tabstractrecorddef);
|
||||
var
|
||||
i : longint;
|
||||
hp : tdef;
|
||||
begin
|
||||
for i:=0 to def.symtable.DefList.Count-1 do
|
||||
begin
|
||||
hp:=tdef(def.symtable.DefList[i]);
|
||||
if hp.typ=procdef then
|
||||
begin
|
||||
{ only generate the code if we need a body }
|
||||
if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then
|
||||
continue;
|
||||
if assigned(tprocdef(hp).genericdef) and
|
||||
(tprocdef(hp).genericdef.typ=procdef) and
|
||||
assigned(tprocdef(tprocdef(hp).genericdef).generictokenbuf) then
|
||||
begin
|
||||
oldcurrent_filepos:=current_filepos;
|
||||
current_filepos:=tprocdef(tprocdef(hp).genericdef).fileinfo;
|
||||
{ use the index the module got from the current compilation process }
|
||||
current_filepos.moduleindex:=hmodule.unit_index;
|
||||
current_tokenpos:=current_filepos;
|
||||
current_scanner.startreplaytokens(tprocdef(tprocdef(hp).genericdef).generictokenbuf,
|
||||
tprocdef(tprocdef(hp).genericdef).change_endian);
|
||||
read_proc_body(nil,tprocdef(hp));
|
||||
current_filepos:=oldcurrent_filepos;
|
||||
end
|
||||
else
|
||||
MessagePos1(tprocdef(hp).fileinfo,sym_e_forward_not_resolved,tprocdef(hp).fullprocname(false));
|
||||
end
|
||||
else
|
||||
if hp.typ in [objectdef,recorddef] then
|
||||
{ generate code for subtypes as well }
|
||||
process_abstractrecorddef(tabstractrecorddef(hp));
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if not((tsym(p).typ=typesym) and
|
||||
(ttypesym(p).typedef.typesym=tsym(p)) and
|
||||
@ -1994,29 +2036,7 @@ implementation
|
||||
symtablestack.push(hmodule.localsymtable);
|
||||
|
||||
{ procedure definitions for classes or objects }
|
||||
for i:=0 to specobj.symtable.DefList.Count-1 do
|
||||
begin
|
||||
hp:=tdef(specobj.symtable.DefList[i]);
|
||||
if hp.typ=procdef then
|
||||
begin
|
||||
if assigned(tprocdef(hp).genericdef) and
|
||||
(tprocdef(hp).genericdef.typ=procdef) and
|
||||
assigned(tprocdef(tprocdef(hp).genericdef).generictokenbuf) then
|
||||
begin
|
||||
oldcurrent_filepos:=current_filepos;
|
||||
current_filepos:=tprocdef(tprocdef(hp).genericdef).fileinfo;
|
||||
{ use the index the module got from the current compilation process }
|
||||
current_filepos.moduleindex:=hmodule.unit_index;
|
||||
current_tokenpos:=current_filepos;
|
||||
current_scanner.startreplaytokens(tprocdef(tprocdef(hp).genericdef).generictokenbuf,
|
||||
tprocdef(tprocdef(hp).genericdef).change_endian);
|
||||
read_proc_body(nil,tprocdef(hp));
|
||||
current_filepos:=oldcurrent_filepos;
|
||||
end
|
||||
else
|
||||
MessagePos1(tprocdef(hp).fileinfo,sym_e_forward_not_resolved,tprocdef(hp).fullprocname(false));
|
||||
end;
|
||||
end;
|
||||
process_abstractrecorddef(specobj);
|
||||
|
||||
{ Restore symtablestack }
|
||||
current_module.extendeddefs.free;
|
||||
|
||||
@ -52,8 +52,6 @@ interface
|
||||
{ generate persistent type information like VMT, RTTI and inittables }
|
||||
procedure write_persistent_type_info(st:tsymtable);
|
||||
|
||||
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname : string);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -74,7 +72,7 @@ implementation
|
||||
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
|
||||
{ parser }
|
||||
scanner,
|
||||
pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl;
|
||||
pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil;
|
||||
|
||||
|
||||
procedure resolve_forward_types;
|
||||
@ -143,271 +141,8 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname : string);
|
||||
var
|
||||
st : TSymtable;
|
||||
srsym : tsym;
|
||||
pt2 : tnode;
|
||||
first,
|
||||
err : boolean;
|
||||
i : longint;
|
||||
sym : tsym;
|
||||
genericdef : tstoreddef;
|
||||
generictype : ttypesym;
|
||||
generictypelist : TFPObjectList;
|
||||
oldsymtablestack : tsymtablestack;
|
||||
oldextendeddefs : TFPHashObjectList;
|
||||
hmodule : tmodule;
|
||||
pu : tused_unit;
|
||||
prettyname : ansistring;
|
||||
uspecializename,
|
||||
specializename : string;
|
||||
vmtbuilder : TVMTBuilder;
|
||||
onlyparsepara : boolean;
|
||||
specializest : tsymtable;
|
||||
item: psymtablestackitem;
|
||||
begin
|
||||
{ retrieve generic def that we are going to replace }
|
||||
genericdef:=tstoreddef(tt);
|
||||
tt:=nil;
|
||||
onlyparsepara:=false;
|
||||
procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean;out srsym:tsym;out srsymtable:tsymtable); forward;
|
||||
|
||||
if not(df_generic in genericdef.defoptions) then
|
||||
begin
|
||||
Message(parser_e_special_onlygenerics);
|
||||
tt:=generrordef;
|
||||
onlyparsepara:=true;
|
||||
end;
|
||||
|
||||
{ only need to record the tokens, then we don't know the type yet ... }
|
||||
if parse_generic then
|
||||
begin
|
||||
{ ... but we have to insert a def into the symtable else the deflist
|
||||
of generic and specialization might not be equally sized which
|
||||
is later assumed }
|
||||
tt:=tundefineddef.create;
|
||||
if parse_class_parent then
|
||||
tt:=genericdef;
|
||||
onlyparsepara:=true;
|
||||
end;
|
||||
|
||||
{ Only parse the parameters for recovery or
|
||||
for recording in genericbuf }
|
||||
if onlyparsepara then
|
||||
begin
|
||||
consume(_LSHARPBRACKET);
|
||||
repeat
|
||||
pt2:=factor(false,true);
|
||||
pt2.free;
|
||||
until not try_to_consume(_COMMA);
|
||||
consume(_RSHARPBRACKET);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if not try_to_consume(_LT) then
|
||||
consume(_LSHARPBRACKET);
|
||||
{ Parse generic parameters, for each undefineddef in the symtable of
|
||||
the genericdef we need to have a new def }
|
||||
err:=false;
|
||||
first:=true;
|
||||
generictypelist:=TFPObjectList.create(false);
|
||||
case genericdef.typ of
|
||||
procdef:
|
||||
st:=genericdef.GetSymtable(gs_para);
|
||||
objectdef,
|
||||
recorddef:
|
||||
st:=genericdef.GetSymtable(gs_record);
|
||||
arraydef:
|
||||
st:=tarraydef(genericdef).symtable;
|
||||
procvardef:
|
||||
st:=genericdef.GetSymtable(gs_para);
|
||||
else
|
||||
internalerror(200511182);
|
||||
end;
|
||||
|
||||
{ Parse type parameters }
|
||||
if not assigned(genericdef.typesym) then
|
||||
internalerror(200710173);
|
||||
specializename:=genericdef.typesym.realname;
|
||||
prettyname:=genericdef.typesym.prettyname+'<';
|
||||
for i:=0 to st.SymList.Count-1 do
|
||||
begin
|
||||
sym:=tsym(st.SymList[i]);
|
||||
if (sp_generic_para in sym.symoptions) then
|
||||
begin
|
||||
if not first then
|
||||
consume(_COMMA)
|
||||
else
|
||||
first:=false;
|
||||
pt2:=factor(false,true);
|
||||
if pt2.nodetype=typen then
|
||||
begin
|
||||
if df_generic in pt2.resultdef.defoptions then
|
||||
Message(parser_e_no_generics_as_params);
|
||||
generictype:=ttypesym.create(sym.realname,pt2.resultdef);
|
||||
generictypelist.add(generictype);
|
||||
if not assigned(pt2.resultdef.typesym) then
|
||||
message(type_e_generics_cannot_reference_itself)
|
||||
else
|
||||
begin
|
||||
specializename:=specializename+'$'+pt2.resultdef.typesym.realname;
|
||||
if i=0 then
|
||||
prettyname:=prettyname+pt2.resultdef.typesym.prettyname
|
||||
else
|
||||
prettyname:=prettyname+','+pt2.resultdef.typesym.prettyname;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Message(type_e_type_id_expected);
|
||||
err:=true;
|
||||
end;
|
||||
pt2.free;
|
||||
end;
|
||||
end;
|
||||
prettyname:=prettyname+'>';
|
||||
|
||||
uspecializename:=upper(specializename);
|
||||
{ force correct error location if too much type parameters are passed }
|
||||
if not (token in [_RSHARPBRACKET,_GT]) then
|
||||
consume(_RSHARPBRACKET);
|
||||
|
||||
{ Special case if we are referencing the current defined object }
|
||||
if assigned(current_structdef) and
|
||||
(current_structdef.objname^=uspecializename) then
|
||||
tt:=current_structdef;
|
||||
|
||||
{ for units specializations can already be needed in the interface, therefor we
|
||||
will use the global symtable. Programs don't have a globalsymtable and there we
|
||||
use the localsymtable }
|
||||
if current_module.is_unit then
|
||||
specializest:=current_module.globalsymtable
|
||||
else
|
||||
specializest:=current_module.localsymtable;
|
||||
|
||||
{ Can we reuse an already specialized type? }
|
||||
if not assigned(tt) then
|
||||
begin
|
||||
srsym:=tsym(specializest.find(uspecializename));
|
||||
if assigned(srsym) then
|
||||
begin
|
||||
if srsym.typ<>typesym then
|
||||
internalerror(200710171);
|
||||
tt:=ttypesym(srsym).typedef;
|
||||
end;
|
||||
end;
|
||||
|
||||
if not assigned(tt) then
|
||||
begin
|
||||
{ Setup symtablestack at definition time
|
||||
to get types right, however this is not perfect, we should probably record
|
||||
the resolved symbols }
|
||||
oldsymtablestack:=symtablestack;
|
||||
oldextendeddefs:=current_module.extendeddefs;
|
||||
current_module.extendeddefs:=TFPHashObjectList.create(true);
|
||||
symtablestack:=tdefawaresymtablestack.create;
|
||||
if not assigned(genericdef) then
|
||||
internalerror(200705151);
|
||||
hmodule:=find_module_from_symtable(genericdef.owner);
|
||||
if hmodule=nil then
|
||||
internalerror(200705152);
|
||||
pu:=tused_unit(hmodule.used_units.first);
|
||||
while assigned(pu) do
|
||||
begin
|
||||
if not assigned(pu.u.globalsymtable) then
|
||||
internalerror(200705153);
|
||||
symtablestack.push(pu.u.globalsymtable);
|
||||
pu:=tused_unit(pu.next);
|
||||
end;
|
||||
|
||||
if assigned(hmodule.globalsymtable) then
|
||||
symtablestack.push(hmodule.globalsymtable);
|
||||
|
||||
{ hacky, but necessary to insert the newly generated class properly }
|
||||
item:=oldsymtablestack.stack;
|
||||
while assigned(item) and (item^.symtable.symtablelevel>main_program_level) do
|
||||
item:=item^.next;
|
||||
if assigned(item) and (item^.symtable<>symtablestack.top) then
|
||||
symtablestack.push(item^.symtable);
|
||||
|
||||
{ Reparse the original type definition }
|
||||
if not err then
|
||||
begin
|
||||
{ First a new typesym so we can reuse this specialization and
|
||||
references to this specialization can be handled }
|
||||
srsym:=ttypesym.create(specializename,generrordef);
|
||||
specializest.insert(srsym);
|
||||
|
||||
if not assigned(genericdef.generictokenbuf) then
|
||||
internalerror(200511171);
|
||||
current_scanner.startreplaytokens(genericdef.generictokenbuf,
|
||||
genericdef.change_endian);
|
||||
read_named_type(tt,specializename,genericdef,generictypelist,false);
|
||||
ttypesym(srsym).typedef:=tt;
|
||||
tt.typesym:=srsym;
|
||||
|
||||
if _prettyname<>'' then
|
||||
ttypesym(tt.typesym).fprettyname:=_prettyname
|
||||
else
|
||||
ttypesym(tt.typesym).fprettyname:=prettyname;
|
||||
|
||||
case tt.typ of
|
||||
{ Build VMT indexes for classes }
|
||||
objectdef:
|
||||
begin
|
||||
vmtbuilder:=TVMTBuilder.Create(tobjectdef(tt));
|
||||
vmtbuilder.generate_vmt;
|
||||
vmtbuilder.free;
|
||||
end;
|
||||
{ handle params, calling convention, etc }
|
||||
procvardef:
|
||||
begin
|
||||
if not check_proc_directive(true) then
|
||||
begin
|
||||
try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
|
||||
consume(_SEMICOLON);
|
||||
end;
|
||||
parse_var_proc_directives(ttypesym(srsym));
|
||||
handle_calling_convention(tprocvardef(tt));
|
||||
if try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg) then
|
||||
consume(_SEMICOLON);
|
||||
end;
|
||||
end;
|
||||
{ Consume the semicolon if it is also recorded }
|
||||
try_to_consume(_SEMICOLON);
|
||||
end;
|
||||
|
||||
{ Restore symtablestack }
|
||||
current_module.extendeddefs.free;
|
||||
current_module.extendeddefs:=oldextendeddefs;
|
||||
symtablestack.free;
|
||||
symtablestack:=oldsymtablestack;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ There is comment few lines before ie 200512115
|
||||
saying "We are parsing the same objectdef, the def index numbers
|
||||
are the same". This is wrong (index numbers are not same)
|
||||
in case there is specialization (S2 in this case) inside
|
||||
specialized generic (G2 in this case) which is equal to
|
||||
some previous specialization (S1 in this case). In that case,
|
||||
new symbol is not added to currently specialized type
|
||||
(S in this case) for that specializations (S2 in this case),
|
||||
and this results in that specialization and generic definition
|
||||
don't have same number of elements in their object symbol tables.
|
||||
This patch adds undefined def to ensure that those
|
||||
two symbol tables will have same number of elements.
|
||||
}
|
||||
tundefineddef.create;
|
||||
end;
|
||||
|
||||
generictypelist.free;
|
||||
if not try_to_consume(_GT) then
|
||||
consume(_RSHARPBRACKET);
|
||||
end;
|
||||
|
||||
|
||||
procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef:boolean); forward;
|
||||
|
||||
{ def is the outermost type in which other types have to be searched
|
||||
|
||||
@ -423,6 +158,8 @@ implementation
|
||||
var
|
||||
t2: tdef;
|
||||
structstackindex: longint;
|
||||
srsym: tsym;
|
||||
srsymtable: tsymtable;
|
||||
begin
|
||||
if assigned(currentstructstack) then
|
||||
structstackindex:=currentstructstack.count-1
|
||||
@ -431,12 +168,7 @@ implementation
|
||||
{ handle types inside classes, e.g. TNode.TLongint }
|
||||
while (token=_POINT) do
|
||||
begin
|
||||
if parse_generic then
|
||||
begin
|
||||
consume(_POINT);
|
||||
consume(_ID);
|
||||
end
|
||||
else if is_class_or_object(def) or is_record(def) then
|
||||
if is_class_or_object(def) or is_record(def) then
|
||||
begin
|
||||
consume(_POINT);
|
||||
if (structstackindex>=0) and
|
||||
@ -451,7 +183,7 @@ implementation
|
||||
structstackindex:=-1;
|
||||
symtablestack.push(tabstractrecorddef(def).symtable);
|
||||
t2:=generrordef;
|
||||
id_type(t2,isforwarddef,false);
|
||||
id_type(t2,isforwarddef,false,false,srsym,srsymtable);
|
||||
symtablestack.pop(tabstractrecorddef(def).symtable);
|
||||
def:=t2;
|
||||
end;
|
||||
@ -497,18 +229,18 @@ implementation
|
||||
result:=false;
|
||||
end;
|
||||
|
||||
procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef:boolean);
|
||||
procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean;out srsym:tsym;out srsymtable:tsymtable);
|
||||
{ reads a type definition }
|
||||
{ to a appropriating tdef, s gets the name of }
|
||||
{ the type to allow name mangling }
|
||||
var
|
||||
is_unit_specific : boolean;
|
||||
pos : tfileposinfo;
|
||||
srsym : tsym;
|
||||
srsymtable : TSymtable;
|
||||
s,sorg : TIDString;
|
||||
t : ttoken;
|
||||
begin
|
||||
srsym:=nil;
|
||||
srsymtable:=nil;
|
||||
s:=pattern;
|
||||
sorg:=orgpattern;
|
||||
pos:=current_tokenpos;
|
||||
@ -528,7 +260,10 @@ implementation
|
||||
table as forwarddef are not resolved directly }
|
||||
if assigned(srsym) and
|
||||
(srsym.typ=typesym) and
|
||||
(ttypesym(srsym).typedef.typ=errordef) then
|
||||
((ttypesym(srsym).typedef.typ=errordef) or
|
||||
(not allowgenericsyms and
|
||||
(ttypesym(srsym).typedef.typ=undefineddef) and
|
||||
not (sp_generic_para in srsym.symoptions))) then
|
||||
begin
|
||||
Message1(type_e_type_is_not_completly_defined,ttypesym(srsym).realname);
|
||||
def:=generrordef;
|
||||
@ -571,6 +306,8 @@ implementation
|
||||
t2 : tdef;
|
||||
dospecialize,
|
||||
again : boolean;
|
||||
srsym : tsym;
|
||||
srsymtable : tsymtable;
|
||||
begin
|
||||
dospecialize:=false;
|
||||
repeat
|
||||
@ -617,7 +354,7 @@ implementation
|
||||
end
|
||||
else
|
||||
begin
|
||||
id_type(def,stoIsForwardDef in options,true);
|
||||
id_type(def,stoIsForwardDef in options,true,true,srsym,srsymtable);
|
||||
parse_nested_types(def,stoIsForwardDef in options,nil);
|
||||
end;
|
||||
end;
|
||||
@ -631,9 +368,9 @@ implementation
|
||||
until not again;
|
||||
if ([stoAllowSpecialization,stoAllowTypeDef] * options <> []) and
|
||||
(m_delphi in current_settings.modeswitches) then
|
||||
dospecialize:=token=_LSHARPBRACKET;
|
||||
dospecialize:=token in [_LSHARPBRACKET,_LT];
|
||||
if dospecialize then
|
||||
generate_specialization(def,stoParseClassParent in options,'')
|
||||
generate_specialization(def,stoParseClassParent in options,'',nil,'')
|
||||
else
|
||||
begin
|
||||
if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
|
||||
@ -644,7 +381,14 @@ implementation
|
||||
begin
|
||||
def:=current_genericdef
|
||||
end
|
||||
else if (df_generic in def.defoptions) then
|
||||
else if (df_generic in def.defoptions) and
|
||||
not
|
||||
(
|
||||
parse_generic and
|
||||
(current_genericdef.typ in [recorddef,objectdef]) and
|
||||
sym_is_owned_by(srsym,tabstractrecorddef(current_genericdef).symtable)
|
||||
)
|
||||
then
|
||||
begin
|
||||
Message(parser_e_no_generics_as_types);
|
||||
def:=generrordef;
|
||||
@ -983,7 +727,16 @@ implementation
|
||||
else if assigned(genericlist) then
|
||||
current_genericdef:=current_structdef;
|
||||
|
||||
{ nested types of specializations are specializations as well }
|
||||
if assigned(old_current_structdef) and
|
||||
(df_specialization in old_current_structdef.defoptions) then
|
||||
include(current_structdef.defoptions,df_specialization);
|
||||
|
||||
insert_generic_parameter_types(current_structdef,genericdef,genericlist);
|
||||
{ when we are parsing a generic already then this is a generic as
|
||||
well }
|
||||
if old_parse_generic then
|
||||
include(current_structdef.defoptions, df_generic);
|
||||
parse_generic:=(df_generic in current_structdef.defoptions);
|
||||
if m_advanced_records in current_settings.modeswitches then
|
||||
parse_record_members
|
||||
@ -1090,9 +843,40 @@ implementation
|
||||
def:=ttypenode(pt1).resultdef;
|
||||
{ Delphi mode specialization? }
|
||||
if (m_delphi in current_settings.modeswitches) then
|
||||
dospecialize:=token=_LSHARPBRACKET;
|
||||
dospecialize:=token=_LSHARPBRACKET
|
||||
else
|
||||
{ in non-Delphi modes we might get a inline specialization
|
||||
without "specialize" or "<T>" of the same type we're
|
||||
currently parsing, so we need to handle that special }
|
||||
if not dospecialize and
|
||||
assigned(ttypenode(pt1).typesym) and
|
||||
(ttypenode(pt1).typesym.typ=typesym) and
|
||||
(sp_generic_dummy in ttypenode(pt1).typesym.symoptions) and
|
||||
assigned(current_structdef) and
|
||||
(
|
||||
(
|
||||
not (m_delphi in current_settings.modeswitches) and
|
||||
(ttypesym(ttypenode(pt1).typesym).typedef.typ=undefineddef) and
|
||||
(df_generic in current_structdef.defoptions) and
|
||||
(ttypesym(ttypenode(pt1).typesym).typedef.owner=current_structdef.owner) and
|
||||
(upper(ttypenode(pt1).typesym.realname)=copy(current_structdef.objname^,1,pos('$',current_structdef.objname^)-1))
|
||||
) or (
|
||||
(df_specialization in current_structdef.defoptions) and
|
||||
(ttypesym(ttypenode(pt1).typesym).typedef=current_structdef.genericdef)
|
||||
)
|
||||
)
|
||||
then
|
||||
begin
|
||||
def:=current_structdef;
|
||||
{ handle nested types }
|
||||
post_comp_expr_gendef(def);
|
||||
end;
|
||||
if dospecialize then
|
||||
generate_specialization(def,false,name)
|
||||
begin
|
||||
generate_specialization(def,false,name,nil,'');
|
||||
{ handle nested types }
|
||||
post_comp_expr_gendef(def);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
|
||||
@ -1103,7 +887,17 @@ implementation
|
||||
begin
|
||||
def:=current_genericdef
|
||||
end
|
||||
else if (df_generic in def.defoptions) then
|
||||
else if (df_generic in def.defoptions) and
|
||||
{ TODO : check once nested generics are allowed }
|
||||
not
|
||||
(
|
||||
parse_generic and
|
||||
(current_genericdef.typ in [recorddef,objectdef]) and
|
||||
(def.typ in [recorddef,objectdef]) and
|
||||
(ttypenode(pt1).typesym<>nil) and
|
||||
sym_is_owned_by(ttypenode(pt1).typesym,tabstractrecorddef(current_genericdef).symtable)
|
||||
)
|
||||
then
|
||||
begin
|
||||
Message(parser_e_no_generics_as_types);
|
||||
def:=generrordef;
|
||||
|
||||
@ -167,7 +167,11 @@ type
|
||||
sp_implicitrename,
|
||||
sp_hint_experimental,
|
||||
sp_generic_para,
|
||||
sp_has_deprecated_msg
|
||||
sp_has_deprecated_msg,
|
||||
sp_generic_dummy { this is used for symbols that are generated when a
|
||||
generic is encountered to ease inline
|
||||
specializations, etc; those symbols can be
|
||||
"overridden" with a completely different symbol }
|
||||
);
|
||||
tsymoptions=set of tsymoption;
|
||||
|
||||
@ -471,7 +475,7 @@ type
|
||||
|
||||
{ options for symtables }
|
||||
tsymtableoption = (
|
||||
sto_has_helper { contains at least one helper symbol }
|
||||
sto_has_helper { contains at least one helper symbol }
|
||||
);
|
||||
tsymtableoptions = set of tsymtableoption;
|
||||
|
||||
|
||||
@ -120,6 +120,7 @@ interface
|
||||
end;
|
||||
|
||||
ttypesym = class(Tstoredsym)
|
||||
public
|
||||
typedef : tdef;
|
||||
typedefderef : tderef;
|
||||
fprettyname : ansistring;
|
||||
@ -1981,13 +1982,13 @@ implementation
|
||||
|
||||
procedure ttypesym.buildderef;
|
||||
begin
|
||||
typedefderef.build(typedef);
|
||||
typedefderef.build(typedef);
|
||||
end;
|
||||
|
||||
|
||||
procedure ttypesym.deref;
|
||||
begin
|
||||
typedef:=tdef(typedefderef.resolve);
|
||||
typedef:=tdef(typedefderef.resolve);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -166,6 +166,11 @@ interface
|
||||
function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
|
||||
end;
|
||||
|
||||
tspecializesymtable = class(tglobalsymtable)
|
||||
public
|
||||
function iscurrentunit:boolean;override;
|
||||
end;
|
||||
|
||||
twithsymtable = class(TSymtable)
|
||||
withrefnode : tobject; { tnode }
|
||||
constructor create(aowner:tdef;ASymList:TFPHashObjectList;refnode:tobject{tnode});
|
||||
@ -214,14 +219,20 @@ interface
|
||||
procedure incompatibletypes(def1,def2:tdef);
|
||||
procedure hidesym(sym:TSymEntry);
|
||||
procedure duplicatesym(var hashedid:THashedIDString;dupsym,origsym:TSymEntry);
|
||||
function handle_generic_dummysym(sym:TSymEntry;var symoptions:tsymoptions):boolean;
|
||||
|
||||
{*** Search ***}
|
||||
procedure addsymref(sym:tsym);
|
||||
function is_owned_by(childdef,ownerdef:tdef):boolean;
|
||||
function sym_is_owned_by(childsym:tsym;symtable:tsymtable):boolean;
|
||||
function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
|
||||
function is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean;
|
||||
function is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean;
|
||||
function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_maybe_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchoption:boolean;option:tsymoption):boolean;
|
||||
{ searches for a symbol with the given name that has the given option in
|
||||
symoptions set }
|
||||
function searchsym_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;option:tsymoption):boolean;
|
||||
function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
|
||||
@ -342,7 +353,6 @@ implementation
|
||||
var
|
||||
dupnr : longint; { unique number for duplicate symbols }
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TStoredSymtable
|
||||
*****************************************************************************}
|
||||
@ -1467,6 +1477,8 @@ implementation
|
||||
hsym:=tsym(FindWithHash(hashedid));
|
||||
if assigned(hsym) then
|
||||
begin
|
||||
if (sym is tstoredsym) and handle_generic_dummysym(hsym,tstoredsym(sym).symoptions) then
|
||||
exit;
|
||||
if hsym.typ=symconst.namespacesym then
|
||||
begin
|
||||
case sym.typ of
|
||||
@ -1598,6 +1610,16 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
tspecializesymtable
|
||||
*****************************************************************************}
|
||||
|
||||
function tspecializesymtable.iscurrentunit: boolean;
|
||||
begin
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TWITHSYMTABLE
|
||||
****************************************************************************}
|
||||
@ -1806,6 +1828,29 @@ implementation
|
||||
include(tsym(dupsym).symoptions,sp_implicitrename);
|
||||
end;
|
||||
|
||||
function handle_generic_dummysym(sym:TSymEntry;var symoptions:tsymoptions):boolean;
|
||||
begin
|
||||
result:=false;
|
||||
if not assigned(sym) or not (sym is tstoredsym) then
|
||||
Internalerror(2011081101);
|
||||
{ For generics a dummy symbol without the parameter count is created
|
||||
if such a symbol not yet exists so that different parts of the
|
||||
parser can find that symbol. If that symbol is still a
|
||||
undefineddef we replace the generic dummy symbol's
|
||||
name with a "dup" name and use the new symbol as the generic dummy
|
||||
symbol }
|
||||
if (sp_generic_dummy in tstoredsym(sym).symoptions) and
|
||||
(sym.typ=typesym) and (ttypesym(sym).typedef.typ=undefineddef) and
|
||||
(m_delphi in current_settings.modeswitches) then
|
||||
begin
|
||||
inc(dupnr);
|
||||
sym.Owner.SymList.Rename(upper(sym.realname),'dup_'+tostr(dupnr)+sym.realname);
|
||||
include(tsym(sym).symoptions,sp_implicitrename);
|
||||
{ we need to find the new symbol now if checking for a dummy }
|
||||
include(symoptions,sp_generic_dummy);
|
||||
result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
Search
|
||||
@ -1833,6 +1878,13 @@ implementation
|
||||
result:=is_owned_by(tdef(childdef.owner.defowner),ownerdef);
|
||||
end;
|
||||
|
||||
function sym_is_owned_by(childsym:tsym;symtable:tsymtable):boolean;
|
||||
begin
|
||||
result:=childsym.owner=symtable;
|
||||
if not result and (childsym.owner.symtabletype in [objectsymtable,recordsymtable]) then
|
||||
result:=sym_is_owned_by(tabstractrecorddef(childsym.owner.defowner).typesym,symtable);
|
||||
end;
|
||||
|
||||
function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
|
||||
var
|
||||
symownerdef : tabstractrecorddef;
|
||||
@ -1962,6 +2014,11 @@ implementation
|
||||
|
||||
|
||||
function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
begin
|
||||
result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,false,sp_none);
|
||||
end;
|
||||
|
||||
function searchsym_maybe_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchoption:boolean;option:tsymoption):boolean;
|
||||
var
|
||||
hashedid : THashedIDString;
|
||||
contextstructdef : tabstractrecorddef;
|
||||
@ -1975,6 +2032,12 @@ implementation
|
||||
srsymtable:=stackitem^.symtable;
|
||||
if (srsymtable.symtabletype=objectsymtable) then
|
||||
begin
|
||||
{ TODO : implement the search for an option in classes as well }
|
||||
if searchoption then
|
||||
begin
|
||||
result:=false;
|
||||
exit;
|
||||
end;
|
||||
if searchsym_in_class(tobjectdef(srsymtable.defowner),tobjectdef(srsymtable.defowner),s,srsym,srsymtable,true) then
|
||||
begin
|
||||
result:=true;
|
||||
@ -1997,7 +2060,8 @@ implementation
|
||||
else
|
||||
contextstructdef:=current_structdef;
|
||||
if not (srsym.owner.symtabletype in [objectsymtable,recordsymtable]) or
|
||||
is_visible_for_object(srsym,contextstructdef) then
|
||||
is_visible_for_object(srsym,contextstructdef) and
|
||||
(not searchoption or (option in srsym.symoptions)) then
|
||||
begin
|
||||
{ we need to know if a procedure references symbols
|
||||
in the static symtable, because then it can't be
|
||||
@ -2017,6 +2081,11 @@ implementation
|
||||
srsymtable:=nil;
|
||||
end;
|
||||
|
||||
function searchsym_with_symoption(const s: TIDString;out srsym:tsym;out
|
||||
srsymtable:TSymtable;option:tsymoption):boolean;
|
||||
begin
|
||||
result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,true,option);
|
||||
end;
|
||||
|
||||
function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
var
|
||||
|
||||
@ -1074,7 +1074,8 @@ const
|
||||
(mask:sp_internal; str:'Internal'),
|
||||
(mask:sp_implicitrename; str:'Implicit Rename'),
|
||||
(mask:sp_generic_para; str:'Generic Parameter'),
|
||||
(mask:sp_has_deprecated_msg; str:'Has Deprecated Message')
|
||||
(mask:sp_has_deprecated_msg; str:'Has Deprecated Message'),
|
||||
(mask:sp_generic_dummy; str:'Generic Dummy')
|
||||
);
|
||||
var
|
||||
symoptions : tsymoptions;
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{ %NORUN }
|
||||
program tgeneric29;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
25
tests/test/tgeneric36.pp
Normal file
25
tests/test/tgeneric36.pp
Normal file
@ -0,0 +1,25 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: class only }
|
||||
program tgeneric36;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest = class
|
||||
|
||||
end;
|
||||
|
||||
TTest<T> = class
|
||||
|
||||
end;
|
||||
|
||||
TTest<T, S> = class
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
25
tests/test/tgeneric37.pp
Normal file
25
tests/test/tgeneric37.pp
Normal file
@ -0,0 +1,25 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: record only }
|
||||
program tgeneric37;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest = record
|
||||
|
||||
end;
|
||||
|
||||
TTest<T> = record
|
||||
|
||||
end;
|
||||
|
||||
TTest<T, S> = record
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
25
tests/test/tgeneric38.pp
Normal file
25
tests/test/tgeneric38.pp
Normal file
@ -0,0 +1,25 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: interface only }
|
||||
program tgeneric38;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest = interface
|
||||
|
||||
end;
|
||||
|
||||
TTest<T> = interface
|
||||
|
||||
end;
|
||||
|
||||
TTest<T, S> = interface
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
19
tests/test/tgeneric39.pp
Normal file
19
tests/test/tgeneric39.pp
Normal file
@ -0,0 +1,19 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: procvars only }
|
||||
program tgeneric39;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest = procedure;
|
||||
|
||||
TTest<T> = procedure;
|
||||
|
||||
TTest<T, S> = procedure;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
19
tests/test/tgeneric40.pp
Normal file
19
tests/test/tgeneric40.pp
Normal file
@ -0,0 +1,19 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: arrays only }
|
||||
program tgeneric40;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest = array of Integer;
|
||||
|
||||
TTest<T> = array of Integer;
|
||||
|
||||
TTest<T, S> = array of Integer;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
19
tests/test/tgeneric41.pp
Normal file
19
tests/test/tgeneric41.pp
Normal file
@ -0,0 +1,19 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: method vars only }
|
||||
program tgeneric41;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest = procedure of object;
|
||||
|
||||
TTest<T> = procedure of object;
|
||||
|
||||
TTest<T, S> = procedure of object;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
26
tests/test/tgeneric42.pp
Normal file
26
tests/test/tgeneric42.pp
Normal file
@ -0,0 +1,26 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: class only
|
||||
Note: This tests a different code path than in the compiler than tgeneric36! }
|
||||
program tgeneric42;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = class
|
||||
|
||||
end;
|
||||
|
||||
TTest = class
|
||||
|
||||
end;
|
||||
|
||||
TTest<T, S> = class
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
26
tests/test/tgeneric43.pp
Normal file
26
tests/test/tgeneric43.pp
Normal file
@ -0,0 +1,26 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: record only
|
||||
Note: This tests a different code path than in the compiler than tgeneric37! }
|
||||
program tgeneric43;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = record
|
||||
|
||||
end;
|
||||
|
||||
TTest = record
|
||||
|
||||
end;
|
||||
|
||||
TTest<T, S> = record
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
26
tests/test/tgeneric44.pp
Normal file
26
tests/test/tgeneric44.pp
Normal file
@ -0,0 +1,26 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: interface only
|
||||
Note: This tests a different code path than in the compiler than tgeneric38! }
|
||||
program tgeneric44;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = interface
|
||||
|
||||
end;
|
||||
|
||||
TTest = interface
|
||||
|
||||
end;
|
||||
|
||||
TTest<T, S> = interface
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
20
tests/test/tgeneric45.pp
Normal file
20
tests/test/tgeneric45.pp
Normal file
@ -0,0 +1,20 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: procvars only
|
||||
Note: This tests a different code path than in the compiler than tgeneric39! }
|
||||
program tgeneric45;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = procedure;
|
||||
|
||||
TTest = procedure;
|
||||
|
||||
TTest<T, S> = procedure;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
20
tests/test/tgeneric46.pp
Normal file
20
tests/test/tgeneric46.pp
Normal file
@ -0,0 +1,20 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: arrays only
|
||||
Note: This tests a different code path than in the compiler than tgeneric40! }
|
||||
program tgeneric40;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = array of Integer;
|
||||
|
||||
TTest = array of Integer;
|
||||
|
||||
TTest<T, S> = array of Integer;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
20
tests/test/tgeneric47.pp
Normal file
20
tests/test/tgeneric47.pp
Normal file
@ -0,0 +1,20 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: method vars only
|
||||
Note: This tests a different code path than in the compiler than tgeneric39! }
|
||||
program tgeneric47;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = procedure of object;
|
||||
|
||||
TTest = procedure of object;
|
||||
|
||||
TTest<T, S> = procedure of object;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
28
tests/test/tgeneric48.pp
Normal file
28
tests/test/tgeneric48.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ in mode Delphi generic types might be overloaded - here: a mix }
|
||||
program tgeneric48;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest = class
|
||||
end;
|
||||
|
||||
TTest<T> = record
|
||||
end;
|
||||
|
||||
TTest<T, S> = interface
|
||||
end;
|
||||
|
||||
TTest<T, S, R> = procedure;
|
||||
|
||||
TTest<T, S, R, Q> = array of Integer;
|
||||
|
||||
TTest<T, S, R, Q, P> = procedure of object;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
38
tests/test/tgeneric49.pp
Normal file
38
tests/test/tgeneric49.pp
Normal file
@ -0,0 +1,38 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ This tests whether the correct deprecated messages are printed. As I don't
|
||||
know of a way to check these inside a test this needs to be done by hand }
|
||||
program tgeneric49;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = class
|
||||
|
||||
end deprecated 'Message A';
|
||||
|
||||
TTest = class
|
||||
|
||||
end deprecated 'Message B';
|
||||
|
||||
// this should print 'Message A'
|
||||
TTestInteger = TTest<Integer>;
|
||||
|
||||
FooInt = Integer deprecated;
|
||||
|
||||
// this should print that TTest<T> and FooInt are deprecated
|
||||
TTestFooInt = TTest<FooInt>;
|
||||
|
||||
var
|
||||
// this should print 'Message B'
|
||||
t: TTest;
|
||||
// this should print nothing
|
||||
t2: TTestInteger;
|
||||
// this should print that TTest<T> and FooInt are deprecated
|
||||
t3: TTest<FooInt>;
|
||||
begin
|
||||
// this should print that TTest<T> and FooInt are deprecated
|
||||
t3 := TTest<FooInt>.Create;
|
||||
end.
|
||||
31
tests/test/tgeneric50.pp
Normal file
31
tests/test/tgeneric50.pp
Normal file
@ -0,0 +1,31 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ this tests that hint directives defined for a generic only apply when
|
||||
specializung a generic and that specializations may introduce their own
|
||||
directives }
|
||||
program tgeneric50;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = class
|
||||
|
||||
end deprecated 'Message A' platform;
|
||||
|
||||
// these will both print that TTest<T> is deprecated and platform
|
||||
TTestInteger = TTest<Integer> deprecated 'Message B' experimental;
|
||||
TTestString = TTest<String>;
|
||||
|
||||
var
|
||||
// this will print that TTestInteger is deprecated and experimental
|
||||
t: TTestInteger;
|
||||
// this will print nothing
|
||||
t2: TTestString;
|
||||
begin
|
||||
// this will print that TTest<T> is deprecated and platform
|
||||
t2 := TTest<String>.Create;
|
||||
// this will print that TTestInteger is deprecated and experimental
|
||||
t := TTestInteger.Create;
|
||||
end.
|
||||
39
tests/test/tgeneric51.pp
Normal file
39
tests/test/tgeneric51.pp
Normal file
@ -0,0 +1,39 @@
|
||||
{ this tests that simple inline specializations work }
|
||||
program tgeneric51;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TTest<T> = class
|
||||
function Test(a: T): T;
|
||||
class function ClassTest(a: T): T;
|
||||
end;
|
||||
|
||||
function TTest<T>.Test(a: T): T;
|
||||
begin
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
class function TTest<T>.ClassTest(a: T): T;
|
||||
begin
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest<Integer>;
|
||||
res: Integer;
|
||||
begin
|
||||
t := TTest<Integer>.Create;
|
||||
res := t.Test(42);
|
||||
Writeln('t.Test: ', res);
|
||||
if res <> 42 then
|
||||
Halt(1);
|
||||
res := TTest<Integer>.ClassTest(42);
|
||||
Writeln('t.ClassTest: ', res);
|
||||
if res <> 42 then
|
||||
Halt(2);
|
||||
Writeln('ok');
|
||||
end.
|
||||
38
tests/test/tgeneric52.pp
Normal file
38
tests/test/tgeneric52.pp
Normal file
@ -0,0 +1,38 @@
|
||||
{ this tests that forced typecasts to inline specialized types work }
|
||||
program tgeneric52;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TTest = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TTestGen<T> = class(TTest)
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestGen<T>.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest;
|
||||
res: Integer;
|
||||
begin
|
||||
t := TTestGen<Integer>.Create;
|
||||
res := TTestGen<Integer>(t).Test;
|
||||
Writeln('t.Test: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
39
tests/test/tgeneric53.pp
Normal file
39
tests/test/tgeneric53.pp
Normal file
@ -0,0 +1,39 @@
|
||||
{ this tests that checked typecasts to inline specialized types work }
|
||||
program tgeneric53;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TTest = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TTestGen<T> = class(TTest)
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestGen<T>.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest;
|
||||
res: Integer;
|
||||
begin
|
||||
t := TTestGen<Integer>.Create;
|
||||
res := (t as TTestGen<Integer>).Test;
|
||||
Writeln('t.Test: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
40
tests/test/tgeneric54.pp
Normal file
40
tests/test/tgeneric54.pp
Normal file
@ -0,0 +1,40 @@
|
||||
{ this tests that type checks for inline specialized types work }
|
||||
program tgeneric53;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TTest = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TTestGen<T> = class(TTest)
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestGen<T>.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest;
|
||||
begin
|
||||
t := TTestGen<Integer>.Create;
|
||||
if t is TTestGen<Integer> then
|
||||
Writeln('t is a TTestGen<Integer>')
|
||||
else begin
|
||||
Writeln('t is not a TTestGen<Integer>');
|
||||
Halt(1);
|
||||
end;
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
19
tests/test/tgeneric55.pp
Normal file
19
tests/test/tgeneric55.pp
Normal file
@ -0,0 +1,19 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ this tests that the dummy symbol that is introduced for generic "overloads"
|
||||
can not be used when it shouldn't be - Test 1 }
|
||||
program tgeneric55;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = class
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest;
|
||||
begin
|
||||
end.
|
||||
20
tests/test/tgeneric56.pp
Normal file
20
tests/test/tgeneric56.pp
Normal file
@ -0,0 +1,20 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ this tests that the dummy symbol that is introduced for generic "overloads"
|
||||
can not be used when it shouldn't be - Test 2 }
|
||||
program tgeneric56;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
generic TTest<T> = class
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest;
|
||||
begin
|
||||
end.
|
||||
|
||||
21
tests/test/tgeneric57.pp
Normal file
21
tests/test/tgeneric57.pp
Normal file
@ -0,0 +1,21 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ this tests that the dummy symbol that is introduced for generic "overloads"
|
||||
can not be used when it shouldn't be - Test 3 }
|
||||
program tgeneric57;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = class
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
t: TObject;
|
||||
begin
|
||||
t := TTest.Create;
|
||||
end.
|
||||
|
||||
21
tests/test/tgeneric58.pp
Normal file
21
tests/test/tgeneric58.pp
Normal file
@ -0,0 +1,21 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ this tests that the dummy symbol that is introduced for generic "overloads"
|
||||
can not be used when it shouldn't be - Test 4 }
|
||||
program tgeneric58;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
generic TTest<T> = class
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
t: TObject;
|
||||
begin
|
||||
t := TTest.Create;
|
||||
end.
|
||||
|
||||
25
tests/test/tgeneric59.pp
Normal file
25
tests/test/tgeneric59.pp
Normal file
@ -0,0 +1,25 @@
|
||||
{ TTest<T, S> is used from one unit, while TTest<T> is used from another }
|
||||
program tgeneric59;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
uses
|
||||
ugeneric59a,
|
||||
ugeneric59b;
|
||||
|
||||
type
|
||||
TTestInteger = TTest<Integer>;
|
||||
TTestIntegerString = TTest<Integer, String>;
|
||||
|
||||
var
|
||||
res: Integer;
|
||||
begin
|
||||
res := TTestInteger.Test;
|
||||
Writeln('TTestInteger.Test: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
28
tests/test/tgeneric60.pp
Normal file
28
tests/test/tgeneric60.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ this tests that nested non-generic structured types can be used inside
|
||||
generics - here: record in class }
|
||||
program tgeneric60;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = class
|
||||
type
|
||||
TTestSub = record
|
||||
class function Test(a: T): T; static;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TTest<T>.TTestSub.Test(a: T): T;
|
||||
begin
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest<Integer>.TTestSub;
|
||||
begin
|
||||
TTest<Integer>.TTestSub.Test(42);
|
||||
end.
|
||||
28
tests/test/tgeneric61.pp
Normal file
28
tests/test/tgeneric61.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ this tests that nested non-generic structured types can be used inside
|
||||
generics - here: class in class }
|
||||
program tgeneric61;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = class
|
||||
type
|
||||
TTestSub = class
|
||||
class function Test(a: T): T;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TTest<T>.TTestSub.Test(a: T): T;
|
||||
begin
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest<Integer>.TTestSub;
|
||||
begin
|
||||
TTest<Integer>.TTestSub.Test(42);
|
||||
end.
|
||||
28
tests/test/tgeneric62.pp
Normal file
28
tests/test/tgeneric62.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ this tests that nested non-generic structured types can be used inside
|
||||
generics - here: object in class }
|
||||
program tgeneric62;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = class
|
||||
type
|
||||
TTestSub = object
|
||||
function Test(a: T): T;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTest<T>.TTestSub.Test(a: T): T;
|
||||
begin
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest<Integer>.TTestSub;
|
||||
begin
|
||||
t.Test(42);
|
||||
end.
|
||||
28
tests/test/tgeneric63.pp
Normal file
28
tests/test/tgeneric63.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ this tests that nested non-generic structured types can be used inside
|
||||
generics - here: record in record }
|
||||
program tgeneric63;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = record
|
||||
type
|
||||
TTestSub = record
|
||||
class function Test(a: T): T; static;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TTest<T>.TTestSub.Test(a: T): T;
|
||||
begin
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest<Integer>.TTestSub;
|
||||
begin
|
||||
TTest<Integer>.TTestSub.Test(42);
|
||||
end.
|
||||
28
tests/test/tgeneric64.pp
Normal file
28
tests/test/tgeneric64.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ this tests that nested non-generic structured types can be used inside
|
||||
generics - here: class in record }
|
||||
program tgeneric64;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = record
|
||||
type
|
||||
TTestSub = class
|
||||
class function Test(a: T): T;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TTest<T>.TTestSub.Test(a: T): T;
|
||||
begin
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest<Integer>.TTestSub;
|
||||
begin
|
||||
TTest<Integer>.TTestSub.Test(42);
|
||||
end.
|
||||
28
tests/test/tgeneric65.pp
Normal file
28
tests/test/tgeneric65.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ this tests that nested non-generic structured types can be used inside
|
||||
generics - here: object in record }
|
||||
program tgeneric65;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = record
|
||||
type
|
||||
TTestSub = object
|
||||
function Test(a: T): T;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTest<T>.TTestSub.Test(a: T): T;
|
||||
begin
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest<Integer>.TTestSub;
|
||||
begin
|
||||
t.Test(42);
|
||||
end.
|
||||
28
tests/test/tgeneric66.pp
Normal file
28
tests/test/tgeneric66.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ this tests that nested non-generic structured types can be used inside
|
||||
generics - here: record in object }
|
||||
program tgeneric66;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = object
|
||||
type
|
||||
TTestSub = record
|
||||
class function Test(a: T): T; static;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TTest<T>.TTestSub.Test(a: T): T;
|
||||
begin
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest<Integer>.TTestSub;
|
||||
begin
|
||||
TTest<Integer>.TTestSub.Test(42);
|
||||
end.
|
||||
28
tests/test/tgeneric67.pp
Normal file
28
tests/test/tgeneric67.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ this tests that nested non-generic structured types can be used inside
|
||||
generics - here: class in object }
|
||||
program tgeneric66;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = object
|
||||
type
|
||||
TTestSub = class
|
||||
class function Test(a: T): T;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TTest<T>.TTestSub.Test(a: T): T;
|
||||
begin
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest<Integer>.TTestSub;
|
||||
begin
|
||||
TTest<Integer>.TTestSub.Test(42);
|
||||
end.
|
||||
28
tests/test/tgeneric68.pp
Normal file
28
tests/test/tgeneric68.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ this tests that nested non-generic structured types can be used inside
|
||||
generics - here: object in object }
|
||||
program tgeneric68;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest<T> = object
|
||||
type
|
||||
TTestSub = object
|
||||
function Test(a: T): T;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTest<T>.TTestSub.Test(a: T): T;
|
||||
begin
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest<Integer>.TTestSub;
|
||||
begin
|
||||
t.Test(42);
|
||||
end.
|
||||
24
tests/test/ugeneric59a.pp
Normal file
24
tests/test/ugeneric59a.pp
Normal file
@ -0,0 +1,24 @@
|
||||
unit ugeneric59a;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TTest<T> = class
|
||||
class function Test: Integer;
|
||||
end;
|
||||
|
||||
TTest<T, S> = class
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
class function TTest<T>.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
end.
|
||||
22
tests/test/ugeneric59b.pp
Normal file
22
tests/test/ugeneric59b.pp
Normal file
@ -0,0 +1,22 @@
|
||||
unit ugeneric59b;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TTest<T> = class
|
||||
class function Test: Integer;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
class function TTest<T>.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -5,13 +5,13 @@ program tw18567;
|
||||
type
|
||||
TSomeRecord <TData> = record
|
||||
data: TData;
|
||||
class operator Explicit(a: TData) : TSomeRecord;
|
||||
class operator Explicit(a: TData) : TSomeRecord <TData>;
|
||||
end;
|
||||
|
||||
class operator TSomeRecord <TData>.Explicit (a: TData): TSomeRecord;
|
||||
class operator TSomeRecord <TData>.Explicit (a: TData): TSomeRecord <TData>;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user