[multiple changes]

2011-08-02  Robert Dewar  <dewar@adacore.com>

	* einfo.adb (Is_Base_Type): Improve efficiency by using a flag table
	(Base_Type): Now uses improved Is_Base_Type function
	* einfo.ads (Base_Type): Inline this function

2011-08-02  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Defend against infinite recursion
	(Analyze_Aspect_Specifications): Fix Sloc values for constructed pragmas

2011-08-02  Arnaud Charlet  <charlet@adacore.com>

	* gcc-interface/Make-lang.in: Update dependencies.
	* gcc-interface/Makefile.in: Use s-inmapop-vxworks.adb for all VxWorks
	targets.

2011-08-02  Yannick Moy  <moy@adacore.com>

	* par-ch3.adb (P_Delta_Constraint): issue an error in formal mode on
	non-simple expression used in delta constraint
	(P_Index_Or_Discriminant_Constraint): issue an error in formal mode on
	index constraint which is not a subtype mark
	* par.adb: With and use Restrict
	* sem_ch3.adb (Analyze_Component_Declaration): issue an error in formal
	mode on component type which is not a subtype mark and default
	expression on component
	(Analyze_Subtype_Declaration): issue an error in formal mode on subtype
	of string which does not have a lower index bound equal to 1
	(Array_Type_Declaration): issue an error in formal mode on index or
	component type which is not a subtype mark, and on aliased keyword on
	component
	(Derived_Type_Declaration): issue an error in formal mode on interface,
	limited or abstract type
	(Record_Type_Declaration): issue an error in formal mode on interface
	(Record_Type_Definition): issue an error in formal mode on tagged types
	and type extensions not declared in the specification of a library unit
	package; on null non-tagged record; on variant part

2011-08-02  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Check_Library_Attributes): Do not report Library_Dir
	not declared for qualified library project when Library_Name is not
	declared, but Library_Dir is.

