diff --git a/src/alloc.c b/src/alloc.c
index d09fc41dec6..616b4fa7a66 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2606,6 +2606,9 @@ make_clear_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes, bool clearit)
 
   s = allocate_string ();
   s->u.s.intervals = NULL;
+#ifdef CHECK_STRING_LITERALS
+  s->u.s.literal = false;
+#endif
   allocate_string_data (s, nchars, nbytes, clearit, false);
   XSETSTRING (string, s);
   string_chars_consed += nbytes;
diff --git a/src/lisp.h b/src/lisp.h
index 4e17e369312..30c0a001c34 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1560,6 +1560,8 @@ CDR_SAFE (Lisp_Object c)
   return CONSP (c) ? XCDR (c) : Qnil;
 }
 
+#define CHECK_STRING_LITERALS 1
+
 /* In a string or vector, the sign bit of u.s.size is the gc mark bit.  */
 
 struct Lisp_String
@@ -1579,6 +1581,10 @@ CDR_SAFE (Lisp_Object c)
 
       INTERVAL intervals;	/* Text properties in this string.  */
       unsigned char *data;
+#ifdef CHECK_STRING_LITERALS
+      /* Whether this string originated as a string literal in Lisp code.  */
+      bool literal;
+#endif
     } s;
     struct Lisp_String *next;
     GCALIGNED_UNION_MEMBER
diff --git a/src/lread.c b/src/lread.c
index 273120315df..23d8a1489c1 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1411,6 +1411,10 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
   specbind (Qlread_unescaped_character_literals, Qnil);
   record_unwind_protect (load_warn_unescaped_character_literals, file);
 
+#ifdef CHECK_STRING_LITERALS
+  specbind (Qlread_unescaped_character_literals, Qnil);
+#endif
+
   bool is_elc = suffix_p (found, ".elc");
   if (is_elc
       /* version = 1 means the file is empty, in which case we can
@@ -2230,6 +2234,10 @@ readevalloop (Lisp_Object readcharfun,
 	     ? Qnil : list1 (Qt)));
   specbind (Qmacroexp__dynvars, Vmacroexp__dynvars);
 
+#ifdef CHECK_STRING_LITERALS
+  specbind (Qread_string_literals, Qt);
+#endif
+
   /* Ensure sourcename is absolute, except whilst preloading.  */
   if (!will_dump_p ()
       && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename)))
@@ -3163,6 +3171,10 @@ read_string_literal (Lisp_Object readcharfun)
   Lisp_Object obj = make_specified_string (read_buffer, nchars, p - read_buffer,
 					   (force_multibyte
 					    || (p - read_buffer != nchars)));
+#ifdef CHECK_STRING_LITERALS
+  if (!NILP (Vread_string_literals))
+    XSTRING (obj)->u.s.literal = true;
+#endif
   return unbind_to (count, obj);
 }
 
@@ -3363,7 +3375,14 @@ string_props_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
 	invalid_syntax ("Invalid string property list", readcharfun);
       Lisp_Object plist = XCAR (tl);
       tl = XCDR (tl);
+#ifdef CHECK_STRING_LITERALS
+      bool lit = XSTRING (obj)->u.s.literal;
+      XSTRING (obj)->u.s.literal = false;
+#endif
       Fset_text_properties (beg, end, plist, obj);
+#ifdef CHECK_STRING_LITERALS
+      XSTRING (obj)->u.s.literal = lit;
+#endif
     }
   return obj;
 }
@@ -5452,6 +5471,21 @@ syms_of_lread (void)
 	       doc: /* Non-nil means read recursive structures using #N= and #N# syntax.  */);
   Vread_circle = Qt;
 
+#ifdef CHECK_STRING_LITERALS
+  DEFVAR_LISP ("read-string-literals", Vread_string_literals,
+	       doc: /* Non-nil means read string literals as literals.  */);
+  Vread_string_literals = Qnil;
+  DEFSYM (Qread_string_literals, "read-string-literals");
+  DEFVAR_LISP ("string-literal-property-change",
+	       Vstring_literal_property_change,
+	       doc: /* How to handle changes to properties in literal strings.
+If `error', raise an error.
+If `warn', emit a warning.
+If `nil', do nothing.  */);
+  Vstring_literal_property_change = Qerror;
+  DEFSYM (Qwarn, "warn");
+#endif
+
   DEFVAR_LISP ("load-path", Vload_path,
 	       doc: /* List of directories to search for files to load.
 Each element is a string (directory file name) or nil (meaning
diff --git a/src/textprop.c b/src/textprop.c
index f88fff19c59..2a57262ec67 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -1164,6 +1164,36 @@ DEFUN ("previous-single-property-change", Fprevious_single_property_change,
     return make_fixnum (previous->position + LENGTH (previous));
 }
 
+
+#ifdef CHECK_STRING_LITERALS
+__attribute__((noinline)) void
+string_literal_prop_change (Lisp_Object object);
+
+__attribute__((noinline)) void
+string_literal_prop_change (Lisp_Object object)
+{
+  Lisp_Object how = Vstring_literal_property_change;
+  if (EQ (how, Qerror))
+    error ("Attempt to modify properties of literal string \"%s\"",
+	   SSDATA (object));
+  else if (EQ (how, Qwarn))
+    call2 (intern ("warn"),
+	   build_string
+	   ("Attempt to modify properties of literal string %S"),
+	   object);
+}
+#endif
+
+static void
+check_string_literal_prop_change (Lisp_Object object)
+{
+#ifdef CHECK_STRING_LITERALS
+  if (STRINGP (object) && XSTRING (object)->u.s.literal
+      && SCHARS (object) > 0)
+    string_literal_prop_change (object);
+#endif
+}
+
 /* Used by add-text-properties and add-face-text-property. */
 
 static Lisp_Object
@@ -1184,6 +1214,8 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end,
 						      destructive));
     }
 
+  check_string_literal_prop_change (object);
+
   INTERVAL i, unchanged;
   ptrdiff_t s, len;
   bool modified = false;
@@ -1399,6 +1431,15 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
 					     object, coherent_change_p));
     }
 
+#ifdef CHECK_STRING_LITERALS
+  // Don't complain about removal of properties from a string without any.
+  if (STRINGP (object) && !(!string_intervals (object)
+			    && NILP (properties)
+			    && BASE_EQ (start, make_fixnum (0))
+			    && BASE_EQ (end, make_fixnum (SCHARS (object)))))
+    check_string_literal_prop_change (object);
+#endif
+
   INTERVAL i;
   bool first_time = true;
 
@@ -1483,6 +1524,8 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end,
       return;
     }
 
+  check_string_literal_prop_change (object);
+
   INTERVAL prev_changed = NULL;
   ptrdiff_t s = XFIXNUM (start);
   ptrdiff_t len = XFIXNUM (end) - s;
@@ -1578,6 +1621,8 @@ DEFUN ("remove-text-properties", Fremove_text_properties,
 						 object));
     }
 
+  check_string_literal_prop_change (object);
+
   INTERVAL i, unchanged;
   ptrdiff_t s, len;
   bool modified = false;
@@ -1704,6 +1749,8 @@ DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
 							 object));
     }
 
+  check_string_literal_prop_change (object);
+
   INTERVAL i, unchanged;
   ptrdiff_t s, len;
   bool modified = false;
