mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 09:19:39 +01:00 
			
		
		
		
	compiler: correctly traverse record fields while generating record constant (bug #0020594)
git-svn-id: trunk@19563 -
This commit is contained in:
		
							parent
							
								
									6b4a5c3cf6
								
							
						
					
					
						commit
						f685d67647
					
				
							
								
								
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							@ -11890,6 +11890,7 @@ tests/webtbs/tw2046a.pp svneol=native#text/plain
 | 
				
			|||||||
tests/webtbs/tw20527.pp svneol=native#text/plain
 | 
					tests/webtbs/tw20527.pp svneol=native#text/plain
 | 
				
			||||||
tests/webtbs/tw20557.pp svneol=native#text/pascal
 | 
					tests/webtbs/tw20557.pp svneol=native#text/pascal
 | 
				
			||||||
tests/webtbs/tw2059.pp svneol=native#text/plain
 | 
					tests/webtbs/tw2059.pp svneol=native#text/plain
 | 
				
			||||||
 | 
					tests/webtbs/tw20594.pp svneol=native#text/pascal
 | 
				
			||||||
tests/webtbs/tw2065.pp svneol=native#text/plain
 | 
					tests/webtbs/tw2065.pp svneol=native#text/plain
 | 
				
			||||||
tests/webtbs/tw2069.pp svneol=native#text/plain
 | 
					tests/webtbs/tw2069.pp svneol=native#text/plain
 | 
				
			||||||
tests/webtbs/tw2072.pp svneol=native#text/plain
 | 
					tests/webtbs/tw2072.pp svneol=native#text/plain
 | 
				
			||||||
 | 
				
			|||||||
@ -35,7 +35,7 @@ implementation
 | 
				
			|||||||
    uses
 | 
					    uses
 | 
				
			||||||
       SysUtils,
 | 
					       SysUtils,
 | 
				
			||||||
       globtype,systems,tokens,verbose,constexp,
 | 
					       globtype,systems,tokens,verbose,constexp,
 | 
				
			||||||
       cutils,globals,widestr,scanner,
 | 
					       cclasses,cutils,globals,widestr,scanner,
 | 
				
			||||||
       symconst,symbase,symdef,symtable,
 | 
					       symconst,symbase,symdef,symtable,
 | 
				
			||||||
       aasmbase,aasmtai,aasmcpu,defutil,defcmp,
 | 
					       aasmbase,aasmtai,aasmcpu,defutil,defcmp,
 | 
				
			||||||
       { pass 1 }
 | 
					       { pass 1 }
 | 
				
			||||||
@ -1094,9 +1094,21 @@ implementation
 | 
				
			|||||||
              Message(parser_e_improper_guid_syntax);
 | 
					              Message(parser_e_improper_guid_syntax);
 | 
				
			||||||
          end;
 | 
					          end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					        function get_next_varsym(const SymList:TFPHashObjectList; var symidx:longint):tsym;inline;
 | 
				
			||||||
 | 
					          begin
 | 
				
			||||||
 | 
					            while symidx<SymList.Count do
 | 
				
			||||||
 | 
					              begin
 | 
				
			||||||
 | 
					                result:=tsym(def.symtable.SymList[symidx]);
 | 
				
			||||||
 | 
					                inc(symidx);
 | 
				
			||||||
 | 
					                if result.typ=fieldvarsym then
 | 
				
			||||||
 | 
					                  exit;
 | 
				
			||||||
 | 
					              end;
 | 
				
			||||||
 | 
					            result:=nil;
 | 
				
			||||||
 | 
					          end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
        var
 | 
					        var
 | 
				
			||||||
          i : longint;
 | 
					          i : longint;
 | 
				
			||||||
 | 
					          SymList:TFPHashObjectList;
 | 
				
			||||||
        begin
 | 
					        begin
 | 
				
			||||||
          { GUID }
 | 
					          { GUID }
 | 
				
			||||||
          if (def=rec_tguid) and (token=_ID) then
 | 
					          if (def=rec_tguid) and (token=_ID) then
 | 
				
			||||||
@ -1146,9 +1158,10 @@ implementation
 | 
				
			|||||||
          { normal record }
 | 
					          { normal record }
 | 
				
			||||||
          consume(_LKLAMMER);
 | 
					          consume(_LKLAMMER);
 | 
				
			||||||
          curroffset:=0;
 | 
					          curroffset:=0;
 | 
				
			||||||
          symidx:=0;
 | 
					 | 
				
			||||||
          sorg:='';
 | 
					          sorg:='';
 | 
				
			||||||
          srsym:=tsym(def.symtable.SymList[symidx]);
 | 
					          symidx:=0;
 | 
				
			||||||
 | 
					          symlist:=def.symtable.SymList;
 | 
				
			||||||
 | 
					          srsym:=get_next_varsym(symlist,symidx);
 | 
				
			||||||
          recsym := nil;
 | 
					          recsym := nil;
 | 
				
			||||||
          startoffset:=hr.offset;
 | 
					          startoffset:=hr.offset;
 | 
				
			||||||
          while token<>_RKLAMMER do
 | 
					          while token<>_RKLAMMER do
 | 
				
			||||||
@ -1184,7 +1197,8 @@ implementation
 | 
				
			|||||||
                     (tfieldvarsym(recsym).fieldoffset = curroffset) then
 | 
					                     (tfieldvarsym(recsym).fieldoffset = curroffset) then
 | 
				
			||||||
                    begin
 | 
					                    begin
 | 
				
			||||||
                      srsym:=recsym;
 | 
					                      srsym:=recsym;
 | 
				
			||||||
                      symidx := def.symtable.SymList.indexof(srsym)
 | 
					                      { symidx should contain the next symbol id to search }
 | 
				
			||||||
 | 
					                      symidx:=SymList.indexof(srsym)+1;
 | 
				
			||||||
                    end
 | 
					                    end
 | 
				
			||||||
                  { going backwards isn't allowed in any mode }
 | 
					                  { going backwards isn't allowed in any mode }
 | 
				
			||||||
                  else if (tfieldvarsym(recsym).fieldoffset<curroffset) then
 | 
					                  else if (tfieldvarsym(recsym).fieldoffset<curroffset) then
 | 
				
			||||||
@ -1256,12 +1270,7 @@ implementation
 | 
				
			|||||||
                  { record was initialized (JM)                    }
 | 
					                  { record was initialized (JM)                    }
 | 
				
			||||||
                  recsym := srsym;
 | 
					                  recsym := srsym;
 | 
				
			||||||
                  { goto next field }
 | 
					                  { goto next field }
 | 
				
			||||||
                  inc(symidx);
 | 
					                  srsym:=get_next_varsym(SymList,symidx);
 | 
				
			||||||
                  if symidx<def.symtable.SymList.Count then
 | 
					 | 
				
			||||||
                    srsym:=tsym(def.symtable.SymList[symidx])
 | 
					 | 
				
			||||||
                  else
 | 
					 | 
				
			||||||
                    srsym:=nil;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
                  if token=_SEMICOLON then
 | 
					                  if token=_SEMICOLON then
 | 
				
			||||||
                    consume(_SEMICOLON)
 | 
					                    consume(_SEMICOLON)
 | 
				
			||||||
                  else if (token=_COMMA) and (m_mac in current_settings.modeswitches) then
 | 
					                  else if (token=_COMMA) and (m_mac in current_settings.modeswitches) then
 | 
				
			||||||
 | 
				
			|||||||
							
								
								
									
										55
									
								
								tests/webtbs/tw20594.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										55
									
								
								tests/webtbs/tw20594.pp
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,55 @@
 | 
				
			|||||||
 | 
					{ %norun}
 | 
				
			||||||
 | 
					{ %OPT=-Sew -vw}
 | 
				
			||||||
 | 
					{$MODE delphi}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					type
 | 
				
			||||||
 | 
					  TTestRec1 = record
 | 
				
			||||||
 | 
					    A, B: Integer;
 | 
				
			||||||
 | 
					  end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  TTestRec2 = record
 | 
				
			||||||
 | 
					    A, B: Integer;
 | 
				
			||||||
 | 
					    class operator Explicit(const rec: TTestRec2): ShortString;
 | 
				
			||||||
 | 
					  end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  TTestRec3 = record
 | 
				
			||||||
 | 
					    A, B: Integer;
 | 
				
			||||||
 | 
					    function ToString: ShortString;
 | 
				
			||||||
 | 
					  end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  TTestRec4 = record
 | 
				
			||||||
 | 
					    A: Integer;
 | 
				
			||||||
 | 
					    function ToString: ShortString;
 | 
				
			||||||
 | 
					    var B: Integer;
 | 
				
			||||||
 | 
					  end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					class operator TTestRec2.Explicit(const rec: TTestRec2): ShortString;
 | 
				
			||||||
 | 
					begin
 | 
				
			||||||
 | 
					  with rec do WriteStr(Result, A, ':', B);
 | 
				
			||||||
 | 
					end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					function TTestRec3.ToString: ShortString;
 | 
				
			||||||
 | 
					begin
 | 
				
			||||||
 | 
					  Result := ShortString(TTestRec2(Self));
 | 
				
			||||||
 | 
					end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					function TTestRec4.ToString: ShortString;
 | 
				
			||||||
 | 
					begin
 | 
				
			||||||
 | 
					  Result := ShortString(TTestRec2(Self));
 | 
				
			||||||
 | 
					end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					const
 | 
				
			||||||
 | 
					  r1: TTestRec1 = (A: 1; B: 2);
 | 
				
			||||||
 | 
					  r2: TTestRec2 = (A: 3; B: 4);
 | 
				
			||||||
 | 
					  r3: TTestRec3 = (A: 5; B: 6);
 | 
				
			||||||
 | 
					  r4: TTestRec3 = (A: 7; B: 8);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					begin
 | 
				
			||||||
 | 
					  Writeln(ShortString(r2));
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  Writeln(SizeOf(TTestRec1) = SizeOf(TTestRec2));
 | 
				
			||||||
 | 
					  Writeln(ShortString(TTestRec2(r1)));
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  Writeln(r3.ToString);
 | 
				
			||||||
 | 
					  Writeln(r4.ToString);
 | 
				
			||||||
 | 
					end.
 | 
				
			||||||
		Loading…
	
		Reference in New Issue
	
	Block a user