View Issue Details

IDProjectCategoryView StatusLast Update
0035772FPCCompilerpublic2019-10-08 12:29
ReporterRyan JosephAssigned To 
PrioritynormalSeverityminorReproducibilityN/A
Status newResolutionopen 
Product Version3.3.1Product Build 
Target VersionFixed in Version 
Summary0035772: [PATCH] Default array property overloads
DescriptionPatch to allow overloading of default array properties.

1) All default properties must have the same name if within the same class (names can be different for subclasses). This is for backwards compatibility for classes that declare multiple defaults in different classes.
2) Currently to allow overloading you must declare the property as default. Maybe this should be for all array properties?
3) See tests for more examples.

type
  TValue = TObject;
  TList = record
    function GetValueWithInt(index: integer): TValue;
    function GetValueWithString(index: string): TValue;
    function GetValueWithPair(index: integer; key: string): TValue;
    property Values[index: integer]: TValue read GetValueWithInt; default;
    property Values[index: string]: TValue read GetValueWithString; default;
    property Values[index: integer; key: string]: TValue read GetValueWithPair; default;
  end;

{ ... }

var
  c: TList;
  v: TValue;
begin
  v := c[1];
  v := c['key'];
  v := c[1,'key'];

  v := c.values[1];
  v := c.values['a'];
  v := c.values[1, 'a'];
end.
Additional InformationFull source at: https://github.com/genericptr/freepascal/tree/array_prop_overload

