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.
+
openSUSE Build Service is sponsored by