paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 00:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Merging r45365 into '.':

Browse Source 
U    compiler/systems/t_embed.pas
--- Recording mergeinfo for merge of r45365 into '.':
 U   .
--- Merging r45707 into '.':
U    compiler/defcmp.pas
A    tests/tbs/tb0675.pp
--- Recording mergeinfo for merge of r45707 into '.':
 G   .
--- Merging r46279 into '.':
U    compiler/pexpr.pas
A    tests/test/tarrconstr8.pp
--- Recording mergeinfo for merge of r46279 into '.':
 G   .
--- Merging r47110 into '.':
U    compiler/symdef.pas
A    tests/tbs/tb0679.pp
A    tests/tbs/tb0680.pp
--- Recording mergeinfo for merge of r47110 into '.':
 G   .

git-svn-id: branches/fixes_3_2@47819 -
This commit is contained in:
svenbarth 2020-12-19 21:21:05 +00:00
parent 74a1b6406e
commit 036c9f7ff2
9 changed files with 158 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -12934,9 +12934,12 @@ tests/tbs/tb0668a.pp svneol=native#text/pascal
tests/tbs/tb0668b.pp svneol=native#text/pascal
tests/tbs/tb0669.pp svneol=native#text/pascal
tests/tbs/tb0670.pp svneol=native#text/pascal
tests/tbs/tb0675.pp svneol=native#text/pascal
tests/tbs/tb0676.pp svneol=native#text/pascal
tests/tbs/tb0677.pp svneol=native#text/pascal
tests/tbs/tb0678.pp svneol=native#text/pascal
tests/tbs/tb0679.pp svneol=native#text/pascal
tests/tbs/tb0680.pp svneol=native#text/pascal
tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/tb610.pp svneol=native#text/pascal
tests/tbs/tb613.pp svneol=native#text/plain
@ -13957,6 +13960,7 @@ tests/test/tarrconstr4.pp svneol=native#text/pascal
tests/test/tarrconstr5.pp svneol=native#text/pascal
tests/test/tarrconstr6.pp svneol=native#text/pascal
tests/test/tarrconstr7.pp svneol=native#text/pascal
tests/test/tarrconstr8.pp svneol=native#text/pascal
tests/test/tasm1.pp svneol=native#text/plain
tests/test/tasm10.pp svneol=native#text/plain
tests/test/tasm10a.pp svneol=native#text/plain

16
compiler/defcmp.pas
View File

@ -822,7 +822,14 @@ implementation
{ the orddef < currency (then it will get convert l3, }
{ and conversion to float is favoured) }
doconv:=tc_int_2_real;
eq:=te_convert_l2;
if is_extended(def_to) then
eq:=te_convert_l2
else if is_double(def_to) then
eq:=te_convert_l3
else if is_single(def_to) then
eq:=te_convert_l4
else
eq:=te_convert_l2;
end;
end;
floatdef :
@ -843,7 +850,12 @@ implementation
{ do we lose precision? }
if (def_to.size<def_from.size) or
(is_currency(def_from) and (tfloatdef(def_to).floattype in [s32real,s64real])) then
eq:=te_convert_l2
begin
if is_currency(def_from) and (tfloatdef(def_to).floattype=s32real) then
eq:=te_convert_l3
else
eq:=te_convert_l2
end
else
eq:=te_convert_l1;
end;

22
compiler/pexpr.pas
View File

@ -2449,16 +2449,26 @@ implementation
begin
if not try_type_helper(p1,nil) then
begin
if pattern='CREATE' then
if p1.nodetype=typen then
begin
consume(_ID);
p2:=parse_array_constructor(tarraydef(p1.resultdef));
p1.destroy;
p1:=p2;
if pattern='CREATE' then
begin
consume(_ID);
p2:=parse_array_constructor(tarraydef(p1.resultdef));
p1.destroy;
p1:=p2;
end
else
begin
Message2(scan_f_syn_expected,'CREATE',pattern);
p1.destroy;
p1:=cerrornode.create;
consume(_ID);
end;
end
else
begin
Message2(scan_f_syn_expected,'CREATE',pattern);
Message(parser_e_invalid_qualifier);
p1.destroy;
p1:=cerrornode.create;
consume(_ID);