2011-08-02  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specification): Fix slocs on generated
	pragmas (affects aspects [Component_]Default_Value
	(Check_Aspect_At_Freeze_Point): For Component_Default_Value, use
	component type for the resolution

From-SVN: r177123

gcc/ada/ChangeLog

+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.adb (Is_Base_Type): Improve efficiency by using a flag table
+	(Base_Type): Now uses improved Is_Base_Type function
+	* einfo.ads (Base_Type): Inline this function
+
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma): Defend against infinite recursion
+	(Analyze_Aspect_Specifications): Fix Sloc values for constructed pragmas
+
+2011-08-02  Arnaud Charlet  <charlet@adacore.com>
+
+	* gcc-interface/Make-lang.in: Update dependencies.
+	* gcc-interface/Makefile.in: Use s-inmapop-vxworks.adb for all VxWorks
+	targets.
+
+2011-08-02  Yannick Moy  <moy@adacore.com>
+
+	* par-ch3.adb (P_Delta_Constraint): issue an error in formal mode on
+	non-simple expression used in delta constraint
+	(P_Index_Or_Discriminant_Constraint): issue an error in formal mode on
+	index constraint which is not a subtype mark
+	* par.adb: With and use Restrict
+	* sem_ch3.adb (Analyze_Component_Declaration): issue an error in formal
+	mode on component type which is not a subtype mark and default
+	expression on component
+	(Analyze_Subtype_Declaration): issue an error in formal mode on subtype
+	of string which does not have a lower index bound equal to 1
+	(Array_Type_Declaration): issue an error in formal mode on index or
+	component type which is not a subtype mark, and on aliased keyword on
+	component
+	(Derived_Type_Declaration): issue an error in formal mode on interface,
+	limited or abstract type
+	(Record_Type_Declaration): issue an error in formal mode on interface
+	(Record_Type_Definition): issue an error in formal mode on tagged types
+	and type extensions not declared in the specification of a library unit
+	package; on null non-tagged record; on variant part
+
+2011-08-02  Vincent Celier  <celier@adacore.com>
+
+	* prj-nmsc.adb (Check_Library_Attributes): Do not report Library_Dir
+	not declared for qualified library project when Library_Name is not
+	declared, but Library_Dir is.
+
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch13.adb (Analyze_Aspect_Specification): Fix slocs on generated
+	pragmas (affects aspects [Component_]Default_Value
+	(Check_Aspect_At_Freeze_Point): For Component_Default_Value, use
+	component type for the resolution
+
 2011-08-02  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* einfo.adb (Base_Type): Tune implementation for speed.

gcc/ada/einfo.adb

@@ -5608,43 +5608,13 @@ package body Einfo is
    ---------------
 
    function Base_Type (Id : E) return E is
-      Is_Base_Type : Boolean;
    begin
-      --  Implementation note: this function shows up high in the profile.
-      --  We use a fully static case construct so as to make it easier for
-      --  the compiler to build a static table out of it, instead of using
-      --  a less efficient jump table.
-
-      case Ekind (Id) is
-         when E_Enumeration_Subtype          |
-              E_Incomplete_Type              |
-              E_Signed_Integer_Subtype       |
-              E_Modular_Integer_Subtype      |
-              E_Floating_Point_Subtype       |
-              E_Ordinary_Fixed_Point_Subtype |
-              E_Decimal_Fixed_Point_Subtype  |
-              E_Array_Subtype                |
-              E_String_Subtype               |
-              E_Record_Subtype               |
-              E_Private_Subtype              |
-              E_Record_Subtype_With_Private  |
-              E_Limited_Private_Subtype      |
-              E_Access_Subtype               |
-              E_Protected_Subtype            |
-              E_Task_Subtype                 |
-              E_String_Literal_Subtype       |
-              E_Class_Wide_Subtype           =>
-            Is_Base_Type := False;
-
-         when others =>
-            Is_Base_Type := True;
-      end case;
-
-      if Is_Base_Type then
+      if Is_Base_Type (Id) then
          return Id;
+      else
+         pragma Assert (Is_Type (Id));
+         return Etype (Id);
       end if;
-
-      return Etype (Id);
    end Base_Type;
 
    -------------------------
@@ -6206,9 +6176,32 @@ package body Einfo is
    -- Is_Base_Type --
    ------------------
 
+   --  Global flag table allowing rapid computation of this function
+
+   Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean :=
+                           (E_Enumeration_Subtype          |
+                            E_Incomplete_Type              |
+                            E_Signed_Integer_Subtype       |
+                            E_Modular_Integer_Subtype      |
+                            E_Floating_Point_Subtype       |
+                            E_Ordinary_Fixed_Point_Subtype |
+                            E_Decimal_Fixed_Point_Subtype  |
+                            E_Array_Subtype                |
+                            E_String_Subtype               |
+                            E_Record_Subtype               |
+                            E_Private_Subtype              |
+                            E_Record_Subtype_With_Private  |
+                            E_Limited_Private_Subtype      |
+                            E_Access_Subtype               |
+                            E_Protected_Subtype            |
+                            E_Task_Subtype                 |
+                            E_String_Literal_Subtype       |
+                            E_Class_Wide_Subtype           => False,
+                            others                         => True);
+
    function Is_Base_Type (Id : E) return Boolean is
    begin
-      return Id = Base_Type (Id);
+      return Entity_Is_Base_Type (Ekind (Id));
    end Is_Base_Type;
 
    ---------------------

gcc/ada/einfo.ads

@@ -8010,6 +8010,7 @@ package Einfo is
    --  things here which are small, but not of the canonical attribute
    --  access/set format that can be handled by xeinfo.
 
+   pragma Inline (Base_Type);
    pragma Inline (Is_Base_Type);
    pragma Inline (Is_Package_Or_Generic_Package);
    pragma Inline (Is_Volatile);

gcc/ada/gcc-interface/Makefile.in

@@ -423,7 +423,7 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
   LIBGNAT_TARGET_PAIRS = \
   a-intnam.ads<a-intnam-vxworks.ads \
   a-numaux.ads<a-numaux-vxworks.ads \
-  s-inmaop.adb<s-inmaop-posix.adb \
+  s-inmaop.adb<s-inmaop-vxworks.adb \
   s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
@@ -468,7 +468,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
   LIBGNAT_TARGET_PAIRS = \
   a-intnam.ads<a-intnam-vxworks.ads \
   a-numaux.ads<a-numaux-vxworks.ads \
-  s-inmaop.adb<s-inmaop-posix.adb \
+  s-inmaop.adb<s-inmaop-vxworks.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
   s-osinte.ads<s-osinte-vxworks.ads \
@@ -564,7 +564,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
   a-numaux.ads<a-numaux-vxworks.ads \
   g-io.adb<g-io-vxworks-ppc-cert.adb \
   g-io.ads<g-io-vxworks-ppc-cert.ads \
-  s-inmaop.adb<s-inmaop-posix.adb \
+  s-inmaop.adb<s-inmaop-vxworks.adb \
   s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
@@ -625,7 +625,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksmils,$(targ))),)
   a-numaux.ads<a-numaux-vxworks.ads \
   g-io.adb<g-io-vxworks-ppc-cert.adb \
   g-io.ads<g-io-vxworks-ppc-cert.ads \
