File gpc-fix6.patch of Package gcc3
--- p/typecheck.c 2012-11-04 13:44:19.000000000 +0000
+++ p/typecheck.c 2012-11-04 13:46:24.000000000 +0000
@@ -1020,8 +1020,15 @@
type = TREE_TYPE (val);
else if (!varparm)
type = build_pascal_string_schema (PASCAL_STRING_LENGTH (val));
- if (is_readonly != TYPE_READONLY (type) || is_volatile != TYPE_VOLATILE (type))
- type = p_build_type_variant (type, is_readonly, is_volatile);
+ if (is_readonly != TYPE_READONLY (type)
+ || is_volatile != TYPE_VOLATILE (type)
+ || PASCAL_TYPE_VAL_REF_PARM (type) != val_ref_parm)
+ {
+ type = build_type_copy (type);
+ TYPE_READONLY (type) = is_readonly;
+ TYPE_VOLATILE (type) = is_volatile;
+ PASCAL_TYPE_VAL_REF_PARM (type) = val_ref_parm;
+ }
if (varparm && TREE_CODE (type) != REFERENCE_TYPE)
{
type = build_type_copy (build_reference_type (type));
--- p/test/jsmltest.pas 1970-01-01 01:00:00.000000000 +0100
+++ p/test/jsmltest.pas 2012-11-04 15:48:14.000000000 +0000
@@ -0,0 +1,23 @@
+
+program jsm1test( input, output ) ;
+
+ { passing string literal to const var string formal parameter }
+ { produces }
+ { error: type mismatch in argument 1 of `rejecter' }
+ { unless have previous call (to another routine) passing string }
+ { literal to const string }
+
+procedure enabler( const s : string ) ;
+ begin
+ end ;
+
+procedure rejecter( const var s : string ) ;
+ begin
+ end ;
+
+begin
+{ enabler( 'lit2' ) ; }
+rejecter( 'literal' ) ; { type mismatch if prev line commented out }
+writeln( 'OK' ) ;
+end.
+