When the code is reviewed and confirmed I'll make a better patch. Just putting it in to the pipeline for now.
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files
  • array_prop_overload_6_26.diff (43,589 bytes)
    From e22a88e922edc7f0970b3ff32d05c9f5971133b1 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Fri, 21 Jun 2019 09:32:36 -0400
    Subject: [PATCH 1/4] initial commit
    
    ---
     .gitignore               | 24 +++++++++++++
     compiler/ryan_ppcx64.lpi | 77 ++++++++++++++++++++++++++++++++++++++++
     2 files changed, 101 insertions(+)
     create mode 100644 .gitignore
     create mode 100644 compiler/ryan_ppcx64.lpi
    
    diff --git a/.gitignore b/.gitignore
    new file mode 100644
    index 0000000000..8b577f31db
    --- /dev/null
    +++ b/.gitignore
    @@ -0,0 +1,24 @@
    +# files
    +pp
    +fpmake
    +rtl/darwin/fpcmade.x86_64-darwin
    +fpmake_proc1 copy.inc
    +tests/*.x86_64-darwin
    +rtl/Package.fpc
    +tests/createlst
    +tests/gparmake
    +#compiler/ryan_ppcx64.lpi
    +
    +# directories
    +lazbuild/
    +x86_64-darwin/
    +tests/tstunits/
    +tests/utils
    +
    +# patterns
    +*.app
    +*.o
    +*.ppu
    +*.fpm
    +*.rsj
    +*.lst
    \ No newline at end of file
    diff --git a/compiler/ryan_ppcx64.lpi b/compiler/ryan_ppcx64.lpi
    new file mode 100644
    index 0000000000..68008e4ab3
    --- /dev/null
    +++ b/compiler/ryan_ppcx64.lpi
    @@ -0,0 +1,77 @@
    +<?xml version="1.0"?>
    +<CONFIG>
    +  <ProjectOptions>
    +    <Version Value="9"/>
    +    <PathDelim Value="\"/>
    +    <General>
    +      <Flags>
    +        <MainUnitHasUsesSectionForAllUnits Value="False"/>
    +        <MainUnitHasCreateFormStatements Value="False"/>
    +        <MainUnitHasTitleStatement Value="False"/>
    +        <LRSInOutputDirectory Value="False"/>
    +      </Flags>
    +      <SessionStorage Value="InProjectDir"/>
    +      <MainUnit Value="0"/>
    +      <Title Value="ppcx64"/>
    +    </General>
    +    <BuildModes Count="1">
    +      <Item1 Name="default" Default="True"/>
    +    </BuildModes>
    +    <PublishOptions>
    +      <Version Value="2"/>
    +      <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
    +      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
    +      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
    +    </PublishOptions>
    +    <RunParams>
    +      <local>
    +        <FormatVersion Value="1"/>
    +        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
    +      </local>
    +    </RunParams>
    +    <Units Count="2">
    +      <Unit0>
    +        <Filename Value="pp.pas"/>
    +        <IsPartOfProject Value="True"/>
    +        <UnitName Value="pp"/>
    +      </Unit0>
    +      <Unit1>
    +        <Filename Value="x86\aasmcpu.pas"/>
    +        <IsPartOfProject Value="True"/>
    +        <UnitName Value="aasmcpu"/>
    +      </Unit1>
    +    </Units>
    +  </ProjectOptions>
    +  <CompilerOptions>
    +    <Version Value="11"/>
    +    <PathDelim Value="\"/>
    +    <Target>
    +      <Filename Value="x86_64\pp"/>
    +    </Target>
    +    <SearchPaths>
    +      <IncludeFiles Value="x86_64"/>
    +      <OtherUnitFiles Value="x86_64;x86;systems"/>
    +      <UnitOutputDirectory Value="x86_64\lazbuild"/>
    +    </SearchPaths>
    +    <Parsing>
    +      <SyntaxOptions>
    +        <CStyleOperator Value="False"/>
    +        <AllowLabel Value="False"/>
    +        <CPPInline Value="False"/>
    +        <UseAnsiStrings Value="False"/>
    +      </SyntaxOptions>
    +    </Parsing>
    +    <Other>
    +      <Verbosity>
    +        <ShowWarn Value="False"/>
    +        <ShowNotes Value="False"/>
    +        <ShowHints Value="False"/>
    +      </Verbosity>
    +      <ConfigFile>
    +        <StopAfterErrCount Value="50"/>
    +      </ConfigFile>
    +      <CustomOptions Value="-dx86_64 -gw -godwarfcpp -Fl/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/lib"/>
    +      <CompilerPath Value="$(CompPath)"/>
    +    </Other>
    +  </CompilerOptions>
    +</CONFIG>
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 8b4092cc7e8e70e80cf65510deda7b51f1660beb Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Fri, 21 Jun 2019 13:32:20 -0400
    Subject: [PATCH 2/4] first draft
    
    ---
     compiler/pdecobj.pas  | 85 +++++++++++++++++++++++++++++++++++++++++--
     compiler/pdecvar.pas  | 23 ++++++++----
     compiler/pexpr.pas    | 26 +++++++++----
     compiler/symtable.pas | 76 ++++++++++++++++++++++++++++++--------
     4 files changed, 175 insertions(+), 35 deletions(-)
    
    diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
    index 64e948a106..01ffcff1a0 100644
    --- a/compiler/pdecobj.pas
    +++ b/compiler/pdecobj.pas
    @@ -163,8 +163,83 @@ implementation
     
     
         procedure struct_property_dec(is_classproperty:boolean);
    +      
    +      procedure check_invalid_default_property(pd: tabstractrecorddef; p: tpropertysym; name_filepos: tfileposinfo);
    +        var
    +          i: integer;
    +          sym: tsym;
    +          st,sc: tsymtable;
    +          paraindex: integer;
    +          from_para, to_para: tparavarsym;
    +          eq: integer;
    +        begin
    +          sc:=p.parast;
    +          for i := 0 to pd.symtable.SymList.Count-1 do
    +            begin
    +              sym:=tsym(pd.symtable.SymList[i]);
    +              if (sym.typ<>propertysym) or (sym=p) then
    +                continue;
    +
    +              { non-default parametered properties must not have the same name }
    +              if (ppo_hasparameters in tpropertysym(sym).propoptions) and
    +                 not (ppo_defaultproperty in tpropertysym(sym).propoptions) then 
    +                begin
    +                  MessagePos1(name_filepos,sym_e_duplicate_id,p.realname);
    +                  exit;
    +                end
    +              else if ppo_defaultproperty in tpropertysym(sym).propoptions then
    +                begin
    +                  { all default properties must share the same name }
    +                  if sym.realname<>p.realname then
    +                    begin
    +                      writeln('*** all default properties must share the same name');
    +                      message(parser_e_only_one_default_property);
    +                      exit;
    +                    end;
    +                  { default properties must have unique parameters }
    +                  st:=tpropertysym(sym).parast;
    +                  if st.symlist.count<>sc.SymList.count then
    +                    continue;
    +                  eq:=0;
    +                  for paraindex := 0 to sc.SymList.count-1 do
    +                    begin
    +                      from_para:=tparavarsym(st.SymList[paraindex]);
    +                      to_para:=tparavarsym(sc.SymList[paraindex]);
    +                      if compare_defs(from_para.vardef,to_para.vardef,nothingn)>=te_convert_l1 then
    +                        inc(eq);
    +                    end;
    +                  if eq=sc.SymList.count then
    +                    begin
    +                      writeln('*** default properties must have unique parameters');
    +                      message(parser_e_only_one_default_property);
    +                      exit;
    +                    end;
    +                end;   
    +            end;
    +        end;
    +      
    +      procedure check_duplicate_parametered_property(pd: tabstractrecorddef; p: tpropertysym; name_filepos: tfileposinfo);
    +        var
    +          i: integer;
    +          sym: tsym;
    +        begin
    +          for i := 0 to pd.symtable.SymList.Count-1 do
    +            begin
    +              sym:=tsym(pd.symtable.SymList[i]);
    +              if (sym<>p) and
    +                 (sym.typ=propertysym) and
    +                 (ppo_hasparameters in tpropertysym(sym).propoptions) and
    +                 (sym.realname=p.realname) then
    +                begin
    +                  MessagePos1(name_filepos,sym_e_duplicate_id,p.realname);
    +                  exit;
    +                end;
    +            end;
    +        end;
    +
           var
             p : tpropertysym;
    +        name_filepos: tfileposinfo;
           begin
             { check for a class, record or helper }
             if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef) or
    @@ -172,12 +247,11 @@ implementation
                    (not(m_tp7 in current_settings.modeswitches) and (is_object(current_structdef)))) then
               Message(parser_e_syntax_error);
             consume(_PROPERTY);
    -        p:=read_property_dec(is_classproperty,current_structdef);
    +        p:=read_property_dec(is_classproperty,current_structdef,@name_filepos);
             consume(_SEMICOLON);
             if try_to_consume(_DEFAULT) then
               begin
    -            if oo_has_default_property in current_structdef.objectoptions then
    -              message(parser_e_only_one_default_property);
    +            check_invalid_default_property(current_structdef,p,name_filepos);
                 include(current_structdef.objectoptions,oo_has_default_property);
                 include(p.propoptions,ppo_defaultproperty);
                 if not(ppo_hasparameters in p.propoptions) then
    @@ -188,7 +262,10 @@ implementation
                     consume_all_until(_SEMICOLON);
                   end;
                 consume(_SEMICOLON);
    -          end;
    +          end
    +        { properties with paramters that not default can't have duplicate names }
    +        else if (ppo_hasparameters in p.propoptions) then
    +          check_duplicate_parametered_property(current_structdef,p,name_filepos);
             { parse possible enumerator modifier }
             if try_to_consume(_ENUMERATOR) then
               begin
    diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas
    index 597249fd71..6ff2cbf5ef 100644
    --- a/compiler/pdecvar.pas
    +++ b/compiler/pdecvar.pas
    @@ -27,14 +27,14 @@ unit pdecvar;
     interface
     
         uses
    -      cclasses,
    +      globtype,cclasses,
           symtable,symsym,symdef,symtype;
     
         type
           tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class,vd_final,vd_canreorder,vd_check_generic);
           tvar_dec_options=set of tvar_dec_option;
     
    -    function  read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
    +    function  read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef;name_filepos:pfileposinfo=nil):tpropertysym;
     
         procedure read_var_decls(options:Tvar_dec_options;out had_generic:boolean);
     
    @@ -53,7 +53,7 @@ implementation
            { common }
            cutils,
            { global }
    -       globtype,globals,tokens,verbose,constexp,
    +       globals,tokens,verbose,constexp,
            systems,
            { symtable }
            symconst,symbase,defutil,defcmp,symutil,symcreat,
    @@ -71,7 +71,7 @@ implementation
            pbase,pexpr,ptype,ptconst,pdecsub,pparautl;
     
     
    -    function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
    +    function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef;name_filepos:pfileposinfo=nil):tpropertysym;
     
             { convert a node tree to symlist and return the last
               symbol }
    @@ -333,7 +333,7 @@ implementation
                       create_accessor_procsym(p,writepd,'put$',palt_write);
                     end;
                 end;
    -
    +            
           var
              sym : tsym;
              srsymtable: tsymtable;
    @@ -384,11 +384,18 @@ implementation
              p.default:=longint($80000000);
              if is_classproperty then
                include(p.symoptions, sp_static);
    -         symtablestack.top.insert(p);
              consume(_ID);
    +         if assigned(name_filepos) then
    +           name_filepos^:=current_filepos;
              { property parameters ? }
              if try_to_consume(_LECKKLAMMER) then
                begin
    +              { paramtered properties in structs can be default and
    +                potentially allow duplicate names for overloading }
    +              if assigned(astruct) then
    +                symtablestack.top.insert(p,false)
    +              else
    +                symtablestack.top.insert(p);
                   if (p.visibility=vis_published) and
                     not (m_delphi in current_settings.modeswitches) then
                     Message(parser_e_cant_publish_that_property);
    @@ -446,7 +453,9 @@ implementation
                       p.add_accessor_parameters(readprocdef,writeprocdef);
                       include(p.propoptions,ppo_hasparameters);
                     end;
    -           end;
    +           end
    +         else
    +           symtablestack.top.insert(p);
              { overridden property ?                                 }
              { force property interface
                  there is a property parameter
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index 022aa2a294..7ec3877ed7 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -1151,9 +1151,8 @@ implementation
     
     
         { the following procedure handles the access to a property symbol }
    -    procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;var p1 : tnode);
    +    procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;paras : tnode;var p1 : tnode);
           var
    -         paras : tnode;
              p2    : tnode;
              membercall : boolean;
              callflags  : tcallnodeflags;
    @@ -1162,8 +1161,7 @@ implementation
           begin
              { property parameters? read them only if the property really }
              { has parameters                                             }
    -         paras:=nil;
    -         if (ppo_hasparameters in propsym.propoptions) then
    +         if not assigned(paras) and (ppo_hasparameters in propsym.propoptions) then
                begin
                  if try_to_consume(_LECKKLAMMER) then
                    begin
    @@ -1410,7 +1408,7 @@ implementation
                        begin
                           if isclassref and not (sp_static in sym.symoptions) then
                             Message(parser_e_only_class_members_via_class_ref);
    -                      handle_propertysym(tpropertysym(sym),sym.owner,p1);
    +                      handle_propertysym(tpropertysym(sym),sym.owner,nil,p1);
                        end;
                      typesym:
                        begin
    @@ -2019,6 +2017,7 @@ implementation
          strdef : tdef;
          spezcontext : tspecializationcontext;
          old_current_filepos : tfileposinfo;
    +     paras : tnode;
         label
          skipreckklammercheck,
          skippointdefcheck;
    @@ -2095,7 +2094,18 @@ implementation
                       is_javaclass(p1.resultdef) then
                      begin
                        { default property }
    -                   protsym:=search_default_property(tabstractrecorddef(p1.resultdef));
    +                   paras:=nil;
    +                   if oo_has_default_property in tabstractrecorddef(p1.resultdef).objectoptions then
    +                     begin
    +                       if try_to_consume(_LECKKLAMMER) then
    +                         begin
    +                           paras:=parse_paras(false,false,_RECKKLAMMER);
    +                           consume(_RECKKLAMMER);
    +                           protsym:=search_default_property(tabstractrecorddef(p1.resultdef),paras);
    +                         end;
    +                     end
    +                   else
    +                     protsym:=search_default_property(tabstractrecorddef(p1.resultdef),nil);
                        if not(assigned(protsym)) then
                          begin
                             p1.destroy;
    @@ -2107,7 +2117,7 @@ implementation
                          begin
                            { The property symbol is referenced indirect }
                            protsym.IncRefCount;
    -                       handle_propertysym(protsym,protsym.owner,p1);
    +                       handle_propertysym(protsym,protsym.owner,paras,p1);
                          end;
                      end
                    else
    @@ -3277,7 +3287,7 @@ implementation
                         else
                         { no method pointer }
                           begin
    -                        handle_propertysym(tpropertysym(srsym),srsymtable,p1);
    +                        handle_propertysym(tpropertysym(srsym),srsymtable,nil,p1);
                           end;
                       end;
     
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 305d39904a..376ea60a7c 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -73,7 +73,6 @@ interface
               procedure checklabels;
               function  needs_init_final : boolean; virtual;
               function  has_non_trivial_init:boolean;virtual;
    -          procedure testfordefaultproperty(sym:TObject;arg:pointer);
               procedure register_children;
            end;
     
    @@ -387,7 +386,7 @@ interface
         function get_objectpascal_helpers(pd : tdef):TFPObjectList;
     
     {*** Object Helpers ***}
    -    function search_default_property(pd : tabstractrecorddef) : tpropertysym;
    +    function search_default_property(pd : tabstractrecorddef; paras: pointer) : tpropertysym;
         function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef;
         function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
     
    @@ -485,7 +484,9 @@ implementation
           { ppu }
           entfile,
           { parser }
    -      scanner
    +      scanner,
    +      { node }
    +      node,ncal
           ;
     
     
    @@ -1045,15 +1046,6 @@ implementation
                tabstractrecorddef(ttypesym(sym).typedef).symtable.SymList.ForEachCall(@TestPrivate,nil);
           end;
     
    -
    -   procedure tstoredsymtable.testfordefaultproperty(sym:TObject;arg:pointer);
    -     begin
    -        if (tsym(sym).typ=propertysym) and
    -           (ppo_defaultproperty in tpropertysym(sym).propoptions) then
    -          ppointer(arg)^:=sym;
    -     end;
    -
    -
        procedure tstoredsymtable.register_children;
          begin
            SymList.ForEachCall(@register_syms,nil);
    @@ -4496,8 +4488,60 @@ implementation
                                   Object Helpers
     ****************************************************************************}
     
    -   function search_default_property(pd : tabstractrecorddef) : tpropertysym;
    -   { returns the default property of a class, searches also anchestors }
    +   function search_default_property(pd : tabstractrecorddef; paras: pointer) : tpropertysym;
    +     
    +     function find_best_property(pd: tabstractrecorddef; paras: tcallparanode): tpropertysym;
    +       var
    +         i: integer;
    +         sym: tsym;
    +         st: tsymtable;
    +         pt: tcallparanode;
    +         paraindex, paracount: integer;
    +         parasym: tparavarsym;
    +         eq: integer;
    +       begin 
    +         result:=nil;
    +         pt:=tcallparanode(paras);
    +         paracount:=0;
    +         while assigned(pt) do
    +           begin
    +             pt:=tcallparanode(pt.nextpara);
    +             paracount:=paracount+1;
    +           end;
    +         for i := 0 to pd.symtable.SymList.Count-1 do
    +           begin
    +             sym:=tsym(pd.symtable.SymList[i]);
    +             if (sym.typ=propertysym) and
    +                (ppo_defaultproperty in tpropertysym(sym).propoptions) then
    +               begin
    +                 st:=tpropertysym(sym).parast;
    +                 { parameter count must match }
    +                 if st.symlist.count<>paracount then
    +                   continue;
    +                 pt:=tcallparanode(paras);
    +                 paraindex:=0;
    +                 eq:=0;
    +                 while assigned(pt) do
    +                   begin
    +                     { paranodes are in reverse order so we need to access
    +                       the symtable list from back to front }
    +                     parasym:=tparavarsym(st.symlist[(st.symlist.count-1)-paraindex]);
    +                     if compare_defs(pt.paravalue.resultdef,parasym.vardef,nothingn)>=te_convert_l1 then
    +                       inc(eq);
    +                     { next parameter in the call tree }
    +                     pt:=tcallparanode(pt.nextpara);
    +                     paraindex:=paraindex+1;
    +                   end;
    +                 if eq=paracount then
    +                   begin
    +                     result:=tpropertysym(sym);
    +                     exit;
    +                   end;
    +               end;
    +           end;
    +       end;
    +
    +     { returns the default property of a class, searches also anchestors }
          var
            _defaultprop : tpropertysym;
            helperpd : tobjectdef;
    @@ -4507,7 +4551,7 @@ implementation
             if search_last_objectpascal_helper(pd,nil,helperpd) then
               while assigned(helperpd) do
                 begin
    -              helperpd.symtable.SymList.ForEachCall(@tstoredsymtable(helperpd.symtable).testfordefaultproperty,@_defaultprop);
    +              _defaultprop:=find_best_property(pd,tcallparanode(paras));
                   if assigned(_defaultprop) then
                     break;
                   helperpd:=helperpd.childof;
    @@ -4520,7 +4564,7 @@ implementation
             { now search in the type's hierarchy itself }
             while assigned(pd) do
               begin
    -             pd.symtable.SymList.ForEachCall(@tstoredsymtable(pd.symtable).testfordefaultproperty,@_defaultprop);
    +             _defaultprop:=find_best_property(pd,tcallparanode(paras));
                  if assigned(_defaultprop) then
                    break;
                  if (pd.typ=objectdef) then
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 2db6bbdbcfdf5472ad8179d2c0ed299f6f1fab4b Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Sun, 23 Jun 2019 10:46:27 -0400
    Subject: [PATCH 3/4] default properties can be overloaded by name + added
     tests
    
    ---
     compiler/pexpr.pas        | 16 ++++++++++++++-
     tests/test/tarrpropol1.pp | 43 +++++++++++++++++++++++++++++++++++++++
     tests/test/tarrpropol2.pp | 28 +++++++++++++++++++++++++
     tests/test/tarrpropol3.pp | 22 ++++++++++++++++++++
     tests/test/tarrpropol4.pp | 29 ++++++++++++++++++++++++++
     tests/test/tarrpropol5.pp | 23 +++++++++++++++++++++
     6 files changed, 160 insertions(+), 1 deletion(-)
     create mode 100644 tests/test/tarrpropol1.pp
     create mode 100644 tests/test/tarrpropol2.pp
     create mode 100644 tests/test/tarrpropol3.pp
     create mode 100644 tests/test/tarrpropol4.pp
     create mode 100644 tests/test/tarrpropol5.pp
    
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index 7ec3877ed7..a3566a56d3 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -1282,6 +1282,7 @@ implementation
             isclassref:boolean;
             isrecordtype:boolean;
             isobjecttype:boolean;
    +        paras:tnode;
           begin
              if sym=nil then
                begin
    @@ -1408,7 +1409,19 @@ implementation
                        begin
                           if isclassref and not (sp_static in sym.symoptions) then
                             Message(parser_e_only_class_members_via_class_ref);
    -                      handle_propertysym(tpropertysym(sym),sym.owner,nil,p1);
    +                      if ppo_hasparameters in tpropertysym(sym).propoptions then
    +                        begin
    +                          consume(_LECKKLAMMER);
    +                          paras:=parse_paras(false,false,_RECKKLAMMER);
    +                          consume(_RECKKLAMMER);
    +                          sym:=search_default_property(tabstractrecorddef(p1.resultdef),paras);
    +                          if assigned(sym) then
    +                            handle_propertysym(tpropertysym(sym),sym.owner,paras,p1)
    +                          else
    +                            internalerror(2019062301);
    +                        end
    +                      else
    +                        handle_propertysym(tpropertysym(sym),sym.owner,nil,p1);
                        end;
                      typesym:
                        begin
    @@ -2095,6 +2108,7 @@ implementation
                      begin
                        { default property }
                        paras:=nil;
    +                   protsym:=nil;
                        if oo_has_default_property in tabstractrecorddef(p1.resultdef).objectoptions then
                          begin
                            if try_to_consume(_LECKKLAMMER) then
    diff --git a/tests/test/tarrpropol1.pp b/tests/test/tarrpropol1.pp
    new file mode 100644
    index 0000000000..9e8d6dc78d
    --- /dev/null
    +++ b/tests/test/tarrpropol1.pp
    @@ -0,0 +1,43 @@
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +
    +program tarrpropol1;
    +
    +type
    +  TValue = TObject;
    +  TList = record
    +    function GetValueWithInt(index: integer): TValue;
    +    function GetValueWithString(index: string): TValue;
    +    function GetValueWithPair(index: integer; key: string): TValue;
    +    property Values[index: integer]: TValue read GetValueWithInt; default;
    +    property Values[index: string]: TValue read GetValueWithString; default;
    +    property Values[index: integer; key: string]: TValue read GetValueWithPair; default;
    +  end;
    +
    +function TList.GetValueWithInt(index: integer): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +function TList.GetValueWithString(index: string): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +function TList.GetValueWithPair(index: integer; key: string): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +var
    +  c: TList;
    +  v: TValue;
    +begin
    +  v := c[1];
    +  v := c['key'];
    +  v := c[1,'key'];
    +
    +  v := c.values[1];
    +  v := c.values['a'];
    +  v := c.values[1, 'a'];
    +end.
    diff --git a/tests/test/tarrpropol2.pp b/tests/test/tarrpropol2.pp
    new file mode 100644
    index 0000000000..029704e2ef
    --- /dev/null
    +++ b/tests/test/tarrpropol2.pp
    @@ -0,0 +1,28 @@
    +{%FAIL}
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +
    +program tarrpropol2;
    +
    +type
    +  TValue = TObject;
    +  TList = record
    +    function GetValueWithInt(index: integer): TValue;
    +    function GetValueWithString(index: string): TValue;
    +    { all default properties must share the same name }
    +    property Values0[index: integer]: TValue read GetValueWithInt; default;
    +    property Values1[index: string]: TValue read GetValueWithString; default;
    +  end;
    +
    +function TList.GetValueWithInt(index: integer): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +function TList.GetValueWithString(index: string): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +begin
    +end.
    diff --git a/tests/test/tarrpropol3.pp b/tests/test/tarrpropol3.pp
    new file mode 100644
    index 0000000000..55bd0cf269
    --- /dev/null
    +++ b/tests/test/tarrpropol3.pp
    @@ -0,0 +1,22 @@
    +{%FAIL}
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +
    +program tarrpropol3;
    +
    +type
    +  TValue = TObject;
    +  TList = record
    +    function GetValueWithInt(index: integer): TValue;
    +    { default properties must have unique parameters }
    +    property Values[index: integer]: TValue read GetValueWithInt; default;
    +    property Values[index: integer]: TValue read GetValueWithInt; default;
    +  end;
    +
    +function TList.GetValueWithInt(index: integer): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +begin
    +end.
    diff --git a/tests/test/tarrpropol4.pp b/tests/test/tarrpropol4.pp
    new file mode 100644
    index 0000000000..fa6547852d
    --- /dev/null
    +++ b/tests/test/tarrpropol4.pp
    @@ -0,0 +1,29 @@
    +{%FAIL}
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +
    +program tarrpropol4;
    +
    +type
    +  TValue = TObject;
    +  TList = record
    +    function GetValueWithInt(index: integer): TValue;
    +    function GetValueWithString(index: string): TValue;
    +    { parametered properties still can't have duplicate names
    +      to fix error make properties default }
    +    property Values[index: integer]: TValue read GetValueWithInt;  
    +    property Values[index: string]: TValue read GetValueWithString;
    +  end;
    +
    +function TList.GetValueWithInt(index: integer): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +function TList.GetValueWithString(index: string): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +begin
    +end.
    diff --git a/tests/test/tarrpropol5.pp b/tests/test/tarrpropol5.pp
    new file mode 100644
    index 0000000000..a73f2c6c82
    --- /dev/null
    +++ b/tests/test/tarrpropol5.pp
    @@ -0,0 +1,23 @@
    +{%FAIL}
    +{$mode objfpc}
    +
    +program tarrpropol5;
    +
    +type
    +  TValue = TObject;
    +
    +function GetGlobalValueInt(index: integer): TValue;
    +begin
    +  result:=nil;
    +end;
    +
    +function GetGlobalValueStr(index: string): TValue;
    +begin
    +  result:=nil;
    +end;
    +
    +property Values[index: integer]: TValue read GetGlobalValueInt;
    +property Values[index: string]: TValue read GetGlobalValueStr;
    +
    +begin
    +end.
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 297cda638404e835c3b092b3fd96aded41cc7d6c Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Wed, 26 Jun 2019 13:51:49 -0400
    Subject: [PATCH 4/4] Fixed bugs with unit tests regressions
    
    ---
     compiler/pdecobj.pas      | 84 +++++++++++++++++++++------------------
     compiler/pexpr.pas        | 37 ++++++++++++-----
     compiler/symtable.pas     | 20 ++++++----
     tests/test/tarrpropol5.pp |  1 +
     tests/test/tarrpropol6.pp | 28 +++++++++++++
     tests/test/tarrpropol7.pp | 65 ++++++++++++++++++++++++++++++
     6 files changed, 178 insertions(+), 57 deletions(-)
     create mode 100644 tests/test/tarrpropol6.pp
     create mode 100644 tests/test/tarrpropol7.pp
    
    diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
    index 01ffcff1a0..458a59ad72 100644
    --- a/compiler/pdecobj.pas
    +++ b/compiler/pdecobj.pas
    @@ -174,47 +174,54 @@ implementation
               eq: integer;
             begin
               sc:=p.parast;
    -          for i := 0 to pd.symtable.SymList.Count-1 do
    +          while assigned(pd) do
                 begin
    -              sym:=tsym(pd.symtable.SymList[i]);
    -              if (sym.typ<>propertysym) or (sym=p) then
    -                continue;
    -
    -              { non-default parametered properties must not have the same name }
    -              if (ppo_hasparameters in tpropertysym(sym).propoptions) and
    -                 not (ppo_defaultproperty in tpropertysym(sym).propoptions) then 
    +              for i:=0 to pd.symtable.SymList.Count-1 do
                     begin
    -                  MessagePos1(name_filepos,sym_e_duplicate_id,p.realname);
    -                  exit;
    -                end
    -              else if ppo_defaultproperty in tpropertysym(sym).propoptions then
    -                begin
    -                  { all default properties must share the same name }
    -                  if sym.realname<>p.realname then
    -                    begin
    -                      writeln('*** all default properties must share the same name');
    -                      message(parser_e_only_one_default_property);
    -                      exit;
    -                    end;
    -                  { default properties must have unique parameters }
    -                  st:=tpropertysym(sym).parast;
    -                  if st.symlist.count<>sc.SymList.count then
    +                  sym:=tsym(pd.symtable.SymList[i]);
    +                  { ignore non-properties, the same property or properties in different object }
    +                  if (sym.typ<>propertysym) or (sym=p) or (p.owner<>sym.owner) then
                         continue;
    -                  eq:=0;
    -                  for paraindex := 0 to sc.SymList.count-1 do
    -                    begin
    -                      from_para:=tparavarsym(st.SymList[paraindex]);
    -                      to_para:=tparavarsym(sc.SymList[paraindex]);
    -                      if compare_defs(from_para.vardef,to_para.vardef,nothingn)>=te_convert_l1 then
    -                        inc(eq);
    -                    end;
    -                  if eq=sc.SymList.count then
    +
    +                  { non-default parametered properties must not have the same name }
    +                  if (ppo_hasparameters in tpropertysym(sym).propoptions) and
    +                     not (ppo_defaultproperty in tpropertysym(sym).propoptions) and
    +                     (p.name=sym.name) then 
                         begin
    -                      writeln('*** default properties must have unique parameters');
    -                      message(parser_e_only_one_default_property);
    +                      MessagePos1(name_filepos,sym_e_duplicate_id,p.realname);
                           exit;
    -                    end;
    -                end;   
    +                    end
    +                  else if ppo_defaultproperty in tpropertysym(sym).propoptions then
    +                    begin
    +                      { all default properties must share the same name }
    +                      if sym.name<>p.name then
    +                        begin
    +                          message(parser_e_only_one_default_property);
    +                          exit;
    +                        end;
    +                      { default properties must have unique parameters }
    +                      st:=tpropertysym(sym).parast;
    +                      if st.symlist.count<>sc.SymList.count then
    +                        continue;
    +                      eq:=0;
    +                      for paraindex := 0 to sc.SymList.count-1 do
    +                        begin
    +                          from_para:=tparavarsym(st.SymList[paraindex]);
    +                          to_para:=tparavarsym(sc.SymList[paraindex]);
    +                          if compare_defs(from_para.vardef,to_para.vardef,nothingn)>=te_convert_l3 then
    +                            inc(eq);
    +                        end;
    +                      if eq=sc.SymList.count then
    +                        begin
    +                          message(parser_e_only_one_default_property);
    +                          exit;
    +                        end;
    +                    end;   
    +                end;
    +              if pd.typ=objectdef then
    +                pd:=tobjectdef(pd).childof
    +              else
    +                pd:=nil;
                 end;
             end;
           
    @@ -223,7 +230,7 @@ implementation
               i: integer;
               sym: tsym;
             begin
    -          for i := 0 to pd.symtable.SymList.Count-1 do
    +          for i:=0 to pd.symtable.SymList.Count-1 do
                 begin
                   sym:=tsym(pd.symtable.SymList[i]);
                   if (sym<>p) and
    @@ -263,7 +270,8 @@ implementation
                   end;
                 consume(_SEMICOLON);
               end
    -        { properties with paramters that not default can't have duplicate names }
    +        { properties with paramters that are not default can't have duplicate names
    +          we need to check again here because }
             else if (ppo_hasparameters in p.propoptions) then
               check_duplicate_parametered_property(current_structdef,p,name_filepos);
             { parse possible enumerator modifier }
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index a3566a56d3..a87a17fb34 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -1283,6 +1283,7 @@ implementation
             isrecordtype:boolean;
             isobjecttype:boolean;
             paras:tnode;
    +        bestsym:tsym;
           begin
              if sym=nil then
                begin
    @@ -1409,16 +1410,16 @@ implementation
                        begin
                           if isclassref and not (sp_static in sym.symoptions) then
                             Message(parser_e_only_class_members_via_class_ref);
    -                      if ppo_hasparameters in tpropertysym(sym).propoptions then
    +                      if ppo_defaultproperty in tpropertysym(sym).propoptions then
                             begin
                               consume(_LECKKLAMMER);
                               paras:=parse_paras(false,false,_RECKKLAMMER);
                               consume(_RECKKLAMMER);
    -                          sym:=search_default_property(tabstractrecorddef(p1.resultdef),paras);
    -                          if assigned(sym) then
    -                            handle_propertysym(tpropertysym(sym),sym.owner,paras,p1)
    +                          bestsym:=search_default_property(structh,paras,sym.name);
    +                          if assigned(bestsym) then
    +                            handle_propertysym(tpropertysym(bestsym),bestsym.owner,paras,p1)
                               else
    -                            internalerror(2019062301);
    +                            handle_propertysym(tpropertysym(sym),sym.owner,paras,p1);
                             end
                           else
                             handle_propertysym(tpropertysym(sym),sym.owner,nil,p1);
    @@ -2031,6 +2032,7 @@ implementation
          spezcontext : tspecializationcontext;
          old_current_filepos : tfileposinfo;
          paras : tnode;
    +     has_default_property: boolean;
         label
          skipreckklammercheck,
          skippointdefcheck;
    @@ -2109,17 +2111,30 @@ implementation
                        { default property }
                        paras:=nil;
                        protsym:=nil;
    -                   if oo_has_default_property in tabstractrecorddef(p1.resultdef).objectoptions then
    +                   { search hierarchy for default properties }
    +                   has_default_property:=false;
    +                   structh:=tabstractrecorddef(p1.resultdef);
    +                   while assigned(structh) do
                          begin
    -                       if try_to_consume(_LECKKLAMMER) then
    +                       if oo_has_default_property in structh.objectoptions then
                              begin
    -                           paras:=parse_paras(false,false,_RECKKLAMMER);
    -                           consume(_RECKKLAMMER);
    -                           protsym:=search_default_property(tabstractrecorddef(p1.resultdef),paras);
    +                           has_default_property:=true;
    +                           break;
                              end;
    +                       if structh.typ=objectdef then
    +                         structh:=tobjectdef(structh).childof
    +                       else
    +                         structh:=nil;
    +                     end;
    +                   if has_default_property then
    +                     begin
    +                       consume(_LECKKLAMMER);
    +                       paras:=parse_paras(false,false,_RECKKLAMMER);
    +                       consume(_RECKKLAMMER);
    +                       protsym:=search_default_property(tabstractrecorddef(p1.resultdef),paras);
                          end
                        else
    -                     protsym:=search_default_property(tabstractrecorddef(p1.resultdef),nil);
    +                     protsym:=search_default_property(tabstractrecorddef(p1.resultdef));
                        if not(assigned(protsym)) then
                          begin
                             p1.destroy;
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 376ea60a7c..628def918c 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -386,7 +386,7 @@ interface
         function get_objectpascal_helpers(pd : tdef):TFPObjectList;
     
     {*** Object Helpers ***}
    -    function search_default_property(pd : tabstractrecorddef; paras: pointer) : tpropertysym;
    +    function search_default_property(pd : tabstractrecorddef; paras: pointer=nil; name: shortstring='') : tpropertysym;
         function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef;
         function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
     
    @@ -4488,9 +4488,9 @@ implementation
                                   Object Helpers
     ****************************************************************************}
     
    -   function search_default_property(pd : tabstractrecorddef; paras: pointer) : tpropertysym;
    +   function search_default_property(pd : tabstractrecorddef; paras: pointer=nil; name: shortstring='') : tpropertysym;
          
    -     function find_best_property(pd: tabstractrecorddef; paras: tcallparanode): tpropertysym;
    +     function find_best_property(pd:tabstractrecorddef; paras:tcallparanode; name:shortstring): tpropertysym;
            var
              i: integer;
              sym: tsym;
    @@ -4506,11 +4506,15 @@ implementation
              while assigned(pt) do
                begin
                  pt:=tcallparanode(pt.nextpara);
    -             paracount:=paracount+1;
    +             inc(paracount);
                end;
    -         for i := 0 to pd.symtable.SymList.Count-1 do
    +         for i:=0 to pd.symtable.SymList.Count-1 do
                begin
                  sym:=tsym(pd.symtable.SymList[i]);
    +             { rejected symbol for named searches }
    +             if (name<>'') and (sym.name<>name) then
    +               continue;
    +             { filter default properties }
                  if (sym.typ=propertysym) and
                     (ppo_defaultproperty in tpropertysym(sym).propoptions) then
                    begin
    @@ -4526,7 +4530,7 @@ implementation
                          { paranodes are in reverse order so we need to access
                            the symtable list from back to front }
                          parasym:=tparavarsym(st.symlist[(st.symlist.count-1)-paraindex]);
    -                     if compare_defs(pt.paravalue.resultdef,parasym.vardef,nothingn)>=te_convert_l1 then
    +                     if compare_defs(pt.paravalue.resultdef,parasym.vardef,nothingn)>=te_convert_l5 then
                            inc(eq);
                          { next parameter in the call tree }
                          pt:=tcallparanode(pt.nextpara);
    @@ -4551,7 +4555,7 @@ implementation
             if search_last_objectpascal_helper(pd,nil,helperpd) then
               while assigned(helperpd) do
                 begin
    -              _defaultprop:=find_best_property(pd,tcallparanode(paras));
    +              _defaultprop:=find_best_property(helperpd,tcallparanode(paras),name);
                   if assigned(_defaultprop) then
                     break;
                   helperpd:=helperpd.childof;
    @@ -4564,7 +4568,7 @@ implementation
             { now search in the type's hierarchy itself }
             while assigned(pd) do
               begin
    -             _defaultprop:=find_best_property(pd,tcallparanode(paras));
    +             _defaultprop:=find_best_property(pd,tcallparanode(paras),name);
                  if assigned(_defaultprop) then
                    break;
                  if (pd.typ=objectdef) then
    diff --git a/tests/test/tarrpropol5.pp b/tests/test/tarrpropol5.pp
    index a73f2c6c82..8fe81176dc 100644
    --- a/tests/test/tarrpropol5.pp
    +++ b/tests/test/tarrpropol5.pp
    @@ -16,6 +16,7 @@ begin
       result:=nil;
     end;
     
    +{ make sure global properties aren't affect by changes }
     property Values[index: integer]: TValue read GetGlobalValueInt;
     property Values[index: string]: TValue read GetGlobalValueStr;
     
    diff --git a/tests/test/tarrpropol6.pp b/tests/test/tarrpropol6.pp
    new file mode 100644
    index 0000000000..5f220c0a65
    --- /dev/null
    +++ b/tests/test/tarrpropol6.pp
    @@ -0,0 +1,28 @@
    +{%FAIL}
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +
    +program tarrpropol6;
    +
    +type
    +  TValue = TObject;
    +  TList = record
    +    function GetValueWithInt(index: integer): TValue;
    +    function GetValueWithWord(index: word): TValue;
    +    { default properties must have unique parameters }
    +    property Values[index: integer]: TValue read GetValueWithInt; default;
    +    property Values[index: word]: TValue read GetValueWithWord; default;
    +  end;
    +
    +function TList.GetValueWithInt(index: integer): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +function TList.GetValueWithWord(index: word): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +begin
    +end.
    diff --git a/tests/test/tarrpropol7.pp b/tests/test/tarrpropol7.pp
    new file mode 100644
    index 0000000000..dc87035dc9
    --- /dev/null
    +++ b/tests/test/tarrpropol7.pp
    @@ -0,0 +1,65 @@
    +{$mode objfpc}
    +
    +
    +program tarrpropol7;
    +
    +var
    +  LastProc: integer = 0;
    +
    +type
    +  TValue = TObject;
    +  TBase = class
    +    function GetValue(index: integer): TValue;
    +    property Values[index: integer]: TValue read GetValue; default;
    +  end;
    +  
    +  function TBase.GetValue(index: integer): TValue;
    +  begin
    +    LastProc := 1;
    +    result := nil;  
    +  end;
    +
    +type
    +  TList = class(TBase)
    +    function GetAnotherValue(index: integer): TValue;
    +    function GetAnotherValue(index: string): TValue;
    +    { you can declare another default property of a different name
    +      if it's in a child object }
    +    property MoreValues[index: integer]: TValue read GetAnotherValue; default;
    +    property MoreValues[index: string]: TValue read GetAnotherValue; default;
    +  end;
    +
    +  function TList.GetAnotherValue(index: integer): TValue;
    +  begin
    +    LastProc := 2;
    +    result := nil;  
    +  end;
    +
    +  function TList.GetAnotherValue(index: string): TValue;
    +  begin
    +    LastProc := 3;
    +    result := nil;  
    +  end;
    +
    +procedure Test(value: TValue; desired: integer);
    +begin
    +  if LastProc <> desired then
    +    begin
    +      writeln('FAILED');
    +      Halt(-1);
    +    end;
    +end;
    +
    +var
    +  c: TList;
    +  v: TValue;
    +begin
    +  { normal defaults }
    +  Test(c[1], 2);
    +  Test(c['key'], 3);
    +
    +  { named default access }
    +  Test(c.Values[1], 1);
    +  Test(c.MoreValues[1], 2);
    +  Test(c.MoreValues['key'], 3);
    +end.
    -- 
    2.17.2 (Apple Git-113)
    
    
  • patch_6_28.diff (29,318 bytes)
    From c7f8cd7cdb7d8221f21345fb57b42ba3c13d5b84 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Fri, 21 Jun 2019 09:32:36 -0400
    Subject: [PATCH] array property overloads
    
    ---
     compiler/pdecobj.pas      |  92 ++++++++++++++++++++++++++++++++--
     compiler/pdecvar.pas      |  23 ++++++---
     compiler/pexpr.pas        |  36 ++++++++++---
     compiler/symtable.pas     | 103 +++++++++++++++++++++++++++++---------
     tests/test/tarrpropol1.pp | 103 ++++++++++++++++++++++++++++++++++++++
     tests/test/tarrpropol2.pp |  28 +++++++++++
     tests/test/tarrpropol3.pp |  22 ++++++++
     tests/test/tarrpropol4.pp |  24 +++++++++
     tests/test/tarrpropol5.pp |  28 +++++++++++
     tests/test/tarrpropol6.pp |  50 ++++++++++++++++++
     tests/test/tarrpropol7.pp |  64 +++++++++++++++++++++++
     tests/test/tarrpropol8.pp |  28 +++++++++++
     12 files changed, 559 insertions(+), 42 deletions(-)
     create mode 100644 tests/test/tarrpropol1.pp
     create mode 100644 tests/test/tarrpropol2.pp
     create mode 100644 tests/test/tarrpropol3.pp
     create mode 100644 tests/test/tarrpropol4.pp
     create mode 100644 tests/test/tarrpropol5.pp
     create mode 100644 tests/test/tarrpropol6.pp
     create mode 100644 tests/test/tarrpropol7.pp
     create mode 100644 tests/test/tarrpropol8.pp
    
    diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
    index 64e948a106..3d17971bcd 100644
    --- a/compiler/pdecobj.pas
    +++ b/compiler/pdecobj.pas
    @@ -163,8 +163,90 @@ implementation
     
     
         procedure struct_property_dec(is_classproperty:boolean);
    +       
    +      function compare_paras(sym: tpropertysym;parasymtable: tsymtable): boolean;
    +        var
    +          st: tsymtable;
    +          paraindex: integer;
    +          from_para, to_para: tparavarsym;
    +          eq: integer;
    +        begin
    +          st:=tpropertysym(sym).parast;
    +          if st.symlist.count<>parasymtable.SymList.count then
    +            exit(false);
    +          eq:=0;
    +          for paraindex := 0 to parasymtable.SymList.count-1 do
    +            begin
    +              from_para:=tparavarsym(st.SymList[paraindex]);
    +              to_para:=tparavarsym(parasymtable.SymList[paraindex]);
    +              if compare_defs(from_para.vardef,to_para.vardef,nothingn)>=te_convert_l5 then
    +                inc(eq);
    +            end;
    +          result:=(eq=parasymtable.SymList.count);
    +        end;
    +
    +      procedure check_parametered_property(pd: tabstractrecorddef; p: tpropertysym; name_filepos: tfileposinfo);
    +        var
    +          i: integer;
    +          sym: tsym;
    +          st,sc: tsymtable;
    +          paraindex: integer;
    +          from_para, to_para: tparavarsym;
    +          eq: integer;
    +        begin
    +          sc:=p.parast;
    +          while assigned(pd) do
    +            begin
    +              for i:=0 to pd.symtable.SymList.Count-1 do
    +                begin
    +                  sym:=tsym(pd.symtable.SymList[i]);
    +                  { ignore non-properties, the same property or properties in different object }
    +                  if (sym.typ<>propertysym) or (sym=p) or (p.owner<>sym.owner) then
    +                    continue;
    +                  { default properties must have unique parameters }
    +                  if (ppo_defaultproperty in p.propoptions) and (ppo_defaultproperty in tpropertysym(sym).propoptions) then
    +                    begin
    +                      { all default properties must share the same name }
    +                      if sym.name<>p.name then
    +                        begin
    +                          message(parser_e_only_one_default_property);
    +                          exit;
    +                        end;
    +                      if compare_paras(tpropertysym(sym),sc) then
    +                        begin
    +                          // TODO: overloaded property parameters must be unique
    +                          message(parser_e_only_one_default_property);
    +                          exit;
    +                        end
    +                      else
    +                        continue;
    +                    end
    +                  { non-default parametered properties that have the same name
    +                    must have unique parameters }
    +                  else if not(ppo_defaultproperty in p.propoptions) and 
    +                             (ppo_hasparameters in tpropertysym(sym).propoptions) and
    +                             (sym.name=p.name) then
    +                    begin
    +                      if compare_paras(tpropertysym(sym),sc) then
    +                        begin
    +                          // TODO: property parametesr must be unique
    +                          message(parser_e_only_one_default_property);
    +                          exit;
    +                        end
    +                      else
    +                        continue;
    +                    end;
    +                end;
    +              if pd.typ=objectdef then
    +                pd:=tobjectdef(pd).childof
    +              else
    +                pd:=nil;
    +            end;
    +        end;
    +
           var
             p : tpropertysym;
    +        name_filepos: tfileposinfo;
           begin
             { check for a class, record or helper }
             if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef) or
    @@ -172,14 +254,13 @@ implementation
                    (not(m_tp7 in current_settings.modeswitches) and (is_object(current_structdef)))) then
               Message(parser_e_syntax_error);
             consume(_PROPERTY);
    -        p:=read_property_dec(is_classproperty,current_structdef);
    +        p:=read_property_dec(is_classproperty,current_structdef,@name_filepos);
             consume(_SEMICOLON);
             if try_to_consume(_DEFAULT) then
               begin
    -            if oo_has_default_property in current_structdef.objectoptions then
    -              message(parser_e_only_one_default_property);
                 include(current_structdef.objectoptions,oo_has_default_property);
                 include(p.propoptions,ppo_defaultproperty);
    +            check_parametered_property(current_structdef,p,name_filepos);
                 if not(ppo_hasparameters in p.propoptions) then
                   message(parser_e_property_need_paras);
                 if (token=_COLON) then
    @@ -188,7 +269,10 @@ implementation
                     consume_all_until(_SEMICOLON);
                   end;
                 consume(_SEMICOLON);
    -          end;
    +          end
    +        else if (ppo_hasparameters in p.propoptions) then
    +          check_parametered_property(current_structdef,p,name_filepos);
    +
             { parse possible enumerator modifier }
             if try_to_consume(_ENUMERATOR) then
               begin
    diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas
    index 597249fd71..6ff2cbf5ef 100644
    --- a/compiler/pdecvar.pas
    +++ b/compiler/pdecvar.pas
    @@ -27,14 +27,14 @@ unit pdecvar;
     interface
     
         uses
    -      cclasses,
    +      globtype,cclasses,
           symtable,symsym,symdef,symtype;
     
         type
           tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class,vd_final,vd_canreorder,vd_check_generic);
           tvar_dec_options=set of tvar_dec_option;
     
    -    function  read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
    +    function  read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef;name_filepos:pfileposinfo=nil):tpropertysym;
     
         procedure read_var_decls(options:Tvar_dec_options;out had_generic:boolean);
     
    @@ -53,7 +53,7 @@ implementation
            { common }
            cutils,
            { global }
    -       globtype,globals,tokens,verbose,constexp,
    +       globals,tokens,verbose,constexp,
            systems,
            { symtable }
            symconst,symbase,defutil,defcmp,symutil,symcreat,
    @@ -71,7 +71,7 @@ implementation
            pbase,pexpr,ptype,ptconst,pdecsub,pparautl;
     
     
    -    function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
    +    function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef;name_filepos:pfileposinfo=nil):tpropertysym;
     
             { convert a node tree to symlist and return the last
               symbol }
    @@ -333,7 +333,7 @@ implementation
                       create_accessor_procsym(p,writepd,'put$',palt_write);
                     end;
                 end;
    -
    +            
           var
              sym : tsym;
              srsymtable: tsymtable;
    @@ -384,11 +384,18 @@ implementation
              p.default:=longint($80000000);
              if is_classproperty then
                include(p.symoptions, sp_static);
    -         symtablestack.top.insert(p);
              consume(_ID);
    +         if assigned(name_filepos) then
    +           name_filepos^:=current_filepos;
              { property parameters ? }
              if try_to_consume(_LECKKLAMMER) then
                begin
    +              { paramtered properties in structs can be default and
    +                potentially allow duplicate names for overloading }
    +              if assigned(astruct) then
    +                symtablestack.top.insert(p,false)
    +              else
    +                symtablestack.top.insert(p);
                   if (p.visibility=vis_published) and
                     not (m_delphi in current_settings.modeswitches) then
                     Message(parser_e_cant_publish_that_property);
    @@ -446,7 +453,9 @@ implementation
                       p.add_accessor_parameters(readprocdef,writeprocdef);
                       include(p.propoptions,ppo_hasparameters);
                     end;
    -           end;
    +           end
    +         else
    +           symtablestack.top.insert(p);
              { overridden property ?                                 }
              { force property interface
                  there is a property parameter
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index 022aa2a294..44e413244c 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -1151,9 +1151,8 @@ implementation
     
     
         { the following procedure handles the access to a property symbol }
    -    procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;var p1 : tnode);
    +    procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;paras : tnode;var p1 : tnode);
           var
    -         paras : tnode;
              p2    : tnode;
              membercall : boolean;
              callflags  : tcallnodeflags;
    @@ -1162,8 +1161,7 @@ implementation
           begin
              { property parameters? read them only if the property really }
              { has parameters                                             }
    -         paras:=nil;
    -         if (ppo_hasparameters in propsym.propoptions) then
    +         if not assigned(paras) and (ppo_hasparameters in propsym.propoptions) then
                begin
                  if try_to_consume(_LECKKLAMMER) then
                    begin
    @@ -1284,6 +1282,8 @@ implementation
             isclassref:boolean;
             isrecordtype:boolean;
             isobjecttype:boolean;
    +        paras:tnode;
    +        bestsym:tsym;
           begin
              if sym=nil then
                begin
    @@ -1410,7 +1410,19 @@ implementation
                        begin
                           if isclassref and not (sp_static in sym.symoptions) then
                             Message(parser_e_only_class_members_via_class_ref);
    -                      handle_propertysym(tpropertysym(sym),sym.owner,p1);
    +                      if ppo_hasparameters in tpropertysym(sym).propoptions then
    +                        begin
    +                          consume(_LECKKLAMMER);
    +                          paras:=parse_paras(false,false,_RECKKLAMMER);
    +                          consume(_RECKKLAMMER);
    +                          bestsym:=search_parametered_property(structh,paras,sym.name);
    +                          if assigned(bestsym) then
    +                            handle_propertysym(tpropertysym(bestsym),bestsym.owner,paras,p1)
    +                          else
    +                            handle_propertysym(tpropertysym(sym),sym.owner,paras,p1);
    +                        end
    +                      else
    +                        handle_propertysym(tpropertysym(sym),sym.owner,nil,p1);
                        end;
                      typesym:
                        begin
    @@ -2019,6 +2031,7 @@ implementation
          strdef : tdef;
          spezcontext : tspecializationcontext;
          old_current_filepos : tfileposinfo;
    +     paras : tnode;
         label
          skipreckklammercheck,
          skippointdefcheck;
    @@ -2095,7 +2108,14 @@ implementation
                       is_javaclass(p1.resultdef) then
                      begin
                        { default property }
    -                   protsym:=search_default_property(tabstractrecorddef(p1.resultdef));
    +                   paras:=nil;
    +                   protsym:=nil;
    +                   if try_to_consume(_LECKKLAMMER) then
    +                     begin
    +                       paras:=parse_paras(false,false,_RECKKLAMMER);
    +                       consume(_RECKKLAMMER);
    +                       protsym:=search_parametered_property(tabstractrecorddef(p1.resultdef),paras);
    +                     end;
                        if not(assigned(protsym)) then
                          begin
                             p1.destroy;
    @@ -2107,7 +2127,7 @@ implementation
                          begin
                            { The property symbol is referenced indirect }
                            protsym.IncRefCount;
    -                       handle_propertysym(protsym,protsym.owner,p1);
    +                       handle_propertysym(protsym,protsym.owner,paras,p1);
                          end;
                      end
                    else
    @@ -3277,7 +3297,7 @@ implementation
                         else
                         { no method pointer }
                           begin
    -                        handle_propertysym(tpropertysym(srsym),srsymtable,p1);
    +                        handle_propertysym(tpropertysym(srsym),srsymtable,nil,p1);
                           end;
                       end;
     
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 305d39904a..5d2de1ef02 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -73,7 +73,6 @@ interface
               procedure checklabels;
               function  needs_init_final : boolean; virtual;
               function  has_non_trivial_init:boolean;virtual;
    -          procedure testfordefaultproperty(sym:TObject;arg:pointer);
               procedure register_children;
            end;
     
    @@ -387,7 +386,7 @@ interface
         function get_objectpascal_helpers(pd : tdef):TFPObjectList;
     
     {*** Object Helpers ***}
    -    function search_default_property(pd : tabstractrecorddef) : tpropertysym;
    +    function search_parametered_property(pd : tabstractrecorddef; paras: pointer=nil; name: shortstring='') : tpropertysym;
         function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef;
         function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
     
    @@ -485,7 +484,9 @@ implementation
           { ppu }
           entfile,
           { parser }
    -      scanner
    +      scanner,
    +      { node }
    +      node,ncal
           ;
     
     
    @@ -1045,15 +1046,6 @@ implementation
                tabstractrecorddef(ttypesym(sym).typedef).symtable.SymList.ForEachCall(@TestPrivate,nil);
           end;
     
    -
    -   procedure tstoredsymtable.testfordefaultproperty(sym:TObject;arg:pointer);
    -     begin
    -        if (tsym(sym).typ=propertysym) and
    -           (ppo_defaultproperty in tpropertysym(sym).propoptions) then
    -          ppointer(arg)^:=sym;
    -     end;
    -
    -
        procedure tstoredsymtable.register_children;
          begin
            SymList.ForEachCall(@register_syms,nil);
    @@ -4496,39 +4488,104 @@ implementation
                                   Object Helpers
     ****************************************************************************}
     
    -   function search_default_property(pd : tabstractrecorddef) : tpropertysym;
    -   { returns the default property of a class, searches also anchestors }
    +   function search_parametered_property(pd : tabstractrecorddef; paras: pointer=nil; name: shortstring='') : tpropertysym;
    +     
    +     function find_best_property(pd:tabstractrecorddef; paras:tcallparanode; name:shortstring): tpropertysym;
    +       var
    +         i: integer;
    +         sym: tsym;
    +         st: tsymtable;
    +         pt: tcallparanode;
    +         paraindex, paracount: integer;
    +         parasym: tparavarsym;
    +         eq: integer;
    +       begin 
    +         result:=nil;
    +         pt:=tcallparanode(paras);
    +         paracount:=0;
    +         while assigned(pt) do
    +           begin
    +             pt:=tcallparanode(pt.nextpara);
    +             inc(paracount);
    +           end;
    +         for i:=0 to pd.symtable.SymList.Count-1 do
    +           begin
    +             sym:=tsym(pd.symtable.SymList[i]);
    +             { rejected symbol for named searches }
    +             if (name<>'') and (sym.name<>name) then
    +               continue;
    +             { filter properties by default or name }
    +             if (sym.typ=propertysym) and
    +                ((name='') and (ppo_defaultproperty in tpropertysym(sym).propoptions) or
    +                 (name<>'') and (ppo_hasparameters in tpropertysym(sym).propoptions)) then
    +               begin
    +                 st:=tpropertysym(sym).parast;
    +                 { parameter count must match }
    +                 if st.symlist.count<>paracount then
    +                   continue;
    +                 pt:=tcallparanode(paras);
    +                 paraindex:=0;
    +                 eq:=0;
    +                 while assigned(pt) do
    +                   begin
    +                     { paranodes are in reverse order so we need to access
    +                       the symtable list from back to front }
    +                     parasym:=tparavarsym(st.symlist[(st.symlist.count-1)-paraindex]);
    +                     { if the paramter is an error node this may mean that
    +                       we are working with a generic paramter or an unspecialized
    +                       generic type. because it's not possible to choose the correct
    +                       overload will simply return the first default.  }
    +                     if pt.paravalue.nodetype=errorn then
    +                       begin
    +                         result:=tpropertysym(sym);
    +                         exit;
    +                       end;
    +                     if compare_defs(pt.paravalue.resultdef,parasym.vardef,nothingn)>=te_convert_l5 then
    +                       inc(eq);
    +                     { next parameter in the call tree }
    +                     pt:=tcallparanode(pt.nextpara);
    +                     paraindex:=paraindex+1;
    +                   end;
    +                 if eq=paracount then
    +                   begin
    +                     result:=tpropertysym(sym);
    +                     exit;
    +                   end;
    +               end;
    +           end;
    +       end;
    +
          var
    -       _defaultprop : tpropertysym;
    +       found : tpropertysym;
            helperpd : tobjectdef;
          begin
    -        _defaultprop:=nil;
    +        found:=nil;
             { first search in helper's hierarchy }
             if search_last_objectpascal_helper(pd,nil,helperpd) then
               while assigned(helperpd) do
                 begin
    -              helperpd.symtable.SymList.ForEachCall(@tstoredsymtable(helperpd.symtable).testfordefaultproperty,@_defaultprop);
    -              if assigned(_defaultprop) then
    +              found:=find_best_property(helperpd,tcallparanode(paras),name);
    +              if assigned(found) then
                     break;
                   helperpd:=helperpd.childof;
                 end;
    -        if assigned(_defaultprop) then
    +        if assigned(found) then
               begin
    -            search_default_property:=_defaultprop;
    +            result:=found;
                 exit;
               end;
             { now search in the type's hierarchy itself }
             while assigned(pd) do
               begin
    -             pd.symtable.SymList.ForEachCall(@tstoredsymtable(pd.symtable).testfordefaultproperty,@_defaultprop);
    -             if assigned(_defaultprop) then
    +             found:=find_best_property(pd,tcallparanode(paras),name);
    +             if assigned(found) then
                    break;
                  if (pd.typ=objectdef) then
                    pd:=tobjectdef(pd).childof
                  else
                    break;
               end;
    -        search_default_property:=_defaultprop;
    +        result:=found;
          end;
     
     
    diff --git a/tests/test/tarrpropol1.pp b/tests/test/tarrpropol1.pp
    new file mode 100644
    index 0000000000..68bc885250
    --- /dev/null
    +++ b/tests/test/tarrpropol1.pp
    @@ -0,0 +1,103 @@
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +
    +program tarrpropol1;
    +
    +var
    +  LastProc: integer = 0;
    +
    +type
    +  TValue = TObject;
    +  TList = record
    +    function GetValue(index: integer): TValue; overload;
    +    function GetValue(index: string): TValue; overload;
    +    function GetValue(index: integer; key: string): TValue; overload;
    +    procedure SetValue(index: integer; value: TValue); overload;
    +    procedure SetValue(index: string; value: TValue); overload;
    +    procedure SetValue(index: integer; key: string; value: TValue); overload;
    +    { default properties }
    +    property Values[index: integer]: TValue read GetValue write SetValue; default;
    +    property Values[index: string]: TValue read GetValue write SetValue; default;
    +    property Values[index: integer; key: string]: TValue read GetValue write SetValue; default;
    +    { paramatered proprerties }
    +    property Values0[index: integer]: TValue read GetValue write SetValue;
    +    property Values0[index: string]: TValue read GetValue write SetValue;
    +    property Values0[index: integer; key: string]: TValue read GetValue write SetValue;
    +  end;
    +
    +function TList.GetValue(index: integer): TValue;
    +begin
    +  LastProc := 1;
    +  result := nil;  
    +end;
    +
    +function TList.GetValue(index: string): TValue;
    +begin
    +  LastProc := 2;
    +  result := nil;  
    +end;
    +
    +function TList.GetValue(index: integer; key: string): TValue;
    +begin
    +  LastProc := 3;
    +  result := nil;  
    +end;
    +
    +procedure TList.SetValue(index: integer; value: TValue);
    +begin
    +  LastProc := 4;
    +end;
    +
    +procedure TList.SetValue(index: string; value: TValue);
    +begin
    +  LastProc := 5;
    +end;
    +
    +procedure TList.SetValue(index: integer; key: string; value: TValue);
    +begin
    +  LastProc := 6;
    +end;
    +
    +procedure Require(desired: integer);
    +begin
    +  if LastProc <> desired then
    +    begin
    +      writeln('FAILED');
    +      Halt(-1);
    +    end;
    +end;
    +
    +procedure Test(const value: TValue; desired: integer);
    +begin
    +  Require(desired);
    +end;
    +
    +var
    +  c: TList;
    +  v: TValue;
    +begin
    +  // setters (default)
    +  c[1] := v;                  Require(4);
    +  c['key'] := v;              Require(5);
    +  c[1,'key'] := v;            Require(6);
    +
    +  // setters (named)
    +  c.values[1] := v;           Require(4);
    +  c.values['key'] := v;       Require(5);
    +  c.values[1,'key'] := v;     Require(6);
    +
    +  // getters (default)
    +  Test(c[1], 1);
    +  Test(c['key'], 2);
    +  Test(c[1,'key'], 3);
    +
    +  // getters (named)
    +  Test(c.values[1], 1);
    +  Test(c.values['a'], 2);
    +  Test(c.values[1, 'a'], 3);
    +
    +  // getters (named, non-default)
    +  Test(c.values0[1], 1);
    +  Test(c.values0['a'], 2);
    +  Test(c.values0[1, 'a'], 3);
    +end.
    \ No newline at end of file
    diff --git a/tests/test/tarrpropol2.pp b/tests/test/tarrpropol2.pp
    new file mode 100644
    index 0000000000..029704e2ef
    --- /dev/null
    +++ b/tests/test/tarrpropol2.pp
    @@ -0,0 +1,28 @@
    +{%FAIL}
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +
    +program tarrpropol2;
    +
    +type
    +  TValue = TObject;
    +  TList = record
    +    function GetValueWithInt(index: integer): TValue;
    +    function GetValueWithString(index: string): TValue;
    +    { all default properties must share the same name }
    +    property Values0[index: integer]: TValue read GetValueWithInt; default;
    +    property Values1[index: string]: TValue read GetValueWithString; default;
    +  end;
    +
    +function TList.GetValueWithInt(index: integer): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +function TList.GetValueWithString(index: string): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +begin
    +end.
    diff --git a/tests/test/tarrpropol3.pp b/tests/test/tarrpropol3.pp
    new file mode 100644
    index 0000000000..55bd0cf269
    --- /dev/null
    +++ b/tests/test/tarrpropol3.pp
    @@ -0,0 +1,22 @@
    +{%FAIL}
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +
    +program tarrpropol3;
    +
    +type
    +  TValue = TObject;
    +  TList = record
    +    function GetValueWithInt(index: integer): TValue;
    +    { default properties must have unique parameters }
    +    property Values[index: integer]: TValue read GetValueWithInt; default;
    +    property Values[index: integer]: TValue read GetValueWithInt; default;
    +  end;
    +
    +function TList.GetValueWithInt(index: integer): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +begin
    +end.
    diff --git a/tests/test/tarrpropol4.pp b/tests/test/tarrpropol4.pp
    new file mode 100644
    index 0000000000..2d9e48923e
    --- /dev/null
    +++ b/tests/test/tarrpropol4.pp
    @@ -0,0 +1,24 @@
    +{%FAIL}
    +{$mode objfpc}
    +
    +program tarrpropol4;
    +
    +type
    +  TValue = TObject;
    +
    +function GetGlobalValueInt(index: integer): TValue;
    +begin
    +  result:=nil;
    +end;
    +
    +function GetGlobalValueStr(index: string): TValue;
    +begin
    +  result:=nil;
    +end;
    +
    +{ make sure global properties aren't affect by changes }
    +property Values[index: integer]: TValue read GetGlobalValueInt;
    +property Values[index: string]: TValue read GetGlobalValueStr;
    +
    +begin
    +end.
    diff --git a/tests/test/tarrpropol5.pp b/tests/test/tarrpropol5.pp
    new file mode 100644
    index 0000000000..0d2312b0ec
    --- /dev/null
    +++ b/tests/test/tarrpropol5.pp
    @@ -0,0 +1,28 @@
    +{%FAIL}
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +
    +program tarrpropol5;
    +
    +type
    +  TValue = TObject;
    +  TList = record
    +    function GetValue(index: integer): TValue;
    +    function GetValue(index: word): TValue;
    +    { default properties must have unique parameters }
    +    property Values[index: integer]: TValue read GetValue; default;
    +    property Values[index: word]: TValue read GetValue; default;
    +  end;
    +
    +function TList.GetValue(index: integer): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +function TList.GetValue(index: word): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +begin
    +end.
    diff --git a/tests/test/tarrpropol6.pp b/tests/test/tarrpropol6.pp
    new file mode 100644
    index 0000000000..5ea3301c2b
    --- /dev/null
    +++ b/tests/test/tarrpropol6.pp
    @@ -0,0 +1,50 @@
    +{$mode objfpc}
    +
    +program tarrpropol6;
    +
    +var
    +  LastProc: integer = 0;
    +
    +type
    +  TValue = TObject;
    +  TBase = class
    +    function GetValue(index: integer): TValue;
    +    property Values[index: integer]: TValue read GetValue; default;
    +  end;
    +
    +function TBase.GetValue(index: integer): TValue;
    +begin
    +  LastProc := 1;
    +  result := nil;  
    +end;
    +
    +type
    +  TList = class(TBase)
    +    function GetValue(index: integer): TValue;
    +    property Values[index: integer]: TValue read GetValue; default;
    +  end;
    +
    +function TList.GetValue(index: integer): TValue;
    +begin
    +  LastProc := 2;
    +  result := nil;  
    +end;
    +
    +procedure Test(const value: TValue; desired: integer);
    +begin
    +  if LastProc <> desired then
    +    begin
    +      writeln('FAILED');
    +      Halt(-1);
    +    end;
    +end;
    +
    +var
    +  c: TList;
    +  v: TValue;
    +begin
    +  { last wins }
    +  Test(c[1], 2);
    +  { cast to get child access }
    +  Test(TBase(c)[1], 1);
    +end.
    diff --git a/tests/test/tarrpropol7.pp b/tests/test/tarrpropol7.pp
    new file mode 100644
    index 0000000000..a2c471fbf9
    --- /dev/null
    +++ b/tests/test/tarrpropol7.pp
    @@ -0,0 +1,64 @@
    +{$mode objfpc}
    +
    +program tarrpropol7;
    +
    +var
    +  LastProc: integer = 0;
    +
    +type
    +  TValue = TObject;
    +  TBase = class
    +    function GetValue(index: integer): TValue;
    +    property Values[index: integer]: TValue read GetValue; default;
    +  end;
    +  
    +  function TBase.GetValue(index: integer): TValue;
    +  begin
    +    LastProc := 1;
    +    result := nil;  
    +  end;
    +
    +type
    +  TList = class(TBase)
    +    function GetAnotherValue(index: integer): TValue;
    +    function GetAnotherValue(index: string): TValue;
    +    { you can declare another default property of a different name
    +      if it's in a child object }
    +    property MoreValues[index: integer]: TValue read GetAnotherValue; default;
    +    property MoreValues[index: string]: TValue read GetAnotherValue; default;
    +  end;
    +
    +  function TList.GetAnotherValue(index: integer): TValue;
    +  begin
    +    LastProc := 2;
    +    result := nil;  
    +  end;
    +
    +  function TList.GetAnotherValue(index: string): TValue;
    +  begin
    +    LastProc := 3;
    +    result := nil;  
    +  end;
    +
    +procedure Test(const value: TValue; desired: integer);
    +begin
    +  if LastProc <> desired then
    +    begin
    +      writeln('FAILED');
    +      Halt(-1);
    +    end;
    +end;
    +
    +var
    +  c: TList;
    +  v: TValue;
    +begin
    +  { normal defaults }
    +  Test(c[1], 2);
    +  Test(c['key'], 3);
    +
    +  { named default access }
    +  Test(c.Values[1], 1);
    +  Test(c.MoreValues[1], 2);
    +  Test(c.MoreValues['key'], 3);
    +end.
    diff --git a/tests/test/tarrpropol8.pp b/tests/test/tarrpropol8.pp
    new file mode 100644
    index 0000000000..7ae4dca46e
    --- /dev/null
    +++ b/tests/test/tarrpropol8.pp
    @@ -0,0 +1,28 @@
    +{%FAIL}
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +
    +program tarrpropol8;
    +
    +type
    +  TValue = TObject;
    +  TList = record
    +    function GetValue(index: integer): TValue;
    +    function GetValue(index: word): TValue;
    +    { parametered properties must have unique parameters }
    +    property Values[index: integer]: TValue read GetValue;
    +    property Values[index: word]: TValue read GetValue;
    +  end;
    +
    +function TList.GetValue(index: integer): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +function TList.GetValue(index: word): TValue;
    +begin
    +  result := nil;  
    +end;
    +
    +begin
    +end.
    -- 
    2.17.2 (Apple Git-113)
    
    
    patch_6_28.diff (29,318 bytes)

Relationships

related to 0028820 closedOndrej Pokorny Feature request: allow "array" properties to define an enumerator 

Activities

Ryan Joseph

2019-06-26 20:15

reporter  

array_prop_overload_6_26.diff (43,589 bytes)
From e22a88e922edc7f0970b3ff32d05c9f5971133b1 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Fri, 21 Jun 2019 09:32:36 -0400
Subject: [PATCH 1/4] initial commit

---
 .gitignore               | 24 +++++++++++++
 compiler/ryan_ppcx64.lpi | 77 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 101 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 compiler/ryan_ppcx64.lpi

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000000..8b577f31db
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,24 @@
+# files
+pp
+fpmake
+rtl/darwin/fpcmade.x86_64-darwin
+fpmake_proc1 copy.inc
+tests/*.x86_64-darwin
+rtl/Package.fpc
+tests/createlst
+tests/gparmake
+#compiler/ryan_ppcx64.lpi
+
+# directories
+lazbuild/
+x86_64-darwin/
+tests/tstunits/
+tests/utils
+
+# patterns
+*.app
+*.o
+*.ppu
+*.fpm
+*.rsj
+*.lst
\ No newline at end of file
diff --git a/compiler/ryan_ppcx64.lpi b/compiler/ryan_ppcx64.lpi
new file mode 100644
index 0000000000..68008e4ab3
--- /dev/null
+++ b/compiler/ryan_ppcx64.lpi
@@ -0,0 +1,77 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="ppcx64"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="pp.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="pp"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="x86\aasmcpu.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="aasmcpu"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="x86_64\pp"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="x86_64"/>
+      <OtherUnitFiles Value="x86_64;x86;systems"/>
+      <UnitOutputDirectory Value="x86_64\lazbuild"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <CStyleOperator Value="False"/>
+        <AllowLabel Value="False"/>
+        <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <Verbosity>
+        <ShowWarn Value="False"/>
+        <ShowNotes Value="False"/>
+        <ShowHints Value="False"/>
+      </Verbosity>
+      <ConfigFile>
+        <StopAfterErrCount Value="50"/>
+      </ConfigFile>
+      <CustomOptions Value="-dx86_64 -gw -godwarfcpp -Fl/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/lib"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
-- 
2.17.2 (Apple Git-113)


From 8b4092cc7e8e70e80cf65510deda7b51f1660beb Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Fri, 21 Jun 2019 13:32:20 -0400
Subject: [PATCH 2/4] first draft

---
 compiler/pdecobj.pas  | 85 +++++++++++++++++++++++++++++++++++++++++--
 compiler/pdecvar.pas  | 23 ++++++++----
 compiler/pexpr.pas    | 26 +++++++++----
 compiler/symtable.pas | 76 ++++++++++++++++++++++++++++++--------
 4 files changed, 175 insertions(+), 35 deletions(-)

diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index 64e948a106..01ffcff1a0 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -163,8 +163,83 @@ implementation
 
 
     procedure struct_property_dec(is_classproperty:boolean);
+      
+      procedure check_invalid_default_property(pd: tabstractrecorddef; p: tpropertysym; name_filepos: tfileposinfo);
+        var
+          i: integer;
+          sym: tsym;
+          st,sc: tsymtable;
+          paraindex: integer;
+          from_para, to_para: tparavarsym;
+          eq: integer;
+        begin
+          sc:=p.parast;
+          for i := 0 to pd.symtable.SymList.Count-1 do
+            begin
+              sym:=tsym(pd.symtable.SymList[i]);
+              if (sym.typ<>propertysym) or (sym=p) then
+                continue;
+
+              { non-default parametered properties must not have the same name }
+              if (ppo_hasparameters in tpropertysym(sym).propoptions) and
+                 not (ppo_defaultproperty in tpropertysym(sym).propoptions) then 
+                begin
+                  MessagePos1(name_filepos,sym_e_duplicate_id,p.realname);
+                  exit;
+                end
+              else if ppo_defaultproperty in tpropertysym(sym).propoptions then
+                begin
+                  { all default properties must share the same name }
+                  if sym.realname<>p.realname then
+                    begin
+                      writeln('*** all default properties must share the same name');
+                      message(parser_e_only_one_default_property);
+                      exit;
+                    end;
+                  { default properties must have unique parameters }
+                  st:=tpropertysym(sym).parast;
+                  if st.symlist.count<>sc.SymList.count then
+                    continue;
+                  eq:=0;
+                  for paraindex := 0 to sc.SymList.count-1 do
+                    begin
+                      from_para:=tparavarsym(st.SymList[paraindex]);
+                      to_para:=tparavarsym(sc.SymList[paraindex]);
+                      if compare_defs(from_para.vardef,to_para.vardef,nothingn)>=te_convert_l1 then
+                        inc(eq);
+                    end;
+                  if eq=sc.SymList.count then
+                    begin
+                      writeln('*** default properties must have unique parameters');
+                      message(parser_e_only_one_default_property);
+                      exit;
+                    end;
+                end;   
+            end;
+        end;
+      
+      procedure check_duplicate_parametered_property(pd: tabstractrecorddef; p: tpropertysym; name_filepos: tfileposinfo);
+        var
+          i: integer;
+          sym: tsym;
+        begin
+          for i := 0 to pd.symtable.SymList.Count-1 do
+            begin
+              sym:=tsym(pd.symtable.SymList[i]);
+              if (sym<>p) and
+                 (sym.typ=propertysym) and
+                 (ppo_hasparameters in tpropertysym(sym).propoptions) and
+                 (sym.realname=p.realname) then
+                begin
+                  MessagePos1(name_filepos,sym_e_duplicate_id,p.realname);
+                  exit;
+                end;
+            end;
+        end;
+
       var
         p : tpropertysym;
+        name_filepos: tfileposinfo;
       begin
         { check for a class, record or helper }
         if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef) or
@@ -172,12 +247,11 @@ implementation
                (not(m_tp7 in current_settings.modeswitches) and (is_object(current_structdef)))) then
           Message(parser_e_syntax_error);
         consume(_PROPERTY);
-        p:=read_property_dec(is_classproperty,current_structdef);
+        p:=read_property_dec(is_classproperty,current_structdef,@name_filepos);
         consume(_SEMICOLON);
         if try_to_consume(_DEFAULT) then
           begin
-            if oo_has_default_property in current_structdef.objectoptions then
-              message(parser_e_only_one_default_property);
+            check_invalid_default_property(current_structdef,p,name_filepos);
             include(current_structdef.objectoptions,oo_has_default_property);
             include(p.propoptions,ppo_defaultproperty);
             if not(ppo_hasparameters in p.propoptions) then
@@ -188,7 +262,10 @@ implementation
                 consume_all_until(_SEMICOLON);
               end;
             consume(_SEMICOLON);
-          end;
+          end
+        { properties with paramters that not default can't have duplicate names }
+        else if (ppo_hasparameters in p.propoptions) then
+          check_duplicate_parametered_property(current_structdef,p,name_filepos);
         { parse possible enumerator modifier }
         if try_to_consume(_ENUMERATOR) then
           begin
diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas
index 597249fd71..6ff2cbf5ef 100644
--- a/compiler/pdecvar.pas
+++ b/compiler/pdecvar.pas
@@ -27,14 +27,14 @@ unit pdecvar;
 interface
 
     uses
-      cclasses,
+      globtype,cclasses,
       symtable,symsym,symdef,symtype;
 
     type
       tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class,vd_final,vd_canreorder,vd_check_generic);
       tvar_dec_options=set of tvar_dec_option;
 
-    function  read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
+    function  read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef;name_filepos:pfileposinfo=nil):tpropertysym;
 
     procedure read_var_decls(options:Tvar_dec_options;out had_generic:boolean);
 
@@ -53,7 +53,7 @@ implementation
        { common }
        cutils,
        { global }
-       globtype,globals,tokens,verbose,constexp,
+       globals,tokens,verbose,constexp,
        systems,
        { symtable }
        symconst,symbase,defutil,defcmp,symutil,symcreat,
@@ -71,7 +71,7 @@ implementation
        pbase,pexpr,ptype,ptconst,pdecsub,pparautl;
 
 
-    function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
+    function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef;name_filepos:pfileposinfo=nil):tpropertysym;
 
         { convert a node tree to symlist and return the last
           symbol }
@@ -333,7 +333,7 @@ implementation
                   create_accessor_procsym(p,writepd,'put$',palt_write);
                 end;
             end;
-
+            
       var
          sym : tsym;
          srsymtable: tsymtable;
@@ -384,11 +384,18 @@ implementation
          p.default:=longint($80000000);
          if is_classproperty then
            include(p.symoptions, sp_static);
-         symtablestack.top.insert(p);
          consume(_ID);
+         if assigned(name_filepos) then
+           name_filepos^:=current_filepos;
          { property parameters ? }
          if try_to_consume(_LECKKLAMMER) then
            begin
+              { paramtered properties in structs can be default and
+                potentially allow duplicate names for overloading }
+              if assigned(astruct) then
+                symtablestack.top.insert(p,false)
+              else
+                symtablestack.top.insert(p);
               if (p.visibility=vis_published) and
                 not (m_delphi in current_settings.modeswitches) then
                 Message(parser_e_cant_publish_that_property);
@@ -446,7 +453,9 @@ implementation
                   p.add_accessor_parameters(readprocdef,writeprocdef);
                   include(p.propoptions,ppo_hasparameters);
                 end;
-           end;
+           end
+         else
+           symtablestack.top.insert(p);
          { overridden property ?                                 }
          { force property interface
              there is a property parameter
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 022aa2a294..7ec3877ed7 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -1151,9 +1151,8 @@ implementation
 
 
     { the following procedure handles the access to a property symbol }
-    procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;var p1 : tnode);
+    procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;paras : tnode;var p1 : tnode);
       var
-         paras : tnode;
          p2    : tnode;
          membercall : boolean;
          callflags  : tcallnodeflags;
@@ -1162,8 +1161,7 @@ implementation
       begin
          { property parameters? read them only if the property really }
          { has parameters                                             }
-         paras:=nil;
-         if (ppo_hasparameters in propsym.propoptions) then
+         if not assigned(paras) and (ppo_hasparameters in propsym.propoptions) then
            begin
              if try_to_consume(_LECKKLAMMER) then
                begin
@@ -1410,7 +1408,7 @@ implementation
                    begin
                       if isclassref and not (sp_static in sym.symoptions) then
                         Message(parser_e_only_class_members_via_class_ref);
-                      handle_propertysym(tpropertysym(sym),sym.owner,p1);
+                      handle_propertysym(tpropertysym(sym),sym.owner,nil,p1);
                    end;
                  typesym:
                    begin
@@ -2019,6 +2017,7 @@ implementation
      strdef : tdef;
      spezcontext : tspecializationcontext;
      old_current_filepos : tfileposinfo;
+     paras : tnode;
     label
      skipreckklammercheck,
      skippointdefcheck;
@@ -2095,7 +2094,18 @@ implementation
                   is_javaclass(p1.resultdef) then
                  begin
                    { default property }
-                   protsym:=search_default_property(tabstractrecorddef(p1.resultdef));
+                   paras:=nil;
+                   if oo_has_default_property in tabstractrecorddef(p1.resultdef).objectoptions then
+                     begin
+                       if try_to_consume(_LECKKLAMMER) then
+                         begin
+                           paras:=parse_paras(false,false,_RECKKLAMMER);
+                           consume(_RECKKLAMMER);
+                           protsym:=search_default_property(tabstractrecorddef(p1.resultdef),paras);
+                         end;
+                     end
+                   else
+                     protsym:=search_default_property(tabstractrecorddef(p1.resultdef),nil);
                    if not(assigned(protsym)) then
                      begin
                         p1.destroy;
@@ -2107,7 +2117,7 @@ implementation
                      begin
                        { The property symbol is referenced indirect }
                        protsym.IncRefCount;
-                       handle_propertysym(protsym,protsym.owner,p1);
+                       handle_propertysym(protsym,protsym.owner,paras,p1);
                      end;
                  end
                else
@@ -3277,7 +3287,7 @@ implementation
                     else
                     { no method pointer }
                       begin
-                        handle_propertysym(tpropertysym(srsym),srsymtable,p1);
+                        handle_propertysym(tpropertysym(srsym),srsymtable,nil,p1);
                       end;
                   end;
 
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 305d39904a..376ea60a7c 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -73,7 +73,6 @@ interface
           procedure checklabels;
           function  needs_init_final : boolean; virtual;
           function  has_non_trivial_init:boolean;virtual;
-          procedure testfordefaultproperty(sym:TObject;arg:pointer);
           procedure register_children;
        end;
 
@@ -387,7 +386,7 @@ interface
     function get_objectpascal_helpers(pd : tdef):TFPObjectList;
 
 {*** Object Helpers ***}
-    function search_default_property(pd : tabstractrecorddef) : tpropertysym;
+    function search_default_property(pd : tabstractrecorddef; paras: pointer) : tpropertysym;
     function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef;
     function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
 
@@ -485,7 +484,9 @@ implementation
       { ppu }
       entfile,
       { parser }
-      scanner
+      scanner,
+      { node }
+      node,ncal
       ;
 
 
@@ -1045,15 +1046,6 @@ implementation
            tabstractrecorddef(ttypesym(sym).typedef).symtable.SymList.ForEachCall(@TestPrivate,nil);
       end;
 
-
-   procedure tstoredsymtable.testfordefaultproperty(sym:TObject;arg:pointer);
-     begin
-        if (tsym(sym).typ=propertysym) and
-           (ppo_defaultproperty in tpropertysym(sym).propoptions) then
-          ppointer(arg)^:=sym;
-     end;
-
-
    procedure tstoredsymtable.register_children;
      begin
        SymList.ForEachCall(@register_syms,nil);
@@ -4496,8 +4488,60 @@ implementation
                               Object Helpers
 ****************************************************************************}
 
-   function search_default_property(pd : tabstractrecorddef) : tpropertysym;
-   { returns the default property of a class, searches also anchestors }
+   function search_default_property(pd : tabstractrecorddef; paras: pointer) : tpropertysym;
+     
+     function find_best_property(pd: tabstractrecorddef; paras: tcallparanode): tpropertysym;
+       var
+         i: integer;
+         sym: tsym;
+         st: tsymtable;
+         pt: tcallparanode;
+         paraindex, paracount: integer;
+         parasym: tparavarsym;
+         eq: integer;
+       begin 
+         result:=nil;
+         pt:=tcallparanode(paras);
+         paracount:=0;
+         while assigned(pt) do
+           begin
+             pt:=tcallparanode(pt.nextpara);
+             paracount:=paracount+1;
+           end;
+         for i := 0 to pd.symtable.SymList.Count-1 do
+           begin
+             sym:=tsym(pd.symtable.SymList[i]);
+             if (sym.typ=propertysym) and
+                (ppo_defaultproperty in tpropertysym(sym).propoptions) then
+               begin
+                 st:=tpropertysym(sym).parast;
+                 { parameter count must match }
+                 if st.symlist.count<>paracount then
+                   continue;
+                 pt:=tcallparanode(paras);
+                 paraindex:=0;
+                 eq:=0;
+                 while assigned(pt) do
+                   begin
+                     { paranodes are in reverse order so we need to access
+                       the symtable list from back to front }
+                     parasym:=tparavarsym(st.symlist[(st.symlist.count-1)-paraindex]);
+                     if compare_defs(pt.paravalue.resultdef,parasym.vardef,nothingn)>=te_convert_l1 then
+                       inc(eq);
+                     { next parameter in the call tree }
+                     pt:=tcallparanode(pt.nextpara);
+                     paraindex:=paraindex+1;
+                   end;
+                 if eq=paracount then
+                   begin
+                     result:=tpropertysym(sym);
+                     exit;
+                   end;
+               end;
+           end;
+       end;
+
+     { returns the default property of a class, searches also anchestors }
      var
        _defaultprop : tpropertysym;
        helperpd : tobjectdef;
@@ -4507,7 +4551,7 @@ implementation
         if search_last_objectpascal_helper(pd,nil,helperpd) then
           while assigned(helperpd) do
             begin
-              helperpd.symtable.SymList.ForEachCall(@tstoredsymtable(helperpd.symtable).testfordefaultproperty,@_defaultprop);
+              _defaultprop:=find_best_property(pd,tcallparanode(paras));
               if assigned(_defaultprop) then
                 break;
               helperpd:=helperpd.childof;
@@ -4520,7 +4564,7 @@ implementation
         { now search in the type's hierarchy itself }
         while assigned(pd) do
           begin
-             pd.symtable.SymList.ForEachCall(@tstoredsymtable(pd.symtable).testfordefaultproperty,@_defaultprop);
+             _defaultprop:=find_best_property(pd,tcallparanode(paras));
              if assigned(_defaultprop) then
                break;
              if (pd.typ=objectdef) then
-- 
2.17.2 (Apple Git-113)


From 2db6bbdbcfdf5472ad8179d2c0ed299f6f1fab4b Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Sun, 23 Jun 2019 10:46:27 -0400
Subject: [PATCH 3/4] default properties can be overloaded by name + added
 tests

---
 compiler/pexpr.pas        | 16 ++++++++++++++-
 tests/test/tarrpropol1.pp | 43 +++++++++++++++++++++++++++++++++++++++
 tests/test/tarrpropol2.pp | 28 +++++++++++++++++++++++++
 tests/test/tarrpropol3.pp | 22 ++++++++++++++++++++
 tests/test/tarrpropol4.pp | 29 ++++++++++++++++++++++++++
 tests/test/tarrpropol5.pp | 23 +++++++++++++++++++++
 6 files changed, 160 insertions(+), 1 deletion(-)
 create mode 100644 tests/test/tarrpropol1.pp
 create mode 100644 tests/test/tarrpropol2.pp
 create mode 100644 tests/test/tarrpropol3.pp
 create mode 100644 tests/test/tarrpropol4.pp
 create mode 100644 tests/test/tarrpropol5.pp

diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 7ec3877ed7..a3566a56d3 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -1282,6 +1282,7 @@ implementation
         isclassref:boolean;
         isrecordtype:boolean;
         isobjecttype:boolean;
+        paras:tnode;
       begin
          if sym=nil then
            begin
@@ -1408,7 +1409,19 @@ implementation
                    begin
                       if isclassref and not (sp_static in sym.symoptions) then
                         Message(parser_e_only_class_members_via_class_ref);
-                      handle_propertysym(tpropertysym(sym),sym.owner,nil,p1);
+                      if ppo_hasparameters in tpropertysym(sym).propoptions then
+                        begin
+                          consume(_LECKKLAMMER);
+                          paras:=parse_paras(false,false,_RECKKLAMMER);
+                          consume(_RECKKLAMMER);
+                          sym:=search_default_property(tabstractrecorddef(p1.resultdef),paras);
+                          if assigned(sym) then
+                            handle_propertysym(tpropertysym(sym),sym.owner,paras,p1)
+                          else
+                            internalerror(2019062301);
+                        end
+                      else
+                        handle_propertysym(tpropertysym(sym),sym.owner,nil,p1);
                    end;
                  typesym:
                    begin
@@ -2095,6 +2108,7 @@ implementation
                  begin
                    { default property }
                    paras:=nil;
+                   protsym:=nil;
                    if oo_has_default_property in tabstractrecorddef(p1.resultdef).objectoptions then
                      begin
                        if try_to_consume(_LECKKLAMMER) then
diff --git a/tests/test/tarrpropol1.pp b/tests/test/tarrpropol1.pp
new file mode 100644
index 0000000000..9e8d6dc78d
--- /dev/null
+++ b/tests/test/tarrpropol1.pp
@@ -0,0 +1,43 @@
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+program tarrpropol1;
+
+type
+  TValue = TObject;
+  TList = record
+    function GetValueWithInt(index: integer): TValue;
+    function GetValueWithString(index: string): TValue;
+    function GetValueWithPair(index: integer; key: string): TValue;
+    property Values[index: integer]: TValue read GetValueWithInt; default;
+    property Values[index: string]: TValue read GetValueWithString; default;
+    property Values[index: integer; key: string]: TValue read GetValueWithPair; default;
+  end;
+
+function TList.GetValueWithInt(index: integer): TValue;
+begin
+  result := nil;  
+end;
+
+function TList.GetValueWithString(index: string): TValue;
+begin
+  result := nil;  
+end;
+
+function TList.GetValueWithPair(index: integer; key: string): TValue;
+begin
+  result := nil;  
+end;
+
+var
+  c: TList;
+  v: TValue;
+begin
+  v := c[1];
+  v := c['key'];
+  v := c[1,'key'];
+
+  v := c.values[1];
+  v := c.values['a'];
+  v := c.values[1, 'a'];
+end.
diff --git a/tests/test/tarrpropol2.pp b/tests/test/tarrpropol2.pp
new file mode 100644
index 0000000000..029704e2ef
--- /dev/null
+++ b/tests/test/tarrpropol2.pp
@@ -0,0 +1,28 @@
+{%FAIL}
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+program tarrpropol2;
+
+type
+  TValue = TObject;
+  TList = record
+    function GetValueWithInt(index: integer): TValue;
+    function GetValueWithString(index: string): TValue;
+    { all default properties must share the same name }
+    property Values0[index: integer]: TValue read GetValueWithInt; default;
+    property Values1[index: string]: TValue read GetValueWithString; default;
+  end;
+
+function TList.GetValueWithInt(index: integer): TValue;
+begin
+  result := nil;  
+end;
+
+function TList.GetValueWithString(index: string): TValue;
+begin
+  result := nil;  
+end;
+
+begin
+end.
diff --git a/tests/test/tarrpropol3.pp b/tests/test/tarrpropol3.pp
new file mode 100644
index 0000000000..55bd0cf269
--- /dev/null
+++ b/tests/test/tarrpropol3.pp
@@ -0,0 +1,22 @@
+{%FAIL}
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+program tarrpropol3;
+
+type
+  TValue = TObject;
+  TList = record
+    function GetValueWithInt(index: integer): TValue;
+    { default properties must have unique parameters }
+    property Values[index: integer]: TValue read GetValueWithInt; default;
+    property Values[index: integer]: TValue read GetValueWithInt; default;
+  end;
+
+function TList.GetValueWithInt(index: integer): TValue;
+begin
+  result := nil;  
+end;
+
+begin
+end.
diff --git a/tests/test/tarrpropol4.pp b/tests/test/tarrpropol4.pp
new file mode 100644
index 0000000000..fa6547852d
--- /dev/null
+++ b/tests/test/tarrpropol4.pp
@@ -0,0 +1,29 @@
+{%FAIL}
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+program tarrpropol4;
+
+type
+  TValue = TObject;
+  TList = record
+    function GetValueWithInt(index: integer): TValue;
+    function GetValueWithString(index: string): TValue;
+    { parametered properties still can't have duplicate names
+      to fix error make properties default }
+    property Values[index: integer]: TValue read GetValueWithInt;  
+    property Values[index: string]: TValue read GetValueWithString;
+  end;
+
+function TList.GetValueWithInt(index: integer): TValue;
+begin
+  result := nil;  
+end;
+
+function TList.GetValueWithString(index: string): TValue;
+begin
+  result := nil;  
+end;
+
+begin
+end.
diff --git a/tests/test/tarrpropol5.pp b/tests/test/tarrpropol5.pp
new file mode 100644
index 0000000000..a73f2c6c82
--- /dev/null
+++ b/tests/test/tarrpropol5.pp
@@ -0,0 +1,23 @@
+{%FAIL}
+{$mode objfpc}
+
+program tarrpropol5;
+
+type
+  TValue = TObject;
+
+function GetGlobalValueInt(index: integer): TValue;
+begin
+  result:=nil;
+end;
+
+function GetGlobalValueStr(index: string): TValue;
+begin
+  result:=nil;
+end;
+
+property Values[index: integer]: TValue read GetGlobalValueInt;
+property Values[index: string]: TValue read GetGlobalValueStr;
+
+begin
+end.
-- 
2.17.2 (Apple Git-113)


From 297cda638404e835c3b092b3fd96aded41cc7d6c Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Wed, 26 Jun 2019 13:51:49 -0400
Subject: [PATCH 4/4] Fixed bugs with unit tests regressions

---
 compiler/pdecobj.pas      | 84 +++++++++++++++++++++------------------
 compiler/pexpr.pas        | 37 ++++++++++++-----
 compiler/symtable.pas     | 20 ++++++----
 tests/test/tarrpropol5.pp |  1 +
 tests/test/tarrpropol6.pp | 28 +++++++++++++
 tests/test/tarrpropol7.pp | 65 ++++++++++++++++++++++++++++++
 6 files changed, 178 insertions(+), 57 deletions(-)
 create mode 100644 tests/test/tarrpropol6.pp
 create mode 100644 tests/test/tarrpropol7.pp

diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index 01ffcff1a0..458a59ad72 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -174,47 +174,54 @@ implementation
           eq: integer;
         begin
           sc:=p.parast;
-          for i := 0 to pd.symtable.SymList.Count-1 do
+          while assigned(pd) do
             begin
-              sym:=tsym(pd.symtable.SymList[i]);
-              if (sym.typ<>propertysym) or (sym=p) then
-                continue;
-
-              { non-default parametered properties must not have the same name }
-              if (ppo_hasparameters in tpropertysym(sym).propoptions) and
-                 not (ppo_defaultproperty in tpropertysym(sym).propoptions) then 
+              for i:=0 to pd.symtable.SymList.Count-1 do
                 begin
-                  MessagePos1(name_filepos,sym_e_duplicate_id,p.realname);
-                  exit;
-                end
-              else if ppo_defaultproperty in tpropertysym(sym).propoptions then
-                begin
-                  { all default properties must share the same name }
-                  if sym.realname<>p.realname then
-                    begin
-                      writeln('*** all default properties must share the same name');
-                      message(parser_e_only_one_default_property);
-                      exit;
-                    end;
-                  { default properties must have unique parameters }
-                  st:=tpropertysym(sym).parast;
-                  if st.symlist.count<>sc.SymList.count then
+                  sym:=tsym(pd.symtable.SymList[i]);
+                  { ignore non-properties, the same property or properties in different object }
+                  if (sym.typ<>propertysym) or (sym=p) or (p.owner<>sym.owner) then
                     continue;
-                  eq:=0;
-                  for paraindex := 0 to sc.SymList.count-1 do
-                    begin
-                      from_para:=tparavarsym(st.SymList[paraindex]);
-                      to_para:=tparavarsym(sc.SymList[paraindex]);
-                      if compare_defs(from_para.vardef,to_para.vardef,nothingn)>=te_convert_l1 then
-                        inc(eq);
-                    end;
-                  if eq=sc.SymList.count then
+
+                  { non-default parametered properties must not have the same name }
+                  if (ppo_hasparameters in tpropertysym(sym).propoptions) and
+                     not (ppo_defaultproperty in tpropertysym(sym).propoptions) and
+                     (p.name=sym.name) then 
                     begin
-                      writeln('*** default properties must have unique parameters');
-                      message(parser_e_only_one_default_property);
+                      MessagePos1(name_filepos,sym_e_duplicate_id,p.realname);
                       exit;
-                    end;
-                end;   
+                    end
+                  else if ppo_defaultproperty in tpropertysym(sym).propoptions then
+                    begin
+                      { all default properties must share the same name }
+                      if sym.name<>p.name then
+                        begin
+                          message(parser_e_only_one_default_property);
+                          exit;
+                        end;
+                      { default properties must have unique parameters }
+                      st:=tpropertysym(sym).parast;
+                      if st.symlist.count<>sc.SymList.count then
+                        continue;
+                      eq:=0;
+                      for paraindex := 0 to sc.SymList.count-1 do
+                        begin
+                          from_para:=tparavarsym(st.SymList[paraindex]);
+                          to_para:=tparavarsym(sc.SymList[paraindex]);
+                          if compare_defs(from_para.vardef,to_para.vardef,nothingn)>=te_convert_l3 then
+                            inc(eq);
+                        end;
+                      if eq=sc.SymList.count then
+                        begin
+                          message(parser_e_only_one_default_property);
+                          exit;
+                        end;
+                    end;   
+                end;
+              if pd.typ=objectdef then
+                pd:=tobjectdef(pd).childof
+              else
+                pd:=nil;
             end;
         end;
       
@@ -223,7 +230,7 @@ implementation
           i: integer;
           sym: tsym;
         begin
-          for i := 0 to pd.symtable.SymList.Count-1 do
+          for i:=0 to pd.symtable.SymList.Count-1 do
             begin
               sym:=tsym(pd.symtable.SymList[i]);
               if (sym<>p) and
@@ -263,7 +270,8 @@ implementation
               end;
             consume(_SEMICOLON);
           end
-        { properties with paramters that not default can't have duplicate names }
+        { properties with paramters that are not default can't have duplicate names
+          we need to check again here because }
         else if (ppo_hasparameters in p.propoptions) then
           check_duplicate_parametered_property(current_structdef,p,name_filepos);
         { parse possible enumerator modifier }
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index a3566a56d3..a87a17fb34 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -1283,6 +1283,7 @@ implementation
         isrecordtype:boolean;
         isobjecttype:boolean;
         paras:tnode;
+        bestsym:tsym;
       begin
          if sym=nil then
            begin
@@ -1409,16 +1410,16 @@ implementation
                    begin
                       if isclassref and not (sp_static in sym.symoptions) then
                         Message(parser_e_only_class_members_via_class_ref);
-                      if ppo_hasparameters in tpropertysym(sym).propoptions then
+                      if ppo_defaultproperty in tpropertysym(sym).propoptions then
                         begin
                           consume(_LECKKLAMMER);
                           paras:=parse_paras(false,false,_RECKKLAMMER);
                           consume(_RECKKLAMMER);
-                          sym:=search_default_property(tabstractrecorddef(p1.resultdef),paras);
-                          if assigned(sym) then
-                            handle_propertysym(tpropertysym(sym),sym.owner,paras,p1)
+                          bestsym:=search_default_property(structh,paras,sym.name);
+                          if assigned(bestsym) then
+                            handle_propertysym(tpropertysym(bestsym),bestsym.owner,paras,p1)
                           else
-                            internalerror(2019062301);
+                            handle_propertysym(tpropertysym(sym),sym.owner,paras,p1);
                         end
                       else
                         handle_propertysym(tpropertysym(sym),sym.owner,nil,p1);
@@ -2031,6 +2032,7 @@ implementation
      spezcontext : tspecializationcontext;
      old_current_filepos : tfileposinfo;
      paras : tnode;
+     has_default_property: boolean;
     label
      skipreckklammercheck,
      skippointdefcheck;
@@ -2109,17 +2111,30 @@ implementation
                    { default property }
                    paras:=nil;
                    protsym:=nil;
-                   if oo_has_default_property in tabstractrecorddef(p1.resultdef).objectoptions then
+                   { search hierarchy for default properties }
+                   has_default_property:=false;
+                   structh:=tabstractrecorddef(p1.resultdef);
+                   while assigned(structh) do
                      begin
-                       if try_to_consume(_LECKKLAMMER) then
+                       if oo_has_default_property in structh.objectoptions then
                          begin
-                           paras:=parse_paras(false,false,_RECKKLAMMER);
-                           consume(_RECKKLAMMER);
-                           protsym:=search_default_property(tabstractrecorddef(p1.resultdef),paras);
+                           has_default_property:=true;
+                           break;
                          end;
+                       if structh.typ=objectdef then
+                         structh:=tobjectdef(structh).childof
+                       else
+                         structh:=nil;
+                     end;
+                   if has_default_property then
+                     begin
+                       consume(_LECKKLAMMER);
+                       paras:=parse_paras(false,false,_RECKKLAMMER);
+                       consume(_RECKKLAMMER);
+                       protsym:=search_default_property(tabstractrecorddef(p1.resultdef),paras);
                      end
                    else
-                     protsym:=search_default_property(tabstractrecorddef(p1.resultdef),nil);
+                     protsym:=search_default_property(tabstractrecorddef(p1.resultdef));
                    if not(assigned(protsym)) then
                      begin
                         p1.destroy;
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 376ea60a7c..628def918c 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -386,7 +386,7 @@ interface
     function get_objectpascal_helpers(pd : tdef):TFPObjectList;
 
 {*** Object Helpers ***}
-    function search_default_property(pd : tabstractrecorddef; paras: pointer) : tpropertysym;
+    function search_default_property(pd : tabstractrecorddef; paras: pointer=nil; name: shortstring='') : tpropertysym;
     function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef;
     function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
 
@@ -4488,9 +4488,9 @@ implementation
                               Object Helpers
 ****************************************************************************}
 
-   function search_default_property(pd : tabstractrecorddef; paras: pointer) : tpropertysym;
+   function search_default_property(pd : tabstractrecorddef; paras: pointer=nil; name: shortstring='') : tpropertysym;
      
-     function find_best_property(pd: tabstractrecorddef; paras: tcallparanode): tpropertysym;
+     function find_best_property(pd:tabstractrecorddef; paras:tcallparanode; name:shortstring): tpropertysym;
        var
          i: integer;
          sym: tsym;
@@ -4506,11 +4506,15 @@ implementation
          while assigned(pt) do
            begin
              pt:=tcallparanode(pt.nextpara);
-             paracount:=paracount+1;
+             inc(paracount);
            end;
-         for i := 0 to pd.symtable.SymList.Count-1 do
+         for i:=0 to pd.symtable.SymList.Count-1 do
            begin
              sym:=tsym(pd.symtable.SymList[i]);
+             { rejected symbol for named searches }
+             if (name<>'') and (sym.name<>name) then
+               continue;
+             { filter default properties }
              if (sym.typ=propertysym) and
                 (ppo_defaultproperty in tpropertysym(sym).propoptions) then
                begin
@@ -4526,7 +4530,7 @@ implementation
                      { paranodes are in reverse order so we need to access
                        the symtable list from back to front }
                      parasym:=tparavarsym(st.symlist[(st.symlist.count-1)-paraindex]);
-                     if compare_defs(pt.paravalue.resultdef,parasym.vardef,nothingn)>=te_convert_l1 then
+                     if compare_defs(pt.paravalue.resultdef,parasym.vardef,nothingn)>=te_convert_l5 then
                        inc(eq);
                      { next parameter in the call tree }
                      pt:=tcallparanode(pt.nextpara);
@@ -4551,7 +4555,7 @@ implementation
         if search_last_objectpascal_helper(pd,nil,helperpd) then
           while assigned(helperpd) do
             begin
-              _defaultprop:=find_best_property(pd,tcallparanode(paras));
+              _defaultprop:=find_best_property(helperpd,tcallparanode(paras),name);
               if assigned(_defaultprop) then
                 break;
               helperpd:=helperpd.childof;
@@ -4564,7 +4568,7 @@ implementation
         { now search in the type's hierarchy itself }
         while assigned(pd) do
           begin
-             _defaultprop:=find_best_property(pd,tcallparanode(paras));
+             _defaultprop:=find_best_property(pd,tcallparanode(paras),name);
              if assigned(_defaultprop) then
                break;
              if (pd.typ=objectdef) then
diff --git a/tests/test/tarrpropol5.pp b/tests/test/tarrpropol5.pp
index a73f2c6c82..8fe81176dc 100644
--- a/tests/test/tarrpropol5.pp
+++ b/tests/test/tarrpropol5.pp
@@ -16,6 +16,7 @@ begin
   result:=nil;
 end;
 
+{ make sure global properties aren't affect by changes }
 property Values[index: integer]: TValue read GetGlobalValueInt;
 property Values[index: string]: TValue read GetGlobalValueStr;
 
diff --git a/tests/test/tarrpropol6.pp b/tests/test/tarrpropol6.pp
new file mode 100644
index 0000000000..5f220c0a65
--- /dev/null
+++ b/tests/test/tarrpropol6.pp
@@ -0,0 +1,28 @@
+{%FAIL}
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+program tarrpropol6;
+
+type
+  TValue = TObject;
+  TList = record
+    function GetValueWithInt(index: integer): TValue;
+    function GetValueWithWord(index: word): TValue;
+    { default properties must have unique parameters }
+    property Values[index: integer]: TValue read GetValueWithInt; default;
+    property Values[index: word]: TValue read GetValueWithWord; default;
+  end;
+
+function TList.GetValueWithInt(index: integer): TValue;
+begin
+  result := nil;  
+end;
+
+function TList.GetValueWithWord(index: word): TValue;
+begin
+  result := nil;  
+end;
+
+begin
+end.
diff --git a/tests/test/tarrpropol7.pp b/tests/test/tarrpropol7.pp
new file mode 100644
index 0000000000..dc87035dc9
--- /dev/null
+++ b/tests/test/tarrpropol7.pp
@@ -0,0 +1,65 @@
+{$mode objfpc}
+
+
+program tarrpropol7;
+
+var
+  LastProc: integer = 0;
+
+type
+  TValue = TObject;
+  TBase = class
+    function GetValue(index: integer): TValue;
+    property Values[index: integer]: TValue read GetValue; default;
+  end;
+  
+  function TBase.GetValue(index: integer): TValue;
+  begin
+    LastProc := 1;
+    result := nil;  
+  end;
+
+type
+  TList = class(TBase)
+    function GetAnotherValue(index: integer): TValue;
+    function GetAnotherValue(index: string): TValue;
+    { you can declare another default property of a different name
+      if it's in a child object }
+    property MoreValues[index: integer]: TValue read GetAnotherValue; default;
+    property MoreValues[index: string]: TValue read GetAnotherValue; default;
+  end;
+
+  function TList.GetAnotherValue(index: integer): TValue;
+  begin
+    LastProc := 2;
+    result := nil;  
+  end;
+
+  function TList.GetAnotherValue(index: string): TValue;
+  begin
+    LastProc := 3;
+    result := nil;  
+  end;
+
+procedure Test(value: TValue; desired: integer);
+begin
+  if LastProc <> desired then
+    begin
+      writeln('FAILED');
+      Halt(-1);
+    end;
+end;
+
+var
+  c: TList;
+  v: TValue;
+begin
+  { normal defaults }
+  Test(c[1], 2);
+  Test(c['key'], 3);
+
+  { named default access }
+  Test(c.Values[1], 1);
+  Test(c.MoreValues[1], 2);
+  Test(c.MoreValues['key'], 3);
+end.
-- 
2.17.2 (Apple Git-113)

Michael Van Canneyt

2019-06-26 23:35

administrator   ~0116949

Nice work.

The ability to overload should be for all arrays, not just default ones.

Ryan Joseph

2019-06-27 00:22

reporter   ~0116951

ok, I'll make that change.

Awkward

2019-06-27 06:33

reporter   ~0116956

Isn't array property can be overloaded long time ago? i use declaration like this:
  tINIFile = object
  private
    procedure SetAsText( akey:PAnsiChar;val:PAnsiChar); overload;
    procedure SetAsText( asection,akey:PAnsiChar;val:PAnsiChar); overload;
    procedure SetAsText(ans,asection,akey:PAnsiChar;val:PAnsiChar); overload;

    function GetAsText( akey:PAnsiChar):PAnsiChar; overload;
    function GetAsText( asection,akey:PAnsiChar):PAnsiChar; overload;
    function GetAsText(ans,asection,akey:PAnsiChar):PAnsiChar; overload;
  public
    property Value [ans:PAnsiChar; asection:PAnsiChar; akey:PAnsiChar]:PAnsiChar
             read GetAsText write SetAsText; default;
  end;

Ryan Joseph

2019-06-27 15:17

reporter   ~0116966

Hey you're right! There's still the matter of Delphi compatibility (https://bugs.freepascal.org/view.php?id=29056) but I guess this needs more discussion.

Michael Van Canneyt

2019-06-27 15:30

administrator   ~0116967

@awkward
I think this behaviour is by accident.
if you try to explicitly declare the Value array property twice with the correct amount of indexes in the array, it fails.
  TObj = class
    Procedure SetA(Index : String; aValue : string);
    Procedure SetA(Index : integer; aValue : string);
    function GetA (I : Integer) : String;
    function GetA (S : String) : String;
    Property A [Index : Integer] : String Read GetA Write SetA;
    Property A [Index : String] : String Read GetA Write SetA;
   end;
and
  TObj = class
    Procedure SetS(Index : String; aValue : string);
    Procedure SetI(Index : integer; aValue : string);
    function GetI (I : Integer) : String;
    function GetS(S : String) : String;
    Property A [Index : Integer] : String Read GetI Write SetI;
    Property A [Index : String] : String Read GetS Write SetS;
   end;

both fail.

Ryan Joseph

2019-06-27 15:40

reporter   ~0116968

Yeah I just played with it and I agree it's probably by accident.

Ryan Joseph

2019-06-27 18:03

reporter   ~0116969

I made the requested changes but found a new problem. If you build from https://github.com/genericptr/freepascal/tree/array_prop_overload and try to run the tests suite you'll get an error:

ghashset.pp(130,39) Fatal: Internal error 2019062701

This is because the parameter passed to the default property is an error node so I didn't know how to resolve it. Previously there was only one default so it just chose that one but now I need to test for parameters in advance (see search_parametered_property).

Does anyone know why ghashset.pp used to compile or how I should handle the error?

Akira1364

2019-06-27 23:15

reporter   ~0116978

Last edited: 2019-06-27 23:15

View 2 revisions

That line in ghashset.pp looks like this:

(FData[Thash.hash(value,FData.size)]).pushback(value);

FData is an instance of TVector from gvector.pp, which has a default property "Items" indexed by SizeUInt that gets and sets instances of the vector's generic "T".

THash is a completely generic parameter of THashSet (THashSet being defined like "THashSet<T, THash>"), which I believe is supposed to be implemented as something roughly like:

TMyHash<T> = class
public
  class function Hash(const Val: T, const N: SizeUInt): SizeUInt; static;
end;

So I don't think it's mysterious that it worked previously, at least. Just a pretty normal default generic property.

Ryan Joseph

2019-06-27 23:25

reporter   ~0116979

The problem is that the parameter "Thash.hash(value,FData.size)]" is coming in as an error node (I think that's what's happening anyways). I put the error code 2019062701 in there so you can see. Maybe the error node got resolved after the default property was returned?

Akira1364

2019-06-27 23:44

reporter   ~0116980

Seems like it would have to be.

I think it's the same sort of thing you ran into with your generic constants branch, where you had to explicitly *not* range-check the constants before they were actually specialized with something concrete.

Ryan Joseph

2019-06-28 16:56

reporter   ~0116994

Ok, I think I fixed the problem with generic parameters by stopping the search if the error node is encountered and using the first default found. For normal function overloading this step must be deferred until after the type is specialized but for properties it happens immediately after parsing. The result is that if you want overloading to choose the correct property using generic parameters you need to typecast the value to the type you intend.

For example if the previous mentioned error you would may want to do cast to SizeUInt, although in this example there's only default so the correct one will be chosen regardless.

(FData[SizeUInt(Thash.hash(value,FData.size))]).pushback(value);

patch_6_28.diff (29,318 bytes)
From c7f8cd7cdb7d8221f21345fb57b42ba3c13d5b84 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Fri, 21 Jun 2019 09:32:36 -0400
Subject: [PATCH] array property overloads

---
 compiler/pdecobj.pas      |  92 ++++++++++++++++++++++++++++++++--
 compiler/pdecvar.pas      |  23 ++++++---
 compiler/pexpr.pas        |  36 ++++++++++---
 compiler/symtable.pas     | 103 +++++++++++++++++++++++++++++---------
 tests/test/tarrpropol1.pp | 103 ++++++++++++++++++++++++++++++++++++++
 tests/test/tarrpropol2.pp |  28 +++++++++++
 tests/test/tarrpropol3.pp |  22 ++++++++
 tests/test/tarrpropol4.pp |  24 +++++++++
 tests/test/tarrpropol5.pp |  28 +++++++++++
 tests/test/tarrpropol6.pp |  50 ++++++++++++++++++
 tests/test/tarrpropol7.pp |  64 +++++++++++++++++++++++
 tests/test/tarrpropol8.pp |  28 +++++++++++
 12 files changed, 559 insertions(+), 42 deletions(-)
 create mode 100644 tests/test/tarrpropol1.pp
 create mode 100644 tests/test/tarrpropol2.pp
 create mode 100644 tests/test/tarrpropol3.pp
 create mode 100644 tests/test/tarrpropol4.pp
 create mode 100644 tests/test/tarrpropol5.pp
 create mode 100644 tests/test/tarrpropol6.pp
 create mode 100644 tests/test/tarrpropol7.pp
 create mode 100644 tests/test/tarrpropol8.pp

diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index 64e948a106..3d17971bcd 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -163,8 +163,90 @@ implementation
 
 
     procedure struct_property_dec(is_classproperty:boolean);
+       
+      function compare_paras(sym: tpropertysym;parasymtable: tsymtable): boolean;
+        var
+          st: tsymtable;
+          paraindex: integer;
+          from_para, to_para: tparavarsym;
+          eq: integer;
+        begin
+          st:=tpropertysym(sym).parast;
+          if st.symlist.count<>parasymtable.SymList.count then
+            exit(false);
+          eq:=0;
+          for paraindex := 0 to parasymtable.SymList.count-1 do
+            begin
+              from_para:=tparavarsym(st.SymList[paraindex]);
+              to_para:=tparavarsym(parasymtable.SymList[paraindex]);
+              if compare_defs(from_para.vardef,to_para.vardef,nothingn)>=te_convert_l5 then
+                inc(eq);
+            end;
+          result:=(eq=parasymtable.SymList.count);
+        end;
+
+      procedure check_parametered_property(pd: tabstractrecorddef; p: tpropertysym; name_filepos: tfileposinfo);
+        var
+          i: integer;
+          sym: tsym;
+          st,sc: tsymtable;
+          paraindex: integer;
+          from_para, to_para: tparavarsym;
+          eq: integer;
+        begin
+          sc:=p.parast;
+          while assigned(pd) do
+            begin
+              for i:=0 to pd.symtable.SymList.Count-1 do
+                begin
+                  sym:=tsym(pd.symtable.SymList[i]);
+                  { ignore non-properties, the same property or properties in different object }
+                  if (sym.typ<>propertysym) or (sym=p) or (p.owner<>sym.owner) then
+                    continue;
+                  { default properties must have unique parameters }
+                  if (ppo_defaultproperty in p.propoptions) and (ppo_defaultproperty in tpropertysym(sym).propoptions) then
+                    begin
+                      { all default properties must share the same name }
+                      if sym.name<>p.name then
+                        begin
+                          message(parser_e_only_one_default_property);
+                          exit;
+                        end;
+                      if compare_paras(tpropertysym(sym),sc) then
+                        begin
+                          // TODO: overloaded property parameters must be unique
+                          message(parser_e_only_one_default_property);
+                          exit;
+                        end
+                      else
+                        continue;
+                    end
+                  { non-default parametered properties that have the same name
+                    must have unique parameters }
+                  else if not(ppo_defaultproperty in p.propoptions) and 
+                             (ppo_hasparameters in tpropertysym(sym).propoptions) and
+                             (sym.name=p.name) then
+                    begin
+                      if compare_paras(tpropertysym(sym),sc) then
+                        begin
+                          // TODO: property parametesr must be unique
+                          message(parser_e_only_one_default_property);
+                          exit;
+                        end
+                      else
+                        continue;
+                    end;
+                end;
+              if pd.typ=objectdef then
+                pd:=tobjectdef(pd).childof
+              else
+                pd:=nil;
+            end;
+        end;
+
       var
         p : tpropertysym;
+        name_filepos: tfileposinfo;
       begin
         { check for a class, record or helper }
         if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef) or
@@ -172,14 +254,13 @@ implementation
                (not(m_tp7 in current_settings.modeswitches) and (is_object(current_structdef)))) then
           Message(parser_e_syntax_error);
         consume(_PROPERTY);
-        p:=read_property_dec(is_classproperty,current_structdef);
+        p:=read_property_dec(is_classproperty,current_structdef,@name_filepos);
         consume(_SEMICOLON);
         if try_to_consume(_DEFAULT) then
           begin
-            if oo_has_default_property in current_structdef.objectoptions then
-              message(parser_e_only_one_default_property);
             include(current_structdef.objectoptions,oo_has_default_property);
             include(p.propoptions,ppo_defaultproperty);
+            check_parametered_property(current_structdef,p,name_filepos);
             if not(ppo_hasparameters in p.propoptions) then
               message(parser_e_property_need_paras);
             if (token=_COLON) then
@@ -188,7 +269,10 @@ implementation
                 consume_all_until(_SEMICOLON);
               end;
             consume(_SEMICOLON);
-          end;
+          end
+        else if (ppo_hasparameters in p.propoptions) then
+          check_parametered_property(current_structdef,p,name_filepos);
+
         { parse possible enumerator modifier }
         if try_to_consume(_ENUMERATOR) then
           begin
diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas
index 597249fd71..6ff2cbf5ef 100644
--- a/compiler/pdecvar.pas
+++ b/compiler/pdecvar.pas
@@ -27,14 +27,14 @@ unit pdecvar;
 interface
 
     uses
-      cclasses,
+      globtype,cclasses,
       symtable,symsym,symdef,symtype;
 
     type
       tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class,vd_final,vd_canreorder,vd_check_generic);
       tvar_dec_options=set of tvar_dec_option;
 
-    function  read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
+    function  read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef;name_filepos:pfileposinfo=nil):tpropertysym;
 
     procedure read_var_decls(options:Tvar_dec_options;out had_generic:boolean);
 
@@ -53,7 +53,7 @@ implementation
        { common }
        cutils,
        { global }
-       globtype,globals,tokens,verbose,constexp,
+       globals,tokens,verbose,constexp,
        systems,
        { symtable }
        symconst,symbase,defutil,defcmp,symutil,symcreat,
@@ -71,7 +71,7 @@ implementation
        pbase,pexpr,ptype,ptconst,pdecsub,pparautl;
 
 
-    function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
+    function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef;name_filepos:pfileposinfo=nil):tpropertysym;
 
         { convert a node tree to symlist and return the last
           symbol }
@@ -333,7 +333,7 @@ implementation
                   create_accessor_procsym(p,writepd,'put$',palt_write);
                 end;
             end;
-
+            
       var
          sym : tsym;
          srsymtable: tsymtable;
@@ -384,11 +384,18 @@ implementation
          p.default:=longint($80000000);
          if is_classproperty then
            include(p.symoptions, sp_static);
-         symtablestack.top.insert(p);
          consume(_ID);
+         if assigned(name_filepos) then
+           name_filepos^:=current_filepos;
          { property parameters ? }
          if try_to_consume(_LECKKLAMMER) then
            begin
+              { paramtered properties in structs can be default and
+                potentially allow duplicate names for overloading }
+              if assigned(astruct) then
+                symtablestack.top.insert(p,false)
+              else
+                symtablestack.top.insert(p);
               if (p.visibility=vis_published) and
                 not (m_delphi in current_settings.modeswitches) then
                 Message(parser_e_cant_publish_that_property);
@@ -446,7 +453,9 @@ implementation
                   p.add_accessor_parameters(readprocdef,writeprocdef);
                   include(p.propoptions,ppo_hasparameters);
                 end;
-           end;
+           end
+         else
+           symtablestack.top.insert(p);
          { overridden property ?                                 }
          { force property interface
              there is a property parameter
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 022aa2a294..44e413244c 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -1151,9 +1151,8 @@ implementation
 
 
     { the following procedure handles the access to a property symbol }
-    procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;var p1 : tnode);
+    procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;paras : tnode;var p1 : tnode);
       var
-         paras : tnode;
          p2    : tnode;
          membercall : boolean;
          callflags  : tcallnodeflags;
@@ -1162,8 +1161,7 @@ implementation
       begin
          { property parameters? read them only if the property really }
          { has parameters                                             }
-         paras:=nil;
-         if (ppo_hasparameters in propsym.propoptions) then
+         if not assigned(paras) and (ppo_hasparameters in propsym.propoptions) then
            begin
              if try_to_consume(_LECKKLAMMER) then
                begin
@@ -1284,6 +1282,8 @@ implementation
         isclassref:boolean;
         isrecordtype:boolean;
         isobjecttype:boolean;
+        paras:tnode;
+        bestsym:tsym;
       begin
          if sym=nil then
            begin
@@ -1410,7 +1410,19 @@ implementation
                    begin
                       if isclassref and not (sp_static in sym.symoptions) then
                         Message(parser_e_only_class_members_via_class_ref);
-                      handle_propertysym(tpropertysym(sym),sym.owner,p1);
+                      if ppo_hasparameters in tpropertysym(sym).propoptions then
+                        begin
+                          consume(_LECKKLAMMER);
+                          paras:=parse_paras(false,false,_RECKKLAMMER);
+                          consume(_RECKKLAMMER);
+                          bestsym:=search_parametered_property(structh,paras,sym.name);
+                          if assigned(bestsym) then
+                            handle_propertysym(tpropertysym(bestsym),bestsym.owner,paras,p1)
+                          else
+                            handle_propertysym(tpropertysym(sym),sym.owner,paras,p1);
+                        end
+                      else
+                        handle_propertysym(tpropertysym(sym),sym.owner,nil,p1);
                    end;
                  typesym:
                    begin
@@ -2019,6 +2031,7 @@ implementation
      strdef : tdef;
      spezcontext : tspecializationcontext;
      old_current_filepos : tfileposinfo;
+     paras : tnode;
     label
      skipreckklammercheck,
      skippointdefcheck;
@@ -2095,7 +2108,14 @@ implementation
                   is_javaclass(p1.resultdef) then
                  begin
                    { default property }
-                   protsym:=search_default_property(tabstractrecorddef(p1.resultdef));
+                   paras:=nil;
+                   protsym:=nil;
+                   if try_to_consume(_LECKKLAMMER) then
+                     begin
+                       paras:=parse_paras(false,false,_RECKKLAMMER);
+                       consume(_RECKKLAMMER);
+                       protsym:=search_parametered_property(tabstractrecorddef(p1.resultdef),paras);
+                     end;
                    if not(assigned(protsym)) then
                      begin
                         p1.destroy;
@@ -2107,7 +2127,7 @@ implementation
                      begin
                        { The property symbol is referenced indirect }
                        protsym.IncRefCount;
-                       handle_propertysym(protsym,protsym.owner,p1);
+                       handle_propertysym(protsym,protsym.owner,paras,p1);
                      end;
                  end
                else
@@ -3277,7 +3297,7 @@ implementation
                     else
                     { no method pointer }
                       begin
-                        handle_propertysym(tpropertysym(srsym),srsymtable,p1);
+                        handle_propertysym(tpropertysym(srsym),srsymtable,nil,p1);
                       end;
                   end;
 
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 305d39904a..5d2de1ef02 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -73,7 +73,6 @@ interface
           procedure checklabels;
           function  needs_init_final : boolean; virtual;
           function  has_non_trivial_init:boolean;virtual;
-          procedure testfordefaultproperty(sym:TObject;arg:pointer);
           procedure register_children;
        end;
 
@@ -387,7 +386,7 @@ interface
     function get_objectpascal_helpers(pd : tdef):TFPObjectList;
 
 {*** Object Helpers ***}
-    function search_default_property(pd : tabstractrecorddef) : tpropertysym;
+    function search_parametered_property(pd : tabstractrecorddef; paras: pointer=nil; name: shortstring='') : tpropertysym;
     function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef;
     function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
 
@@ -485,7 +484,9 @@ implementation
       { ppu }
       entfile,
       { parser }
-      scanner
+      scanner,
+      { node }
+      node,ncal
       ;
 
 
@@ -1045,15 +1046,6 @@ implementation
            tabstractrecorddef(ttypesym(sym).typedef).symtable.SymList.ForEachCall(@TestPrivate,nil);
       end;
 
-
-   procedure tstoredsymtable.testfordefaultproperty(sym:TObject;arg:pointer);
-     begin
-        if (tsym(sym).typ=propertysym) and
-           (ppo_defaultproperty in tpropertysym(sym).propoptions) then
-          ppointer(arg)^:=sym;
-     end;
-
-
    procedure tstoredsymtable.register_children;
      begin
        SymList.ForEachCall(@register_syms,nil);
@@ -4496,39 +4488,104 @@ implementation
                               Object Helpers
 ****************************************************************************}
 
-   function search_default_property(pd : tabstractrecorddef) : tpropertysym;
-   { returns the default property of a class, searches also anchestors }
+   function search_parametered_property(pd : tabstractrecorddef; paras: pointer=nil; name: shortstring='') : tpropertysym;
+     
+     function find_best_property(pd:tabstractrecorddef; paras:tcallparanode; name:shortstring): tpropertysym;
+       var
+         i: integer;
+         sym: tsym;
+         st: tsymtable;
+         pt: tcallparanode;
+         paraindex, paracount: integer;
+         parasym: tparavarsym;
+         eq: integer;
+       begin 
+         result:=nil;
+         pt:=tcallparanode(paras);
+         paracount:=0;
+         while assigned(pt) do
+           begin
+             pt:=tcallparanode(pt.nextpara);
+             inc(paracount);
+           end;
+         for i:=0 to pd.symtable.SymList.Count-1 do
+           begin
+             sym:=tsym(pd.symtable.SymList[i]);
+             { rejected symbol for named searches }
+             if (name<>'') and (sym.name<>name) then
+               continue;
+             { filter properties by default or name }
+             if (sym.typ=propertysym) and
+                ((name='') and (ppo_defaultproperty in tpropertysym(sym).propoptions) or
+                 (name<>'') and (ppo_hasparameters in tpropertysym(sym).propoptions)) then
+               begin
+                 st:=tpropertysym(sym).parast;
+                 { parameter count must match }
+                 if st.symlist.count<>paracount then
+                   continue;
+                 pt:=tcallparanode(paras);
+                 paraindex:=0;
+                 eq:=0;
+                 while assigned(pt) do
+                   begin
+                     { paranodes are in reverse order so we need to access
+                       the symtable list from back to front }
+                     parasym:=tparavarsym(st.symlist[(st.symlist.count-1)-paraindex]);
+                     { if the paramter is an error node this may mean that
+                       we are working with a generic paramter or an unspecialized
+                       generic type. because it's not possible to choose the correct
+                       overload will simply return the first default.  }
+                     if pt.paravalue.nodetype=errorn then
+                       begin
+                         result:=tpropertysym(sym);
+                         exit;
+                       end;
+                     if compare_defs(pt.paravalue.resultdef,parasym.vardef,nothingn)>=te_convert_l5 then
+                       inc(eq);
+                     { next parameter in the call tree }
+                     pt:=tcallparanode(pt.nextpara);
+                     paraindex:=paraindex+1;
+                   end;
+                 if eq=paracount then
+                   begin
+                     result:=tpropertysym(sym);
+                     exit;
+                   end;
+               end;
+           end;
+       end;
+
      var
-       _defaultprop : tpropertysym;
+       found : tpropertysym;
        helperpd : tobjectdef;
      begin
-        _defaultprop:=nil;
+        found:=nil;
         { first search in helper's hierarchy }
         if search_last_objectpascal_helper(pd,nil,helperpd) then
           while assigned(helperpd) do
             begin
-              helperpd.symtable.SymList.ForEachCall(@tstoredsymtable(helperpd.symtable).testfordefaultproperty,@_defaultprop);
-              if assigned(_defaultprop) then
+              found:=find_best_property(helperpd,tcallparanode(paras),name);
+              if assigned(found) then
                 break;
               helperpd:=helperpd.childof;
             end;
-        if assigned(_defaultprop) then
+        if assigned(found) then
           begin
-            search_default_property:=_defaultprop;
+            result:=found;
             exit;
           end;
         { now search in the type's hierarchy itself }
         while assigned(pd) do
           begin
-             pd.symtable.SymList.ForEachCall(@tstoredsymtable(pd.symtable).testfordefaultproperty,@_defaultprop);
-             if assigned(_defaultprop) then
+             found:=find_best_property(pd,tcallparanode(paras),name);
+             if assigned(found) then
                break;
              if (pd.typ=objectdef) then
                pd:=tobjectdef(pd).childof
              else
                break;
           end;
-        search_default_property:=_defaultprop;
+        result:=found;
      end;
 
 
diff --git a/tests/test/tarrpropol1.pp b/tests/test/tarrpropol1.pp
new file mode 100644
index 0000000000..68bc885250
--- /dev/null
+++ b/tests/test/tarrpropol1.pp
@@ -0,0 +1,103 @@
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+program tarrpropol1;
+
+var
+  LastProc: integer = 0;
+
+type
+  TValue = TObject;
+  TList = record
+    function GetValue(index: integer): TValue; overload;
+    function GetValue(index: string): TValue; overload;
+    function GetValue(index: integer; key: string): TValue; overload;
+    procedure SetValue(index: integer; value: TValue); overload;
+    procedure SetValue(index: string; value: TValue); overload;
+    procedure SetValue(index: integer; key: string; value: TValue); overload;
+    { default properties }
+    property Values[index: integer]: TValue read GetValue write SetValue; default;
+    property Values[index: string]: TValue read GetValue write SetValue; default;
+    property Values[index: integer; key: string]: TValue read GetValue write SetValue; default;
+    { paramatered proprerties }
+    property Values0[index: integer]: TValue read GetValue write SetValue;
+    property Values0[index: string]: TValue read GetValue write SetValue;
+    property Values0[index: integer; key: string]: TValue read GetValue write SetValue;
+  end;
+
+function TList.GetValue(index: integer): TValue;
+begin
+  LastProc := 1;
+  result := nil;  
+end;
+
+function TList.GetValue(index: string): TValue;
+begin
+  LastProc := 2;
+  result := nil;  
+end;
+
+function TList.GetValue(index: integer; key: string): TValue;
+begin
+  LastProc := 3;
+  result := nil;  
+end;
+
+procedure TList.SetValue(index: integer; value: TValue);
+begin
+  LastProc := 4;
+end;
+
+procedure TList.SetValue(index: string; value: TValue);
+begin
+  LastProc := 5;
+end;
+
+procedure TList.SetValue(index: integer; key: string; value: TValue);
+begin
+  LastProc := 6;
+end;
+
+procedure Require(desired: integer);
+begin
+  if LastProc <> desired then
+    begin
+      writeln('FAILED');
+      Halt(-1);
+    end;
+end;
+
+procedure Test(const value: TValue; desired: integer);
+begin
+  Require(desired);
+end;
+
+var
+  c: TList;
+  v: TValue;
+begin
+  // setters (default)
+  c[1] := v;                  Require(4);
+  c['key'] := v;              Require(5);
+  c[1,'key'] := v;            Require(6);
+
+  // setters (named)
+  c.values[1] := v;           Require(4);
+  c.values['key'] := v;       Require(5);
+  c.values[1,'key'] := v;     Require(6);
+
+  // getters (default)
+  Test(c[1], 1);
+  Test(c['key'], 2);
+  Test(c[1,'key'], 3);
+
+  // getters (named)
+  Test(c.values[1], 1);
+  Test(c.values['a'], 2);
+  Test(c.values[1, 'a'], 3);
+
+  // getters (named, non-default)
+  Test(c.values0[1], 1);
+  Test(c.values0['a'], 2);
+  Test(c.values0[1, 'a'], 3);
+end.
\ No newline at end of file
diff --git a/tests/test/tarrpropol2.pp b/tests/test/tarrpropol2.pp
new file mode 100644
index 0000000000..029704e2ef
--- /dev/null
+++ b/tests/test/tarrpropol2.pp
@@ -0,0 +1,28 @@
+{%FAIL}
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+program tarrpropol2;
+
+type
+  TValue = TObject;
+  TList = record
+    function GetValueWithInt(index: integer): TValue;
+    function GetValueWithString(index: string): TValue;
+    { all default properties must share the same name }
+    property Values0[index: integer]: TValue read GetValueWithInt; default;
+    property Values1[index: string]: TValue read GetValueWithString; default;
+  end;
+
+function TList.GetValueWithInt(index: integer): TValue;
+begin
+  result := nil;  
+end;
+
+function TList.GetValueWithString(index: string): TValue;
+begin
+  result := nil;  
+end;
+
+begin
+end.
diff --git a/tests/test/tarrpropol3.pp b/tests/test/tarrpropol3.pp
new file mode 100644
index 0000000000..55bd0cf269
--- /dev/null
+++ b/tests/test/tarrpropol3.pp
@@ -0,0 +1,22 @@
+{%FAIL}
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+program tarrpropol3;
+
+type
+  TValue = TObject;
+  TList = record
+    function GetValueWithInt(index: integer): TValue;
+    { default properties must have unique parameters }
+    property Values[index: integer]: TValue read GetValueWithInt; default;
+    property Values[index: integer]: TValue read GetValueWithInt; default;
+  end;
+
+function TList.GetValueWithInt(index: integer): TValue;
+begin
+  result := nil;  
+end;
+
+begin
+end.
diff --git a/tests/test/tarrpropol4.pp b/tests/test/tarrpropol4.pp
new file mode 100644
index 0000000000..2d9e48923e
--- /dev/null
+++ b/tests/test/tarrpropol4.pp
@@ -0,0 +1,24 @@
+{%FAIL}
+{$mode objfpc}
+
+program tarrpropol4;
+
+type
+  TValue = TObject;
+
+function GetGlobalValueInt(index: integer): TValue;
+begin
+  result:=nil;
+end;
+
+function GetGlobalValueStr(index: string): TValue;
+begin
+  result:=nil;
+end;
+
+{ make sure global properties aren't affect by changes }
+property Values[index: integer]: TValue read GetGlobalValueInt;
+property Values[index: string]: TValue read GetGlobalValueStr;
+
+begin
+end.
diff --git a/tests/test/tarrpropol5.pp b/tests/test/tarrpropol5.pp
new file mode 100644
index 0000000000..0d2312b0ec
--- /dev/null
+++ b/tests/test/tarrpropol5.pp
@@ -0,0 +1,28 @@
+{%FAIL}
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+program tarrpropol5;
+
+type
+  TValue = TObject;
+  TList = record
+    function GetValue(index: integer): TValue;
+    function GetValue(index: word): TValue;
+    { default properties must have unique parameters }
+    property Values[index: integer]: TValue read GetValue; default;
+    property Values[index: word]: TValue read GetValue; default;
+  end;
+
+function TList.GetValue(index: integer): TValue;
+begin
+  result := nil;  
+end;
+
+function TList.GetValue(index: word): TValue;
+begin
+  result := nil;  
+end;
+
+begin
+end.
diff --git a/tests/test/tarrpropol6.pp b/tests/test/tarrpropol6.pp
new file mode 100644
index 0000000000..5ea3301c2b
--- /dev/null
+++ b/tests/test/tarrpropol6.pp
@@ -0,0 +1,50 @@
+{$mode objfpc}
+
+program tarrpropol6;
+
+var
+  LastProc: integer = 0;
+
+type
+  TValue = TObject;
+  TBase = class
+    function GetValue(index: integer): TValue;
+    property Values[index: integer]: TValue read GetValue; default;
+  end;
+
+function TBase.GetValue(index: integer): TValue;
+begin
+  LastProc := 1;
+  result := nil;  
+end;
+
+type
+  TList = class(TBase)
+    function GetValue(index: integer): TValue;
+    property Values[index: integer]: TValue read GetValue; default;
+  end;
+
+function TList.GetValue(index: integer): TValue;
+begin
+  LastProc := 2;
+  result := nil;  
+end;
+
+procedure Test(const value: TValue; desired: integer);
+begin
+  if LastProc <> desired then
+    begin
+      writeln('FAILED');
+      Halt(-1);
+    end;
+end;
+
+var
+  c: TList;
+  v: TValue;
+begin
+  { last wins }
+  Test(c[1], 2);
+  { cast to get child access }
+  Test(TBase(c)[1], 1);
+end.
diff --git a/tests/test/tarrpropol7.pp b/tests/test/tarrpropol7.pp
new file mode 100644
index 0000000000..a2c471fbf9
--- /dev/null
+++ b/tests/test/tarrpropol7.pp
@@ -0,0 +1,64 @@
+{$mode objfpc}
+
+program tarrpropol7;
+
+var
+  LastProc: integer = 0;
+
+type
+  TValue = TObject;
+  TBase = class
+    function GetValue(index: integer): TValue;
+    property Values[index: integer]: TValue read GetValue; default;
+  end;
+  
+  function TBase.GetValue(index: integer): TValue;
+  begin
+    LastProc := 1;
+    result := nil;  
+  end;
+
+type
+  TList = class(TBase)
+    function GetAnotherValue(index: integer): TValue;
+    function GetAnotherValue(index: string): TValue;
+    { you can declare another default property of a different name
+      if it's in a child object }
+    property MoreValues[index: integer]: TValue read GetAnotherValue; default;
+    property MoreValues[index: string]: TValue read GetAnotherValue; default;
+  end;
+
+  function TList.GetAnotherValue(index: integer): TValue;
+  begin
+    LastProc := 2;
+    result := nil;  
+  end;
+
+  function TList.GetAnotherValue(index: string): TValue;
+  begin
+    LastProc := 3;
+    result := nil;  
+  end;
+
+procedure Test(const value: TValue; desired: integer);
+begin
+  if LastProc <> desired then
+    begin
+      writeln('FAILED');
+      Halt(-1);
+    end;
+end;
+
+var
+  c: TList;
+  v: TValue;
+begin
+  { normal defaults }
+  Test(c[1], 2);
+  Test(c['key'], 3);
+
+  { named default access }
+  Test(c.Values[1], 1);
+  Test(c.MoreValues[1], 2);
+  Test(c.MoreValues['key'], 3);
+end.
diff --git a/tests/test/tarrpropol8.pp b/tests/test/tarrpropol8.pp
new file mode 100644
index 0000000000..7ae4dca46e
--- /dev/null
+++ b/tests/test/tarrpropol8.pp
@@ -0,0 +1,28 @@
+{%FAIL}
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+program tarrpropol8;
+
+type
+  TValue = TObject;
+  TList = record
+    function GetValue(index: integer): TValue;
+    function GetValue(index: word): TValue;
+    { parametered properties must have unique parameters }
+    property Values[index: integer]: TValue read GetValue;
+    property Values[index: word]: TValue read GetValue;
+  end;
+
+function TList.GetValue(index: integer): TValue;
+begin
+  result := nil;  
+end;
+
+function TList.GetValue(index: word): TValue;
+begin
+  result := nil;  
+end;
+
+begin
+end.
-- 
2.17.2 (Apple Git-113)

patch_6_28.diff (29,318 bytes)

Issue History

Date Modified Username Field Change
2019-06-26 20:15 Ryan Joseph New Issue
2019-06-26 20:15 Ryan Joseph File Added: array_prop_overload_6_26.diff
2019-06-26 23:35 Michael Van Canneyt Note Added: 0116949
2019-06-27 00:22 Ryan Joseph Note Added: 0116951
2019-06-27 06:33 Awkward Note Added: 0116956
2019-06-27 15:17 Ryan Joseph Note Added: 0116966
2019-06-27 15:30 Michael Van Canneyt Note Added: 0116967
2019-06-27 15:40 Ryan Joseph Note Added: 0116968
2019-06-27 18:03 Ryan Joseph Note Added: 0116969
2019-06-27 23:15 Akira1364 Note Added: 0116978
2019-06-27 23:15 Akira1364 Note Edited: 0116978 View Revisions
2019-06-27 23:25 Ryan Joseph Note Added: 0116979
2019-06-27 23:44 Akira1364 Note Added: 0116980
2019-06-28 16:56 Ryan Joseph File Added: patch_6_28.diff
2019-06-28 16:56 Ryan Joseph Note Added: 0116994
2019-10-08 12:29 Ondrej Pokorny Relationship added related to 0028820