diff --git a/.gitattributes b/.gitattributes index 2a7e490ec2..c20371167d 100644 --- a/.gitattributes +++ b/.gitattributes @@ -10965,6 +10965,7 @@ tests/test/tgeneric89.pp svneol=native#text/pascal tests/test/tgeneric9.pp svneol=native#text/plain tests/test/tgeneric90.pp svneol=native#text/pascal tests/test/tgeneric91.pp svneol=native#text/pascal +tests/test/tgeneric92.pp svneol=native#text/pascal tests/test/tgoto.pp svneol=native#text/plain tests/test/theap.pp svneol=native#text/plain tests/test/theapthread.pp svneol=native#text/plain @@ -12973,6 +12974,7 @@ tests/webtbs/tw2128.pp svneol=native#text/plain tests/webtbs/tw2129.pp svneol=native#text/plain tests/webtbs/tw2129b.pp svneol=native#text/plain tests/webtbs/tw2131.pp svneol=native#text/plain +tests/webtbs/tw21329.pp svneol=native#text/pascal tests/webtbs/tw21350a.pp svneol=native#text/pascal tests/webtbs/tw21350b.pp svneol=native#text/pascal tests/webtbs/tw21443.pp svneol=native#text/plain diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 81aa0275f7..ec713f8115 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -1776,6 +1776,17 @@ implementation mayberesettypeconvs; exit; end; + nothingn : + begin + { generics can generate nothing nodes, just allow everything } + if df_generic in current_procinfo.procdef.defoptions then + result:=true + else if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + + mayberesettypeconvs; + exit; + end; loadn : begin case tloadnode(hp).symtableentry.typ of diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index c39e88b233..9c6f464e0f 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -2113,6 +2113,22 @@ implementation ---------------------------------------------} procedure factor_read_id(out p1:tnode;var again:boolean); + + function findwithsymtable : boolean; + var + hp : psymtablestackitem; + begin + result:=true; + hp:=symtablestack.stack; + while assigned(hp) do + begin + if hp^.symtable.symtabletype=withsymtable then + exit; + hp:=hp^.next; + end; + result:=false; + end; + var srsym : tsym; srsymtable : TSymtable; @@ -2192,9 +2208,21 @@ implementation symbol } not (sp_explicitrename in srsym.symoptions) then begin - identifier_not_found(orgstoredpattern); - srsym:=generrorsym; - srsymtable:=nil; + { if a generic is parsed and when we are inside an with block, + a symbol might not be defined } + if (df_generic in current_procinfo.procdef.defoptions) and + findwithsymtable then + begin + { create dummy symbol, it will be freed later on } + srsym:=tsym.create(undefinedsym,'$undefinedsym'); + srsymtable:=nil; + end + else + begin + identifier_not_found(orgstoredpattern); + srsym:=generrorsym; + srsymtable:=nil; + end; end; end; @@ -2411,6 +2439,14 @@ implementation end; end; + undefinedsym : + begin + p1:=cnothingnode.Create; + p1.resultdef:=tundefineddef.create; + { clean up previously created dummy symbol } + srsym.free; + end; + errorsym : begin p1:=cerrornode.create; diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index b211cf507e..06c93c7724 100644 --- a/compiler/pstatmnt.pas +++ b/compiler/pstatmnt.pas @@ -534,7 +534,6 @@ implementation hp, refnode : tnode; hdef : tdef; - extendeddef : tabstractrecorddef; helperdef : tobjectdef; hasimplicitderef : boolean; withsymtablelist : TFPObjectList; @@ -579,7 +578,8 @@ implementation to call it in case it returns a record/object/... } maybe_call_procvar(p,false); - if (p.resultdef.typ in [objectdef,recorddef,classrefdef]) then + if (p.resultdef.typ in [objectdef,recorddef,classrefdef]) or + ((p.resultdef.typ=undefineddef) and (df_generic in current_procinfo.procdef.defoptions)) then begin newblock:=nil; valuenode:=nil; @@ -660,21 +660,15 @@ implementation valuenode)); typecheckpass(refnode); end; - - { do we have a helper for this type? } - if p.resultdef.typ=classrefdef then - extendeddef:=tobjectdef(tclassrefdef(p.resultdef).pointeddef) - else - extendeddef:=tabstractrecorddef(p.resultdef); - search_last_objectpascal_helper(extendeddef,current_structdef,helperdef); { Note: the symtable of the helper is pushed after the following "case", the symtables of the helper's parents are passed in the "case" branches } - withsymtablelist:=TFPObjectList.create(true); case p.resultdef.typ of objectdef : begin + { do we have a helper for this type? } + search_last_objectpascal_helper(tabstractrecorddef(p.resultdef),current_structdef,helperdef); { push symtables of all parents in reverse order } pushobjchild(tobjectdef(p.resultdef),tobjectdef(p.resultdef).childof); { push symtables of all parents of the helper in reverse order } @@ -687,6 +681,8 @@ implementation end; classrefdef : begin + { do we have a helper for this type? } + search_last_objectpascal_helper(tobjectdef(tclassrefdef(p.resultdef).pointeddef),current_structdef,helperdef); { push symtables of all parents in reverse order } pushobjchild(tobjectdef(tclassrefdef(p.resultdef).pointeddef),tobjectdef(tclassrefdef(p.resultdef).pointeddef).childof); { push symtables of all parents of the helper in reverse order } @@ -699,6 +695,8 @@ implementation end; recorddef : begin + { do we have a helper for this type? } + search_last_objectpascal_helper(tabstractrecorddef(p.resultdef),current_structdef,helperdef); { push symtables of all parents of the helper in reverse order } if assigned(helperdef) then pushobjchild(helperdef,helperdef.childof); @@ -707,6 +705,16 @@ implementation symtablestack.push(st); withsymtablelist.add(st); end; + undefineddef : + begin + if not(df_generic in current_procinfo.procdef.defoptions) then + internalerror(2012122802); + helperdef:=nil; + { push record symtable } + st:=twithsymtable.create(p.resultdef,nil,refnode); + symtablestack.push(st); + withsymtablelist.add(st); + end; else internalerror(200601271); end; diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 69c3b2fdb8..deb907ce14 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -548,7 +548,7 @@ type staticvarsym,localvarsym,paravarsym,fieldvarsym, typesym,procsym,unitsym,constsym,enumsym, errorsym,syssym,labelsym,absolutevarsym,propertysym, - macrosym,namespacesym + macrosym,namespacesym,undefinedsym ); { State of the variable: @@ -662,7 +662,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has 'abstractsym','globalvar','localvar','paravar','fieldvar', 'type','proc','unit','const','enum', 'errorsym','system sym','label','absolutevar','property', - 'macrosym','namespace' + 'macrosym','namespace','undefinedsym' ); typName : array[tdeftyp] of string[12] = ( diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 06704adbbf..07802a955a 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -2292,7 +2292,8 @@ implementation exit; end; end - else + else if not((srsymtable.symtabletype=withsymtable) and assigned(srsymtable.defowner) and + (srsymtable.defowner.typ=undefineddef)) then begin srsym:=tsym(srsymtable.FindWithHash(hashedid)); if assigned(srsym) then diff --git a/tests/test/tgeneric92.pp b/tests/test/tgeneric92.pp new file mode 100644 index 0000000000..0ee58d2098 --- /dev/null +++ b/tests/test/tgeneric92.pp @@ -0,0 +1,24 @@ +{$mode objfpc} +type + TRec = record + i : longint; + end; + + generic TGeneric=class(TObject) + procedure Test(v : T); + end; + +procedure TGeneric.Test(v : T); + begin + with v do + begin + i:=1; + end; + end; + +type + TC = specialize TGeneric; + +begin +end. + diff --git a/tests/webtbs/tw21329.pp b/tests/webtbs/tw21329.pp new file mode 100644 index 0000000000..3e7bd96c56 --- /dev/null +++ b/tests/webtbs/tw21329.pp @@ -0,0 +1,29 @@ +{$MODE DELPHI} +{$DEFINE CAUSE_ERROR} + +type + TArray = array of T; + + TRecord = record end; + + TWrapper = class + strict private + {$IFDEF CAUSE_ERROR} + FRecords: TArray; + {$ELSE} + FRecords: array of TRecord; + {$ENDIF} + public + constructor Create; + end; + +constructor TWrapper.Create; +begin + SetLength(FRecords, 1); + with FRecords[0] do; + // FRecords[0].x:=1; +end; + +begin + TWrapper.Create.Free; +end.