-  s-inmaop.adb<s-inmaop-posix.adb \
+  s-inmaop.adb<s-inmaop-vxworks.adb \
   s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
@@ -682,7 +682,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(targ))),)
   g-bytswa.adb<g-bytswa-x86.adb \
   g-io.adb<g-io-vxworks-ppc-cert.adb \
   g-io.ads<g-io-vxworks-ppc-cert.ads \
-  s-inmaop.adb<s-inmaop-posix.adb \
+  s-inmaop.adb<s-inmaop-vxworks.adb \
   s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
@@ -737,7 +737,7 @@ ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
   LIBGNAT_TARGET_PAIRS = \
   a-intnam.ads<a-intnam-vxworks.ads \
   a-numaux.ads<a-numaux-vxworks.ads \
-  s-inmaop.adb<s-inmaop-posix.adb \
+  s-inmaop.adb<s-inmaop-vxworks.adb \
   s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
@@ -777,7 +777,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
   i-vxwork.ads<i-vxwork-x86.ads \
   s-osinte.adb<s-osinte-vxworks.adb \
   s-osinte.ads<s-osinte-vxworks.ads \
-  s-inmaop.adb<s-inmaop-posix.adb \
+  s-inmaop.adb<s-inmaop-vxworks.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
   a-numaux.adb<a-numaux-x86.adb \
@@ -867,7 +867,7 @@ ifeq ($(strip $(filter-out arm% coff wrs vx%,$(targ))),)
   LIBGNAT_TARGET_PAIRS = \
   a-intnam.ads<a-intnam-vxworks.ads \
   a-numaux.ads<a-numaux-vxworks.ads \
-  s-inmaop.adb<s-inmaop-posix.adb \
+  s-inmaop.adb<s-inmaop-vxworks.adb \
   s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
@@ -905,7 +905,7 @@ ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),)
   LIBGNAT_TARGET_PAIRS = \
   a-intnam.ads<a-intnam-vxworks.ads \
   a-numaux.ads<a-numaux-vxworks.ads \
-  s-inmaop.adb<s-inmaop-posix.adb \
+  s-inmaop.adb<s-inmaop-vxworks.adb \
   s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \

gcc/ada/par-ch3.adb

@@ -2528,6 +2528,7 @@ package body Ch3 is
    --  Note: this is an obsolescent feature in Ada 95 (I.3)
 
    --  Note: in Ada 83, the EXPRESSION must be a SIMPLE_EXPRESSION
+   --  (also true in formal modes).
 
    --  The caller has checked that the initial token is DELTA
 
@@ -2542,6 +2543,12 @@ package body Ch3 is
       Scan; -- past DELTA
       Expr_Node := P_Expression;
       Check_Simple_Expression_In_Ada_83 (Expr_Node);
