[Ada] Allow attribute 'Valid_Scalars on private types

[Ada] Allow attribute 'Valid_Scalars on private types

This patch modifies the analysis and expansion of attribute 'Valid_Scalars. It
is now possible to specify the attribute on a prefix of an untagged private
type.

------------
-- Source --
------------

--  gnat.adc

pragma Initialize_Scalars;

--  pack1.ads

package Pack1 is
   type Acc_1  is private;
   type Acc_2  is private;
   type Arr_1  is private;
   type Arr_2  is private;
   type Bool_1 is private;
   type Cmpx_1 is private;
   type Cmpx_2 is private;
   type Enum_1 is private;
   type Enum_2 is private;
   type Fix_1  is private;
   type Fix_2  is private;
   type Flt_1  is private;
   type Flt_2  is private;
   type Modl_1 is private;
   type Prot_1 is limited private;
   type Prot_2 is limited private;
   type Prot_3 (Discr : Boolean) is limited private;
   type Rec_1  is private;
   type Rec_2  is private;
   type Rec_3  is private;
   type Rec_4 (Discr : Boolean) is private;
   type Rec_5 (Discr_1 : Boolean; Discr_2 : Boolean) is private;
   type Sign_1 is private;
   type Tag_1  is tagged private;
   type Task_1 is limited private;
   type Task_2 (Discr : Boolean) is limited private;

   type Prec_Arr_1 is private;
   type Prec_Arr_2 is private;
   type Prec_Arr_3 is private;
   type Prec_Arr_4 is private;
   type Prec_Arr_5 is private;

   type Prec_Rec_1 is private;
   type Prec_Rec_2 (Discr : Boolean) is private;
   type Prec_Rec_3 (Discr_1 : Boolean; Discr_2 : Boolean) is private;
   type Prec_Rec_4 is private;
   type Prec_Rec_5 is private;
   type Prec_Rec_6 is private;
   type Prec_Rec_7 is private;
   type Prec_Rec_8 is private;
   type Prec_Rec_9 is private;

private
   type Acc_1 is access Boolean;
   type Acc_2 is access procedure;
   type Arr_1  is array (1 .. 10) of Boolean;
   type Arr_2  is array (1 .. 3) of access Boolean;
   type Bool_1 is new Boolean;
   type Cmpx_1 is array (1 .. 5) of Rec_5 (True, True);
   type Cmpx_2 is record
      Comp_1 : Cmpx_1;
      Comp_2 : Rec_4 (True);
   end record;
   type Enum_1 is (One, Two, Three);
   type Enum_2 is ('f', 'o', 'u', 'r');
   type Fix_1  is delta 0.5 range 0.0 .. 10.0;
   type Fix_2  is delta 0.1 digits 15;
   type Flt_1  is digits 8;
   type Flt_2  is digits 10 range -1.0 .. 1.0;
   type Modl_1 is mod 8;
   protected type Prot_1 is
   end Prot_1;
   protected type Prot_2 is
   private
      Comp_1 : Boolean;
      Comp_2 : Boolean;
   end Prot_2;
   protected type Prot_3 (Discr : Boolean) is
   private
      Comp_1 : Boolean;
      Comp_2 : Rec_4 (Discr);
   end Prot_3;
   type Rec_1  is null record;
   type Rec_2  is record
      null;
   end record;
   type Rec_3  is record
      Comp_1 : Boolean;
      Comp_2 : Boolean;
   end record;
   type Rec_4 (Discr : Boolean) is record
      case Discr is
         when True =>
            Comp_1 : Boolean;
            Comp_2 : Boolean;
         when False =>
            Comp_3 : access Boolean;
      end case;
   end record;
   type Rec_5 (Discr_1 : Boolean; Discr_2 : Boolean) is record
      Comp_1 : Boolean;
      Comp_2 : Boolean;
      case Discr_1 is
         when True =>
            case Discr_2 is
               when True =>
                  Comp_3 : Boolean;
                  Comp_4 : Boolean;
               when False =>
                  null;
            end case;
         when False =>
            null;
      end case;
   end record;
   type Sign_1 is range 1 .. 10;
   type Tag_1 is tagged null record;
   task type Task_1;
   task type Task_2 (Discr : Boolean);

   type Prec_Arr_1 is array (1 .. 2) of Boolean;
   type Prec_Arr_2 is array (1 .. 2, 1 .. 2) of Boolean;
   type Prec_Arr_3 is array (1 .. 2) of Prec_Rec_1;
   type Prec_Arr_4 is array (1 .. 2) of Prec_Rec_2 (True);
   type Prec_Arr_5 is array (1 .. 2) of Prec_Rec_3 (True, True);

   type Prec_Rec_1 is record
      Comp_1 : Boolean;
   end record;

   type Prec_Rec_2 (Discr : Boolean) is record
      case Discr is
         when True =>
            Comp_1 : Boolean;
         when others =>
            Comp_2 : Boolean;
      end case;
   end record;

   type Prec_Rec_3 (Discr_1 : Boolean; Discr_2 : Boolean) is record
      case Discr_1 is
         when True =>
            case Discr_2 is
               when True =>
                  Comp_1 : Boolean;
               when others =>
                  Comp_2 : Boolean;
            end case;
         when False =>
            case Discr_2 is
               when True =>
                  Comp_3 : Boolean;
               when others =>
                  Comp_4 : Boolean;
            end case;
      end case;
   end record;

   type Prec_Rec_4 is record
      Comp : Prec_Arr_1;
   end record;

   type Prec_Rec_5 is record
      Comp : Prec_Arr_4;
   end record;

   type Prec_Rec_6 is record
      Comp : Prec_Arr_5;
   end record;

   type Prec_Rec_7 is record
      Comp : Prec_Rec_4;
   end record;

   type Prec_Rec_8 is record
      Comp : Prec_Rec_5;
   end record;

   type Prec_Rec_9 is record
      Comp : Prec_Rec_6;
   end record;
