diff --git a/.gitattributes b/.gitattributes index 8e17fddcba..5ff46eedd8 100644 --- a/.gitattributes +++ b/.gitattributes @@ -6395,7 +6395,6 @@ tests/tbs/tb0202.pp svneol=native#text/plain tests/tbs/tb0203.pp svneol=native#text/plain tests/tbs/tb0204.pp svneol=native#text/plain tests/tbs/tb0205.pp svneol=native#text/plain -tests/tbs/tb0206.pp svneol=native#text/plain tests/tbs/tb0207.pp svneol=native#text/plain tests/tbs/tb0208.pp svneol=native#text/plain tests/tbs/tb0209.pp svneol=native#text/plain @@ -7843,6 +7842,7 @@ tests/webtbf/tw8780a.pp svneol=native#text/plain tests/webtbf/tw8780b.pp svneol=native#text/plain tests/webtbf/tw8780c.pp svneol=native#text/plain tests/webtbf/tw8781.pp svneol=native#text/plain +tests/webtbf/tw9015.pp svneol=native#text/plain tests/webtbf/tw9039a.pp svneol=native#text/plain tests/webtbf/tw9039b.pp svneol=native#text/plain tests/webtbf/tw9039c.pp svneol=native#text/plain diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index d8f1eb1378..bebb01915b 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -1027,11 +1027,6 @@ implementation end; exit; end; - if (Valid_Const in opts) and is_constnode(hp) then - begin - result:=true; - exit; - end; case hp.nodetype of temprefn : begin @@ -1234,6 +1229,26 @@ implementation CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr); exit; end; + ordconstn, + realconstn : + begin + { these constants will be passed by value } + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + setconstn, + stringconstn, + guidconstn : + begin + { these constants will be passed by reference } + if valid_const in opts then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; addrn : begin if gotderef then diff --git a/tests/tbs/tb0206.pp b/tests/tbs/tb0206.pp deleted file mode 100644 index 72c7f51075..0000000000 --- a/tests/tbs/tb0206.pp +++ /dev/null @@ -1,35 +0,0 @@ -{ Old file: tbs0242b.pp } -{ } - - -const - test = 5; - - procedure test_const(const s : string;const x); - begin -{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} - writeln(s,' is ',longint(unaligned(x))); -{$else} - writeln(s,' is ',longint(x)); -{$endif} - end; - - procedure change(var x); - begin - inc(longint(x)); - end; - const i : longint = 12; - var - j : longint; -begin - j:=34; - test_const('Const 5',5); - test_const('Untyped const test',test); - test_const('Typed_const i',i); - test_const('Var j',j); - {test_const('i<>j ',i<>j);} - change(i); - change(j); - { change(test); - change(longint); } -end. diff --git a/tests/webtbf/tw9015.pp b/tests/webtbf/tw9015.pp new file mode 100644 index 0000000000..8c55ca07e3 --- /dev/null +++ b/tests/webtbf/tw9015.pp @@ -0,0 +1,9 @@ +{ %fail } +procedure p1(const b;l:longint); +begin +end; + +begin + // Expected error: variable required + p1(1,sizeof(1)); +end. diff --git a/tests/webtbs/tw4427.pp b/tests/webtbs/tw4427.pp index 104d0a33e4..1121fa5751 100644 --- a/tests/webtbs/tw4427.pp +++ b/tests/webtbs/tw4427.pp @@ -1,11 +1,8 @@ {$inline on} -type - pbyte = ^byte; - procedure test(p: pchar); begin - if pbyte(p)^ <> 0 then + if pchar(p)^ <> 'a' then halt(1); end; @@ -15,5 +12,5 @@ begin end; begin - test(#0); + test('abc'); end.