+
+      if Expr_Form = EF_Non_Simple then
+         Check_Formal_Restriction
+           ("this expression must be parenthesized", Expr_Node);
+      end if;
+
       Set_Delta_Expression (Constraint_Node, Expr_Node);
 
       if Token = Tok_Range then
@@ -3069,6 +3076,12 @@ package body Ch3 is
 
          Expr_Node := P_Expression_Or_Range_Attribute;
 
+         if Expr_Form /= EF_Simple_Name
+           and then Formal_Verification_Mode
+         then
+            Error_Msg_SC ("|~~subtype mark required");
+         end if;
+
          if Expr_Form = EF_Range_Attr then
             Append (Expr_Node, Constr_List);
 

gcc/ada/par.adb

@@ -38,6 +38,7 @@ with Nmake;    use Nmake;
 with Opt;      use Opt;
 with Output;   use Output;
 with Par_SCO;  use Par_SCO;
+with Restrict; use Restrict;
 with Scans;    use Scans;
 with Scn;      use Scn;
 with Sinput;   use Sinput;

gcc/ada/prj-nmsc.adb

@@ -3915,17 +3915,23 @@ package body Prj.Nmsc is
 
             when Library =>
                if not Project.Library then
-                  if Project.Library_Dir = No_Path_Information then
+                  if Project.Library_Name = No_Name then
                      Error_Msg
                        (Data.Flags,
-                        "\attribute Library_Dir not declared",
+                        "attribute Library_Name not declared",
                         Project.Location, Project);
-                  end if;
 
-                  if Project.Library_Name = No_Name then
+                     if not Library_Directory_Present then
+                        Error_Msg
+                          (Data.Flags,
+                           "\attribute Library_Dir not declared",
+                           Project.Location, Project);
+                     end if;
+
+                  elsif Project.Library_Dir = No_Path_Information then
                      Error_Msg
                        (Data.Flags,
-                        "\attribute Library_Name not declared",
+                        "attribute Library_Dir not declared",
                         Project.Location, Project);
                   end if;
                end if;

gcc/ada/sem_ch13.adb

@@ -993,7 +993,7 @@ package body Sem_Ch13 is
                   Aitem :=
                     Make_Pragma (Loc,
                       Pragma_Argument_Associations => New_List (
-                        New_Occurrence_Of (E, Eloc),
+                        New_Occurrence_Of (E, Loc),
                         Relocate_Node (Expr)),
                       Pragma_Identifier            =>
                         Make_Identifier (Sloc (Id), Chars (Id)));
@@ -1016,7 +1016,7 @@ package body Sem_Ch13 is
                   Aitem :=
                     Make_Pragma (Loc,
                       Pragma_Argument_Associations => New_List (
-                        New_Occurrence_Of (E, Eloc),
+                        New_Occurrence_Of (E, Loc),
                         Relocate_Node (Expr)),
                       Pragma_Identifier            =>
                         Make_Identifier (Sloc (Id), Chars (Id)));
@@ -1038,7 +1038,7 @@ package body Sem_Ch13 is
                     Make_Pragma (Loc,
                       Pragma_Argument_Associations => New_List (
                         Relocate_Node (Expr),
-                        New_Occurrence_Of (E, Eloc)),
+                        New_Occurrence_Of (E, Loc)),
                       Pragma_Identifier            =>
                         Make_Identifier (Sloc (Id), Chars (Id)),
                       Class_Present                => Class_Present (Aspect));
@@ -5239,13 +5239,16 @@ package body Sem_Ch13 is
          when Boolean_Aspects =>
             raise Program_Error;
 
-         --  Default_Value and Default_Component_Value are resolved with
-         --  the entity, which is the type in question.
+         --  Default_Value is resolved with the type entity in question
 
-         when Aspect_Default_Component_Value |
-              Aspect_Default_Value           =>
+         when Aspect_Default_Value =>
             T := Entity (ASN);
 
+         --  Default_Component_Value is resolved with the component type
+
+         when Aspect_Default_Component_Value =>
+            T := Component_Type (Entity (ASN));
+
          --  Aspects corresponding to attribute definition clauses
 
          when Aspect_Address =>