end Pack1;

--  pack1.adb

package body Pack1 is
   protected body Prot_1 is end Prot_1;
   protected body Prot_2 is end Prot_2;
   protected body Prot_3 is end Prot_3;

   task body Task_1 is begin null; end Task_1;
   task body Task_2 is begin null; end Task_2;
end Pack1;

--  pack2.ads

with Pack1; use Pack1;

package Pack2 is
   type Acc_3  is private;
   type Acc_4  is private;
   type Arr_3  is private;
   type Arr_4  is private;
   type Bool_2 is private;
   type Cmpx_3 is private;
   type Cmpx_4 is private;
   type Enum_3 is private;
   type Enum_4 is private;
   type Fix_3  is private;
   type Fix_4  is private;
   type Flt_3  is private;
   type Flt_4  is private;
   type Modl_2 is private;
   type Prot_4 is limited private;
   type Prot_5 is limited private;
   type Prot_6 is limited private;
   type Rec_6  is private;
   type Rec_7  is private;
   type Rec_8  is private;
   type Rec_9  (Discr : Boolean) is private;
   type Rec_10 (Discr : Boolean) is private;
   type Sign_2 is private;
   type Task_3 is limited private;

private
   type Acc_3  is new Acc_1;
   type Acc_4  is new Acc_2;
   type Arr_3  is new Arr_1;
   type Arr_4  is new Arr_2;
   type Bool_2 is new Bool_1;
   type Cmpx_3 is new Cmpx_1;
   type Cmpx_4 is new Cmpx_2;
   type Enum_3 is new Enum_1;
   type Enum_4 is new Enum_2;
   type Fix_3  is new Fix_1;
   type Fix_4  is new Fix_2;
   type Flt_3  is new Flt_1;
   type Flt_4  is new Flt_2;
   type Modl_2 is new Modl_1;
   type Prot_4 is new Prot_1;
   type Prot_5 is new Prot_2;
   type Prot_6 is new Prot_3 (True);
   type Rec_6  is new Rec_1;
   type Rec_7  is new Rec_2;
   type Rec_8  is new Rec_3;
   type Rec_9  (Discr : Boolean) is
     new Rec_4 (Discr => Discr);
   type Rec_10 (Discr : Boolean) is
     new Rec_5 (Discr_1 => Discr, Discr_2 => True);
   type Sign_2 is new Sign_1;
   type Task_3 is new Task_1;