9
compiler/symdef.pas
View File

@ -6261,10 +6261,17 @@ implementation
function tprocdef.defaultmangledname: TSymStr;
var
n : TSymStr;
begin
n:=procsym.name;
{ make sure that the mangled names of these overloadable methods types is
unique even if it's made lowercase (e.g. for section names) }
if proctypeoption in [potype_operator,potype_class_constructor,potype_class_destructor] then
n:='$'+n;
{ we need to use the symtable where the procsym is inserted,
because that is visible to the world }
defaultmangledname:=make_mangledname('',procsym.owner,procsym.name);
defaultmangledname:=make_mangledname('',procsym.owner,n);
defaultmangledname:=defaultmangledname+mangledprocparanames(Length(defaultmangledname))
end;

4
compiler/systems/t_embed.pas
View File

@ -1310,6 +1310,10 @@ begin
success:=DoExec(FindUtil(utilsprefix+'objcopy'),'-O binary '+
ChangeFileExt(current_module.exefilename,'.elf')+' '+
ChangeFileExt(current_module.exefilename,'.bin'),true,false);
{$ifdef ARM}
if success and (current_settings.controllertype = ct_raspi2) then
success:=DoExec(FindUtil(utilsprefix+'objcopy'),'-O binary '+ FixedExeFileName + ' kernel7.img',true,false);
{$endif ARM}
end;
MakeExecutable:=success; { otherwise a recursive call to link method }

45
tests/tbs/tb0675.pp Normal file
View File

@ -0,0 +1,45 @@
program tb0675;
{$mode objfpc}
function Test(a: Single): LongInt;
begin
Result := 1;
end;
{$ifdef FPC_HAS_TYPE_DOUBLE}
function Test(a: Double): LongInt;
begin
Result := 2;
end;
{$endif}
function Test2(a: Single): LongInt;
begin
Result := 1;
end;
{$ifdef FPC_HAS_TYPE_DOUBLE}
function Test2(a: Double): LongInt;
begin
Result := 2;
end;
{$endif}
{$ifdef FPC_HAS_TYPE_EXTENDED}
function Test2(a: Extended): LongInt;
begin
Result := 3;
end;
{$endif}
var
a: Currency;
begin
if Test(a) <> 2 then
Halt(1);
{$ifdef FPC_HAS_TYPE_EXTENDED}
if Test2(a) <> 3 then
Halt(2);
{$endif}
end.

28
tests/tbs/tb0679.pp Normal file
View File

@ -0,0 +1,28 @@
{ %NORUN }
program tb0679;
{$mode objfpc}
type
TA = class
public
class destructor Destroy;
destructor Destroy; override;
end;
class destructor TA.Destroy;
begin
end;
destructor TA.Destroy;
begin
inherited;
end;
var
A: TA;
begin
A := TA.Create;
A.Free;
end.

26
tests/tbs/tb0680.pp Normal file
View File

@ -0,0 +1,26 @@
{ %NORUN }
program tb0680;
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
type
TTest = record
class operator + (aLeft, aRight: TTest): TTest;
function Plus(aLeft, aRight: TTest): TTest;
end;
class operator TTest.+(aLeft, aRight: TTest): TTest;
begin
end;
function TTest.Plus(aLeft, aRight: TTest): TTest;
begin
end;
begin
end.

13
tests/test/tarrconstr8.pp Normal file
View File

@ -0,0 +1,13 @@
{ %FAIL }
program tarrconstr8;
type
TLongIntArray = array of LongInt;
var
arr: TLongIntArray;
begin
// Create *must* be used on a type
arr := arr.Create(1, 2);
end.