gcc/ada/sem_ch3.adb

@@ -1773,13 +1773,19 @@ package body Sem_Ch3 is
          end if;
       end Is_Known_Limited;
 
+      Typ : constant Node_Id := Subtype_Indication (Component_Definition (N));
+
    --  Start of processing for Analyze_Component_Declaration
 
    begin
       Generate_Definition (Id);
       Enter_Name (Id);
 
-      if Present (Subtype_Indication (Component_Definition (N))) then
+      if Present (Typ) then
+         if Nkind (Typ) /= N_Identifier then
+            Check_Formal_Restriction ("subtype mark required", Typ);
+         end if;
+
          T := Find_Type_Of_Object
                 (Subtype_Indication (Component_Definition (N)), N);
 
@@ -1833,6 +1839,7 @@ package body Sem_Ch3 is
       --  package Sem).
 
       if Present (E) then
+         Check_Formal_Restriction ("default expression is not allowed", E);
          Preanalyze_Spec_Expression (E, T);
          Check_Initialization (T, E);
 
@@ -3998,6 +4005,36 @@ package body Sem_Ch3 is
            ("subtype of Boolean cannot have constraint", N);
       end if;
 
+      --  Subtype of String shall have a lower index bound equal to 1 in SPARK
+      --  or ALFA.
+
+      if Base_Type (T) = Standard_String
+        and then Nkind (Subtype_Indication (N)) = N_Subtype_Indication
+      then
+         declare
+            Cstr   : constant Node_Id := Constraint (Subtype_Indication (N));
+            Drange : Node_Id;
+            Low    : Node_Id;
+         begin
+            if Nkind (Cstr) = N_Index_Or_Discriminant_Constraint
+              and then List_Length (Constraints (Cstr)) = 1
+            then
+               Drange := First (Constraints (Cstr));
+
+               if Nkind (Drange) = N_Range then
+                  Low := Low_Bound (Drange);
+
+                  if Is_OK_Static_Expression (Low)
+                    and then Expr_Value (Low) /= 1
+                  then
+                     Check_Formal_Restriction
+                       ("subtype of String must have 1 as lower bound", N);
+                  end if;
+               end if;
+            end if;
+         end;
+      end if;
+
       --  In the case where there is no constraint given in the subtype
       --  indication, Process_Subtype just returns the Subtype_Mark, so its
       --  semantic attributes must be established here.
@@ -4503,6 +4540,7 @@ package body Sem_Ch3 is
 
    procedure Array_Type_Declaration (T : in out Entity_Id; Def : Node_Id) is
       Component_Def : constant Node_Id := Component_Definition (Def);
+      Component_Typ : constant Node_Id := Subtype_Indication (Component_Def);
       Element_Type  : Entity_Id;
       Implicit_Base : Entity_Id;
       Index         : Node_Id;
@@ -4530,6 +4568,10 @@ package body Sem_Ch3 is
 
       Nb_Index := 1;
       while Present (Index) loop
+         if Nkind (Index) /= N_Identifier then
+            Check_Formal_Restriction ("subtype mark required", Index);
+         end if;
+
          Analyze (Index);
 
          --  Add a subtype declaration for each index of private array type
@@ -4600,10 +4642,12 @@ package body Sem_Ch3 is
 
       --  Process subtype indication if one is present
 
-      if Present (Subtype_Indication (Component_Def)) then
-         Element_Type :=
-           Process_Subtype
-             (Subtype_Indication (Component_Def), P, Related_Id, 'C');
+      if Present (Component_Typ) then
+         if Nkind (Component_Typ) /= N_Identifier then
+            Check_Formal_Restriction ("subtype mark required", Component_Typ);
+         end if;
+
+         Element_Type := Process_Subtype (Component_Typ, P, Related_Id, 'C');
 
       --  Ada 2005 (AI-230): Access Definition case
 
@@ -4711,6 +4755,8 @@ package body Sem_Ch3 is
       Set_Packed_Array_Type (T, Empty);
 
       if Aliased_Present (Component_Definition (Def)) then