end Pack2;

--  main.adb

with Ada.Text_IO; use Ada.Text_IO;

with Pack1; use Pack1;
with Pack2; use Pack2;

procedure Main is
   procedure Check
     (Actual : Boolean;
      Valid  : Boolean;
      Test   : String)
   is
   begin
      if Actual /= Valid then
         Put_Line ("ERROR " & Test);
         Put_Line ("  valid : " & Valid'Img);
         Put_Line ("  actual: " & Actual'Img);
      end if;
   end Check;

   Valid     : constant Boolean := True;
   Not_Valid : constant Boolean := not Valid;

   pragma Warnings (Off);
   Acc_1_Obj  : Acc_1;
   Acc_2_Obj  : Acc_2;
   Acc_3_Obj  : Acc_3;
   Acc_4_Obj  : Acc_4;
   Arr_1_Obj  : Arr_1;
   Arr_2_Obj  : Arr_2;
   Arr_3_Obj  : Arr_3;
   Arr_4_Obj  : Arr_4;
   Bool_1_Obj : Bool_1;
   Bool_2_Obj : Bool_2;
   Cmpx_1_Obj : Cmpx_1;
   Cmpx_2_Obj : Cmpx_2;
   Cmpx_3_Obj : Cmpx_3;
   Cmpx_4_Obj : Cmpx_4;
   Enum_1_Obj : Enum_1;
   Enum_2_Obj : Enum_2;
   Enum_3_Obj : Enum_3;
   Enum_4_Obj : Enum_4;
   Fix_1_Obj  : Fix_1;
   Fix_2_Obj  : Fix_2;
   Fix_3_Obj  : Fix_3;
   Fix_4_Obj  : Fix_4;
   Flt_1_Obj  : Flt_1;
   Flt_2_Obj  : Flt_2;
   Flt_3_Obj  : Flt_3;
   Flt_4_Obj  : Flt_4;
   Modl_1_Obj : Modl_1;
   Modl_2_Obj : Modl_2;
   Prot_1_Obj : Prot_1;
   Prot_2_Obj : Prot_2;
   Prot_3_Obj : Prot_3 (True);
   Prot_4_Obj : Prot_4;
   Prot_5_Obj : Prot_5;
   Rec_1_Obj  : Rec_1;
   Rec_2_Obj  : Rec_2;
   Rec_3_Obj  : Rec_3;
   Rec_4_Obj  : Rec_4 (True);
   Rec_5_Obj  : Rec_5 (True, True);
   Rec_6_Obj  : Rec_6;
   Rec_7_Obj  : Rec_7;
   Rec_8_Obj  : Rec_8;
   Rec_9_Obj  : Rec_9 (True);
   Sign_1_Obj : Sign_1;
   Sign_2_Obj : Sign_2;
   Tag_1_Obj  : Tag_1;
   Task_1_Obj : Task_1;
   Task_2_Obj : Task_2 (True);
   Task_3_Obj : Task_3;

   Prec_Arr_1_Obj : Prec_Arr_1;
   Prec_Arr_2_Obj : Prec_Arr_2;
   Prec_Arr_3_Obj : Prec_Arr_3;
   Prec_Arr_4_Obj : Prec_Arr_4;
   Prec_Arr_5_Obj : Prec_Arr_5;

   Prec_Rec_1_Obj : Prec_Rec_1;
   Prec_Rec_2_Obj : Prec_Rec_2 (True);
   Prec_Rec_3_Obj : Prec_Rec_3 (True, True);
   Prec_Rec_4_Obj : Prec_Rec_4;
   Prec_Rec_5_Obj : Prec_Rec_5;
   Prec_Rec_6_Obj : Prec_Rec_6;
   Prec_Rec_7_Obj : Prec_Rec_7;
   Prec_Rec_8_Obj : Prec_Rec_8;
   Prec_Rec_9_Obj : Prec_Rec_9;
   pragma Warnings (On);

begin
   Check (Acc_1_Obj'Valid_Scalars,  Valid,     "Acc_1_Obj");
   Check (Acc_2_Obj'Valid_Scalars,  Valid,     "Acc_2_Obj");
   Check (Acc_3_Obj'Valid_Scalars,  Valid,     "Acc_3_Obj");
   Check (Acc_4_Obj'Valid_Scalars,  Valid,     "Acc_4_Obj");
   Check (Arr_1_Obj'Valid_Scalars,  Not_Valid, "Arr_1_Obj");
   Check (Arr_2_Obj'Valid_Scalars,  Valid,     "Arr_2_Obj");
   Check (Arr_3_Obj'Valid_Scalars,  Not_Valid, "Arr_3_Obj");
   Check (Arr_4_Obj'Valid_Scalars,  Valid,     "Arr_4_Obj");
   Check (Bool_1_Obj'Valid_Scalars, Not_Valid, "Bool_1_Obj");
   Check (Bool_2_Obj'Valid_Scalars, Not_Valid, "Bool_2_Obj");
   Check (Cmpx_1_Obj'Valid_Scalars, Not_Valid, "Cmpx_1_Obj");
   Check (Cmpx_2_Obj'Valid_Scalars, Not_Valid, "Cmpx_2_Obj");
   Check (Cmpx_3_Obj'Valid_Scalars, Not_Valid, "Cmpx_3_Obj");
   Check (Cmpx_4_Obj'Valid_Scalars, Not_Valid, "Cmpx_4_Obj");
   Check (Enum_1_Obj'Valid_Scalars, Not_Valid, "Enum_1_Obj");
   Check (Enum_2_Obj'Valid_Scalars, Not_Valid, "Enum_2_Obj");
   Check (Enum_3_Obj'Valid_Scalars, Not_Valid, "Enum_3_Obj");
   Check (Enum_4_Obj'Valid_Scalars, Not_Valid, "Enum_4_Obj");
   Check (Fix_1_Obj'Valid_Scalars,  Not_Valid, "Fix_1_Obj");
   Check (Fix_2_Obj'Valid_Scalars,  Not_Valid, "Fix_2_Obj");
   Check (Fix_3_Obj'Valid_Scalars,  Not_Valid, "Fix_3_Obj");
   Check (Fix_4_Obj'Valid_Scalars,  Not_Valid, "Fix_4_Obj");
   Check (Flt_1_Obj'Valid_Scalars,  Not_Valid, "Flt_1_Obj");
   Check (Flt_2_Obj'Valid_Scalars,  Not_Valid, "Flt_2_Obj");
   Check (Flt_3_Obj'Valid_Scalars,  Not_Valid, "Flt_3_Obj");
   Check (Flt_4_Obj'Valid_Scalars,  Not_Valid, "Flt_4_Obj");
   Check (Modl_1_Obj'Valid_Scalars, Not_Valid, "Modl_1_Obj");
   Check (Modl_2_Obj'Valid_Scalars, Not_Valid, "Modl_2_Obj");
   Check (Prot_1_Obj'Valid_Scalars, Valid,     "Prot_1_Obj");
   Check (Prot_2_Obj'Valid_Scalars, Not_Valid, "Prot_2_Obj");
   Check (Prot_3_Obj'Valid_Scalars, Not_Valid, "Prot_3_Obj");
   Check (Prot_4_Obj'Valid_Scalars, Valid,     "Prot_4_Obj");
   Check (Prot_5_Obj'Valid_Scalars, Not_Valid, "Prot_5_Obj");
   Check (Rec_1_Obj'Valid_Scalars,  Valid,     "Rec_1_Obj");
   Check (Rec_2_Obj'Valid_Scalars,  Valid,     "Rec_2_Obj");
   Check (Rec_3_Obj'Valid_Scalars,  Not_Valid, "Rec_3_Obj");
   Check (Rec_4_Obj'Valid_Scalars,  Not_Valid, "Rec_4_Obj");
   Check (Rec_5_Obj'Valid_Scalars,  Not_Valid, "Rec_5_Obj");
   Check (Rec_6_Obj'Valid_Scalars,  Valid,     "Rec_6_Obj");
   Check (Rec_7_Obj'Valid_Scalars,  Valid,     "Rec_7_Obj");
   Check (Rec_8_Obj'Valid_Scalars,  Not_Valid, "Rec_8_Obj");
   Check (Rec_9_Obj'Valid_Scalars,  Not_Valid, "Rec_9_Obj");
   Check (Sign_1_Obj'Valid_Scalars, Not_Valid, "Sign_1_Obj");
   Check (Sign_2_Obj'Valid_Scalars, Not_Valid, "Sign_2_Obj");
   Check (Tag_1_Obj'Valid_Scalars,  Valid,     "Tag_1_Obj");
   Check (Task_1_Obj'Valid_Scalars, Valid,     "Task_1_Obj");
   Check (Task_2_Obj'Valid_Scalars, Valid,     "Task_2_Obj");
   Check (Task_3_Obj'Valid_Scalars, Valid,     "Task_3_Obj");

   Check (Prec_Arr_1_Obj'Valid_Scalars, Not_Valid, "Prec_Arr_1_Obj");
   Check (Prec_Arr_2_Obj'Valid_Scalars, Not_Valid, "Prec_Arr_2_Obj");
   Check (Prec_Arr_3_Obj'Valid_Scalars, Not_Valid, "Prec_Arr_3_Obj");
   Check (Prec_Arr_4_Obj'Valid_Scalars, Not_Valid, "Prec_Arr_4_Obj");
   Check (Prec_Arr_5_Obj'Valid_Scalars, Not_Valid, "Prec_Arr_5_Obj");

   Check (Prec_Rec_1_Obj'Valid_Scalars, Not_Valid, "Prec_Rec_1_Obj");
   Check (Prec_Rec_2_Obj'Valid_Scalars, Not_Valid, "Prec_Rec_2_Obj");
   Check (Prec_Rec_3_Obj'Valid_Scalars, Not_Valid, "Prec_Rec_3_Obj");
   Check (Prec_Rec_4_Obj'Valid_Scalars, Not_Valid, "Prec_Rec_4_Obj");
   Check (Prec_Rec_5_Obj'Valid_Scalars, Not_Valid, "Prec_Rec_5_Obj");
   Check (Prec_Rec_6_Obj'Valid_Scalars, Not_Valid, "Prec_Rec_6_Obj");
   Check (Prec_Rec_7_Obj'Valid_Scalars, Not_Valid, "Prec_Rec_7_Obj");
   Check (Prec_Rec_8_Obj'Valid_Scalars, Not_Valid, "Prec_Rec_8_Obj");
   Check (Prec_Rec_9_Obj'Valid_Scalars, Not_Valid, "Prec_Rec_9_Obj");
end Main;

-----------------
-- Compilation --
-----------------

$ gnatmake -q main.adb
$ ./main

2018-05-22  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* exp_attr.adb (Build_Array_VS_Func): Reimplemented.
	(Build_Record_VS_Func): Reimplemented.
	(Expand_N_Attribute): Reimplement the handling of attribute
	'Valid_Scalars.
	* sem_attr.adb (Analyze_Attribute): Reimplement the handling of
	attribute 'Valid_Scalars.
	* sem_util.adb (Scalar_Part_Present): Reimplemented.
	(Validated_View): New routine.
	* sem_util.ads (Scalar_Part_Present): Update the parameter profile and
	comment on usage.
	(Validated_View): New routine.
	* doc/gnat_rm/implementation_defined_attributes.rst: Update the
	documentation of attribute 'Valid_Scalars.
	* gnat_rm.texi: Regenerate.

From-SVN: r260518