Browse Source

* don't allow passing ordinal and real constants to formal const parameters

git-svn-id: trunk@10426 -
peter 17 years ago
parent
commit
761344e9fc
5 changed files with 32 additions and 46 deletions
  1. 1 1
      .gitattributes
  2. 20 5
      compiler/htypechk.pas
  3. 0 35
      tests/tbs/tb0206.pp
  4. 9 0
      tests/webtbf/tw9015.pp
  5. 2 5
      tests/webtbs/tw4427.pp

+ 1 - 1
.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

+ 20 - 5
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

+ 0 - 35
tests/tbs/tb0206.pp

@@ -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.

+ 9 - 0
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.

+ 2 - 5
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.