+         Check_Formal_Restriction
+           ("aliased is not allowed", Component_Definition (Def));
          Set_Has_Aliased_Components (Etype (T));
       end if;
 
@@ -13832,6 +13878,8 @@ package body Sem_Ch3 is
       --  parent is also an interface.
 
       if Interface_Present (Def) then
+         Check_Formal_Restriction ("interface is not allowed", Def);
+
          if not Is_Interface (Parent_Type) then
             Diagnose_Interface (Indic, Parent_Type);
 
@@ -18789,6 +18837,14 @@ package body Sem_Ch3 is
       if Ada_Version < Ada_2005
         or else not Interface_Present (Def)
       then
+         if Limited_Present (Def) then
+            Check_Formal_Restriction ("limited is not allowed", N);
+         end if;
+
+         if Abstract_Present (Def) then
+            Check_Formal_Restriction ("abstract is not allowed", N);
+         end if;
+
          --  The flag Is_Tagged_Type might have already been set by
          --  Find_Type_Name if it detected an error for declaration T. This
          --  arises in the case of private tagged types where the full view
@@ -18808,6 +18864,8 @@ package body Sem_Ch3 is
                                       or else Abstract_Present (Def));
 
       else
+         Check_Formal_Restriction ("interface is not allowed", N);
+
          Is_Tagged := True;
          Analyze_Interface_Declaration (T, Def);
 
@@ -18946,6 +19004,41 @@ package body Sem_Ch3 is
          T := Prev_T;
       end if;
 
+      --  In SPARK or ALFA, tagged types and type extensions may only be
+      --  declared in the specification of library unit packages.
+
+      if Present (Def) and then Is_Tagged_Type (T) then
+         declare
+            Typ  : Node_Id;
+            Ctxt : Node_Id;
+         begin
+            if Nkind (Parent (Def)) = N_Full_Type_Declaration then
+               Typ := Parent (Def);
+            else
+               pragma Assert
+                 (Nkind (Parent (Def)) = N_Derived_Type_Definition);
+               Typ := Parent (Parent (Def));
+            end if;
+
+            Ctxt := Parent (Typ);
+
+            if Nkind (Ctxt) = N_Package_Body
+              and then Nkind (Parent (Ctxt)) = N_Compilation_Unit
+            then
+               Check_Formal_Restriction
+                 ("type should be defined in package specification", Typ);
+            elsif Nkind (Ctxt) /= N_Package_Specification
+              or else
+                Nkind (Parent (Parent (Ctxt))) /= N_Compilation_Unit
+            then
+               Check_Formal_Restriction
+                 ("type should be defined in library unit package", Typ);
+            else
+               null;
+            end if;
+         end;
+      end if;
+
       Final_Storage_Only := not Is_Controlled (T);
 
       --  Ada 2005: check whether an explicit Limited is present in a derived
@@ -18968,12 +19061,15 @@ package body Sem_Ch3 is
         or else No (Component_List (Def))
         or else Null_Present (Component_List (Def))
       then
-         null;
+         if not Is_Tagged_Type (T) then
+            Check_Formal_Restriction ("non-tagged record cannot be null", Def);
+         end if;
 
       else
          Analyze_Declarations (Component_Items (Component_List (Def)));
 
          if Present (Variant_Part (Component_List (Def))) then
+            Check_Formal_Restriction ("variant part is not allowed", Def);
             Analyze (Variant_Part (Component_List (Def)));
          end if;
       end if;

gcc/ada/sem_prag.adb

@@ -5656,6 +5656,16 @@ package body Sem_Prag is
    --  Start of processing for Analyze_Pragma
 
    begin
+      --  The following code is a defense against recursion. Not clear that
+      --  this can happen legitimately, but perhaps some error situations
+      --  can cause it, and we did see this recursion during testing.
+
+      if Analyzed (N) then
+         return;
+      else
+         Set_Analyzed (N, True);
+      end if;
+
       --  Deal with unrecognized pragma
 
       if not Is_Pragma_Name (Pname) then