--- rpl/src/instructions_u1.c 2010/05/24 10:58:35 1.10 +++ rpl/src/instructions_u1.c 2018/05/30 09:27:37 1.67 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.0.16 - Copyright (C) 1989-2010 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.29 + Copyright (C) 1989-2018 Dr. BERTRAND Joël This file is part of RPL/2. @@ -20,7 +20,7 @@ */ -#include "rpl.conv.h" +#include "rpl-conv.h" /* @@ -689,7 +689,6 @@ instruction_utpt(struct_processus *s_eta void instruction_use(struct_processus *s_etat_processus) { - logical1 erreur; logical1 existence; logical1 ouverture; @@ -711,7 +710,7 @@ instruction_use(struct_processus *s_etat if ((*s_etat_processus).langue == 'F') { printf("(insertion d'une bibliothèque dynamique)\n\n"); - printf("Si le chemin ne comprend pas de '/', la bibliothèque " + printf("Si le chemin ne commence pas par '/', la bibliothèque " "est recherchée\n"); printf("successivement dans le répertoire courant puis dans %s." "\n\n", d_exec_path); @@ -719,7 +718,7 @@ instruction_use(struct_processus *s_etat else { printf("(insert a shared library)\n\n"); - printf("If this path does not include '/', RPL/2 tries to find " + printf("If this path does not begin with '/', RPL/2 tries to find " "it in current\n"); printf("directory or %s in this order.\n\n", d_exec_path); } @@ -753,12 +752,12 @@ instruction_use(struct_processus *s_etat if ((*s_objet_argument).type == CHN) { /* - * Si le nom contient un '/', il est traité comme un chemin + * Si le nom commence par un '/', il est traité comme un chemin * absolu. Dans le cas contraire, on essaye successivement * './' puis le répertoire lib de l'installation du langage. */ - if (index((unsigned char *) (*s_objet_argument).objet, '/') == NULL) + if (((unsigned char *) (*s_objet_argument).objet)[0] != '/') { if ((tampon = malloc((strlen((unsigned char *) (*s_objet_argument) .objet) + 3) * sizeof(unsigned char))) == NULL) @@ -770,7 +769,7 @@ instruction_use(struct_processus *s_etat sprintf(tampon, "./%s", (unsigned char *) (*s_objet_argument).objet); - erreur = caracteristiques_fichier(s_etat_processus, tampon, + caracteristiques_fichier(s_etat_processus, tampon, &existence, &ouverture, &unite); if (existence != d_faux) @@ -812,6 +811,14 @@ instruction_use(struct_processus *s_etat (unsigned char *) (*s_objet_argument).objet); } + // Si la chaîne commence par '//', on supprime un '/'. + // tampon[1] existe toujours. + + if (tampon[1] == '/') + { + memmove(tampon, tampon + 1, strlen(tampon)); + } + caracteristiques_fichier(s_etat_processus, tampon, &existence, &ouverture, &unite); @@ -1229,8 +1236,8 @@ instruction_unprotect(struct_processus * return; } - ((*s_etat_processus).s_liste_variables[(*s_etat_processus) - .position_variable_courante]).variable_verrouillee = d_faux; + (*(*s_etat_processus).pointeur_variable_courante) + .variable_verrouillee = d_faux; } else if ((*s_objet).type == LST) { @@ -1257,8 +1264,8 @@ instruction_unprotect(struct_processus * return; } - ((*s_etat_processus).s_liste_variables[(*s_etat_processus) - .position_variable_courante]).variable_verrouillee = d_faux; + (*(*s_etat_processus).pointeur_variable_courante) + .variable_verrouillee = d_faux; l_element_courant = (*l_element_courant).suivant; } @@ -1295,9 +1302,6 @@ instruction_ucase(struct_processus *s_et struct_objet *s_objet_argument; struct_objet *s_objet_resultat; - unsigned char *ptr; - unsigned char registre; - (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') @@ -1347,19 +1351,8 @@ instruction_ucase(struct_processus *s_et } liberation(s_etat_processus, s_objet_argument); - ptr = (unsigned char *) (*s_objet_resultat).objet; - - while((*ptr) != d_code_fin_chaine) - { - registre = toupper((*ptr)); - - if (tolower(registre) == (*ptr)) - { - (*ptr) = registre; - } - - ptr++; - } + conversion_chaine(s_etat_processus, (unsigned char *) + (*s_objet_resultat).objet, 'M'); if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur)