Mercurial > hg > xemacs-beta

comparison src/lread.c @ 5916:1152e0091f8c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal. lisp/ChangeLog addition: 2015-06-03 Aidan Kehoe <kehoea@parhasard.net> * code-files.el (load): Revise this to respect load-ignore-out-of-date-elc-files, rather than leaving that to #'load-internal. Avoids a corner case where the source and the compiled file have different, incompatible encodings. Move the call to #'substitute-in-file-name here. No longer check for a zero-length filename, since #'load-internal no longer chokes on same and errors correctly. src/ChangeLog addition: 2015-06-03 Aidan Kehoe <kehoea@parhasard.net> * lread.c (Fload_internal): Delegate calling the handler and #'substitute-in-file-name to #'load. Error correctly with a zero-length file name, instead of giving a bus error on my machine. Delegate the check for out-of-date ELC files to #'load, avoiding a bug where the encoding of the ELC file and the source file differed. * lread.c (PRINT_LOADING_MESSAGE_1): This is simplified, now we no longer have to talk about out-of-date ELC files. tests/ChangeLog addition: 2015-06-03 Aidan Kehoe <kehoea@parhasard.net> * automated/file-tests.el: Gross sanity check for #'load and #'load-internal with a zero-length FILE, something that crashed until today.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 03 Jun 2015 20:13:07 +0100
parents d138e600aa3a
children
comparison
equal deleted inserted replaced
5915:1af53d35dd53 5916:1152e0091f8c
530 { 530 {
531 /* This function can GC */ 531 /* This function can GC */
532 int fd = -1; 532 int fd = -1;
533 int speccount = specpdl_depth (); 533 int speccount = specpdl_depth ();
534 int source_only = 0; 534 int source_only = 0;
535 /* NEWER and OLDER are filenames w/o directory, used in loading messages 535 /* NEWER is a filename without directory, used in loading messages when
536 to e.g. warn of newer .el files when the .elc is being loaded. */ 536 load-ignore-elc-files is non-nil. */
537 Lisp_Object newer = Qnil; 537 Lisp_Object newer = Qnil;
538 Lisp_Object older = Qnil;
539 Lisp_Object handler = Qnil;
540 Lisp_Object found = Qnil; 538 Lisp_Object found = Qnil;
541 Lisp_Object retval; 539 Lisp_Object retval;
542 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 540 struct gcpro gcpro1, gcpro2, gcpro3;
543 int reading_elc = 0; 541 int reading_elc = 0;
544 int from_require = EQ (nomessage, Qrequire); 542 int from_require = EQ (nomessage, Qrequire);
545 int message_p = NILP (nomessage) || load_always_display_messages; 543 int message_p = NILP (nomessage) || load_always_display_messages;
546 struct stat s1, s2;
547 Ibyte *spaces = alloca_ibytes (load_in_progress * 2 + 10); 544 Ibyte *spaces = alloca_ibytes (load_in_progress * 2 + 10);
548 int i; 545 int i;
549 PROFILE_DECLARE (); 546 PROFILE_DECLARE ();
550 547
551 GCPRO4 (file, newer, older, found);
552 CHECK_STRING (file); 548 CHECK_STRING (file);
549 CHECK_SYMBOL (used_codesys); /* Either nil or another symbol to write to. */
550
551 GCPRO3 (file, newer, found);
553 552
554 PROFILE_RECORD_ENTERING_SECTION (Qload_internal); 553 PROFILE_RECORD_ENTERING_SECTION (Qload_internal);
555
556 /* If file name is magic, call the handler. */
557 handler = Ffind_file_name_handler (file, Qload);
558 if (!NILP (handler))
559 {
560 retval = call5 (handler, Qload, file, noerror, nomessage, nosuffix);
561 goto done;
562 }
563
564 /* Do this after the handler to avoid
565 the need to gcpro noerror, nomessage and nosuffix.
566 (Below here, we care only whether they are nil or not.) */
567 file = Fsubstitute_in_file_name (file);
568 if (!NILP (used_codesys))
569 CHECK_SYMBOL (used_codesys);
570 554
571 if (noninteractive) 555 if (noninteractive)
572 { 556 {
573 for (i = 0; i < load_in_progress * 2; i++) 557 for (i = 0; i < load_in_progress * 2; i++)
574 spaces[i] = ' '; 558 spaces[i] = ' ';
578 spaces[0] = '\0'; 562 spaces[0] = '\0';
579 563
580 /* Avoid weird lossage with null string as arg, 564 /* Avoid weird lossage with null string as arg,
581 since it would try to load a directory as a Lisp file. 565 since it would try to load a directory as a Lisp file.
582 Unix truly sucks. */ 566 Unix truly sucks. */
583 if (XSTRING_LENGTH (file) > 0) 567 if (XSTRING_LENGTH (file) == 0)
568 {
569 if (NILP (noerror))
570 signal_error (Qfile_error, "Cannot open load file", file);
571 else
572 {
573 retval = Qnil;
574 goto done;
575 }
576 }
577 else
584 { 578 {
585 Ibyte *foundstr; 579 Ibyte *foundstr;
586 int foundlen; 580 int foundlen;
587 581
588 fd = locate_file (Vload_path, file, 582 fd = locate_file (Vload_path, file,
609 603
610 /* The omniscient JWZ thinks this is worthless, but I beg to 604 /* The omniscient JWZ thinks this is worthless, but I beg to
611 differ. --ben */ 605 differ. --ben */
612 if (load_ignore_elc_files) 606 if (load_ignore_elc_files)
613 newer = Ffile_name_nondirectory (found); 607 newer = Ffile_name_nondirectory (found);
614 else if ((load_warn_when_source_newer ||
615 load_ignore_out_of_date_elc_files) &&
616 !memcmp (".elc", foundstr + foundlen - 4, 4))
617 {
618 if (! qxe_fstat (fd, &s1)) /* can't fail, right? */
619 {
620 int result;
621 /* temporarily hack the 'c' off the end of the filename */
622 foundstr[foundlen - 1] = '\0';
623 result = qxe_stat (foundstr, &s2);
624 if (result >= 0 &&
625 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
626 {
627 /* .elc exists and is out-of-date wrt .el */
628 Lisp_Object el_name = make_string (foundstr, foundlen - 1);
629 struct gcpro nngcpro1;
630 NNGCPRO1 (el_name);
631 newer = Ffile_name_nondirectory (el_name);
632 if (load_ignore_out_of_date_elc_files)
633 {
634 int newfd =
635 locate_file_open_or_access_file
636 (XSTRING_DATA (el_name), -1);
637
638 if (newfd >= 0)
639 {
640 older = Ffile_name_nondirectory (found);
641 found = el_name;
642 retry_close (fd);
643 fd = newfd;
644 }
645 }
646 NNUNGCPRO;
647 }
648 /* put the 'c' back on (kludge-o-rama) */
649 foundstr[foundlen - 1] = 'c';
650 }
651 }
652 else if (load_warn_when_source_only && 608 else if (load_warn_when_source_only &&
653 /* `found' ends in ".el" */ 609 /* `found' ends in ".el" */
654 !memcmp (".el", foundstr + foundlen - 3, 3) && 610 !memcmp (".el", foundstr + foundlen - 3, 3) &&
655 /* `file' does not end in ".el" */ 611 /* `file' does not end in ".el" */
656 memcmp (".el", 612 memcmp (".el",
669 if (message_p) \ 625 if (message_p) \
670 message (loading done, spaces, \ 626 message (loading done, spaces, \
671 XSTRING_DATA (load_show_full_path_in_messages ? \ 627 XSTRING_DATA (load_show_full_path_in_messages ? \
672 found : newer)); \ 628 found : newer)); \
673 } \ 629 } \
674 else if (!NILP (older)) \
675 { \
676 assert (load_ignore_out_of_date_elc_files); \
677 message (loading done " (file %s is out-of-date)", spaces, \
678 XSTRING_DATA (load_show_full_path_in_messages ? \
679 found : newer), \
680 XSTRING_DATA (older)); \
681 } \
682 else if (!NILP (newer)) \
683 message (loading done " (file %s is newer)", spaces, \
684 XSTRING_DATA (load_show_full_path_in_messages ? \
685 found : file), \
686 XSTRING_DATA (newer)); \
687 else if (source_only) \ 630 else if (source_only) \
688 message (loading done " (file %s.elc does not exist)", spaces, \ 631 message (loading done " (file %s.elc does not exist)", spaces, \
689 XSTRING_DATA (load_show_full_path_in_messages ? \ 632 XSTRING_DATA (load_show_full_path_in_messages ? \
690 found : file), \ 633 found : file), \
691 XSTRING_DATA (Ffile_name_nondirectory (file))); \ 634 XSTRING_DATA (Ffile_name_nondirectory (file))); \