[Ada] New pragma Unevaluated_Use_Of_Old

[Arnaud Charlet <charlet at adacore dot com>]

A new pragma Unevaluated_Use_Of_Old (Error | Warn | Allow) is
implemented which controls the processing of attributes Old and
Loop_Entry. If either of these attributes is used in a potentially
unevaluated expression  e.g. the then or else parts of an if
expression), then normally this usage is considered illegal if
the prefix of the attribute is other than an entity name. The
language requires this behavior for Old, and GNAT copies the
same rule for Loop_Entry.

Although the rule avoids this possibility, it is sometimes
too restrictive. The pragma Unevaluated_Use_Of_Old can be
used to modify this behavior. If the argument is ERROR, then an
error is given (this is the default RM behavior). If the argument is
WARN then the usage is allowed as legal but with a warning
that an exception might be raised. If the argument is ALLOW
then the usage is allowed as legal without generating a warning.

This pragma may appear as a configuration pragma, or in a declarative
part or package specification. In the latter case it applies to
uses up to the end of the corresponding statement sequence or
sequence of package declarations.

The following is compiled with -gnatc -gnatwW -gnatld7 -gnatj60

     1. package UnevalOld is
     2.    K : Character;
     3.    procedure U (A : String; C : Boolean)  -- ERROR
     4.      with Post => (if C then A(1)'Old = K else True);
                                     |
        >>> prefix of attribute "Old" that is potentially
            unevaluated must denote an entity

     5.    procedure V (A : String; C : Boolean)
     6.      with Post => A(1)'Old = K;
     7.
     8.    package U1 is
     9.       pragma Unevaluated_Use_Of_Old (Warn); -- WARNING
    10.       procedure P1 (A : String; C : Boolean)
    11.         with Post => (if C then A(1)'Old = K else True);
                                        |
        >>> warning: prefix of attribute "Old" appears in
            potentially unevaluated context, exception may
            be raised

    12.    end U1;
    13.
    14.    package U2 is
    15.       pragma Unevaluated_Use_Of_Old (Allow); -- OK
    16.       procedure P2 (A : String; C : Boolean)
    17.         with Post => (if C then A(1)'Old = K else True);
    18.    end U2;
    19. end;

If the same compilation is carried out with a gnat.adc file that
contains the pragma:

pragma Unevaluated_Use_Of_Old (Allow);

Then the output omits the first error:

     1. package UnevalOld is
     2.    K : Character;
     3.    procedure U (A : String; C : Boolean)  -- ERROR
     4.      with Post => (if C then A(1)'Old = K else True);
     5.    procedure V (A : String; C : Boolean)
     6.      with Post => A(1)'Old = K;
     7.
     8.    package U1 is
     9.       pragma Unevaluated_Use_Of_Old (Warn); -- WARNING
    10.       procedure P1 (A : String; C : Boolean)
    11.         with Post => (if C then A(1)'Old = K else True);
                                        |
        >>> warning: prefix of attribute "Old" appears in
            potentially unevaluated context, exception may
            be raised

    12.    end U1;
    13.
    14.    package U2 is
    15.       pragma Unevaluated_Use_Of_Old (Allow); -- OK
    16.       procedure P2 (A : String; C : Boolean)
    17.         with Post => (if C then A(1)'Old = K else True);
    18.    end U2;
    19. end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-07-29  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Document pragma Unevaluated_Use_Of_Old.
	* opt.adb: Handle Uneval_Old.
	* opt.ads (Uneval_Old, Uneval_Old_Config): New variables.
	* par-prag.adb: Add dummy entry for pragma Unevaluated_Use_Of_Old.
	* sem.ads (Save_Uneval_Old): New field in Scope_Stack_Entry.
	* sem_attr.adb (Uneval_Old_Msg): New procedure.
	* sem_ch8.adb (Push_Scope): Save Uneval_Old.
	(Pop_Scope): Restore Uneval_Old.
	* sem_prag.adb (Analyze_Pragma, case Unevaluated_Use_Of_Old):
	Implemented.
	* snames.ads-tmpl: Add entries for pragma Unevaluated_Use_Of_Old
	Add entries for Name_Warn, Name_Allow.

Attachment: difs
Description: Text document