--- rpl/src/types.c 2011/06/20 17:54:22 1.30 +++ rpl/src/types.c 2011/12/02 11:17:59 1.43 @@ -1,6 +1,6 @@ /* ================================================================================ - RPL/2 (R) version 4.1.0.prerelease.1 + RPL/2 (R) version 4.1.5 Copyright (C) 1989-2011 Dr. BERTRAND Joël This file is part of RPL/2. @@ -79,6 +79,7 @@ recherche_type(struct_processus *s_etat_ unsigned char registre_test; unsigned char registre_test_bis; unsigned char *tampon; + unsigned char variable_implicite; unsigned long i; unsigned long j; @@ -2318,15 +2319,24 @@ recherche_type(struct_processus *s_etat_ } } + variable_implicite = (*s_etat_processus).autorisation_nom_implicite; registre_recherche_type = (*s_etat_processus).recherche_type; (*s_etat_processus).recherche_type = 'Y'; + (*s_etat_processus).autorisation_nom_implicite = 'Y'; if (sequenceur(s_etat_processus) == d_erreur) { + (*s_etat_processus).autorisation_nom_implicite = + variable_implicite; (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; - (*s_etat_processus).erreur_execution = d_ex_syntaxe; + + if ((*s_etat_processus).erreur_execution != + d_ex_nom_implicite) + { + (*s_etat_processus).erreur_execution = d_ex_syntaxe; + } nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle @@ -2372,6 +2382,7 @@ recherche_type(struct_processus *s_etat_ return; } + (*s_etat_processus).autorisation_nom_implicite = variable_implicite; (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; @@ -2857,6 +2868,16 @@ recherche_type(struct_processus *s_etat_ (*(--ptr_ecriture)) = d_code_fin_chaine; + if (validation_chaine((unsigned char *) element) == d_faux) + { + (*s_etat_processus).erreur_execution = d_ex_syntaxe; + (*s_etat_processus).traitement_interruptible = + registre_interruption; + + free(element); + return; + } + break; } @@ -2956,8 +2977,14 @@ recherche_type(struct_processus *s_etat_ registre_recherche_type = (*s_etat_processus).recherche_type; (*s_etat_processus).recherche_type = 'Y'; + variable_implicite = + (*s_etat_processus).autorisation_nom_implicite; + (*s_etat_processus).autorisation_nom_implicite = 'Y'; + if (sequenceur(s_etat_processus) == d_erreur) { + (*s_etat_processus).autorisation_nom_implicite = + variable_implicite; (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).recherche_type = registre_recherche_type; @@ -3008,6 +3035,8 @@ recherche_type(struct_processus *s_etat_ return; } + (*s_etat_processus).autorisation_nom_implicite = + variable_implicite; (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; @@ -3493,28 +3522,64 @@ recherche_type(struct_processus *s_etat_ } else { - (*s_objet).type = INT; + // Le format ressemble à un entier mais il peut y avoir + // un dépassement de capacité lors de la conversion. + // On convertit donc en entier et en réel. Si les + // deux conversions donnent le même résultat, on + // considère que la conversion en entier est bonne. Dans + // le cas contraire, on garde la conversion en réel. - element = (void *) ((integer8 *) malloc( - sizeof(integer8))); + integer8 conversion_entiere; + real8 conversion_reelle; - if (element == NULL) + if (sscanf((*s_etat_processus).instruction_courante, "%lg", + &conversion_reelle) != 1) { - (*s_etat_processus).erreur_systeme = - d_es_allocation_memoire; - (*s_etat_processus).traitement_interruptible = - registre_interruption; - return; + (*s_etat_processus).erreur_execution = d_ex_syntaxe; } - nombre_elements_convertis = sscanf( - (*s_etat_processus).instruction_courante, "%lld", - (integer8 *) element); - - if (nombre_elements_convertis != 1) + if (sscanf((*s_etat_processus).instruction_courante, "%lld", + &conversion_entiere) != 1) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; } + + if (abs(nextafter(conversion_reelle, conversion_entiere) + - conversion_reelle) >= abs(conversion_reelle + - conversion_entiere)) + { + (*s_objet).type = INT; + + element = malloc(sizeof(integer8)); + + if (element == NULL) + { + (*s_etat_processus).erreur_systeme = + d_es_allocation_memoire; + (*s_etat_processus).traitement_interruptible = + registre_interruption; + return; + } + + (*((integer8 *) element)) = conversion_entiere; + } + else + { + (*s_objet).type = REL; + + element = malloc(sizeof(real8)); + + if (element == NULL) + { + (*s_etat_processus).erreur_systeme = + d_es_allocation_memoire; + (*s_etat_processus).traitement_interruptible = + registre_interruption; + return; + } + + (*((real8 *) element)) = conversion_reelle; + } } }